diff --git a/src/Compiler/Checking/CheckComputationExpressions.fs b/src/Compiler/Checking/CheckComputationExpressions.fs index a1c89f61dc..e31b9a1369 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/CheckComputationExpressions.fs @@ -1854,6 +1854,13 @@ let mkSeqFinally (cenv: cenv) env m genTy e1 e2 = let e1 = mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g genResultTy) (tyOfExpr cenv.g e1) e1 mkCallSeqFinally cenv.g m genResultTy e1 e2 +let mkSeqTryWith (cenv: cenv) env m genTy origSeq exnFilter exnHandler = + let g = cenv.g + let genResultTy = NewInferenceType g + UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) + let origSeq = mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g genResultTy) (tyOfExpr cenv.g origSeq) origSeq + mkCallSeqTryWith cenv.g m genResultTy origSeq exnFilter exnHandler + let mkSeqExprMatchClauses (pat, vspecs) innerExpr = [MatchClause(pat, None, TTarget(vspecs, innerExpr, None), pat.Range) ] @@ -2079,8 +2086,38 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = Some(mkLet spMatch inputExprMark matchv inputExpr matchExpr, tpenv) - | SynExpr.TryWith (trivia={ TryToWithRange = mTryToWith }) -> - error(Error(FSComp.SR.tcTryIllegalInSequenceExpression(), mTryToWith)) + | SynExpr.TryWith (innerTry,withList,mTryToWith,_spTry,_spWith,trivia) -> + if not(g.langVersion.SupportsFeature(LanguageFeature.TryWithInSeqExpression)) then + error(Error(FSComp.SR.tcTryIllegalInSequenceExpression(), mTryToWith)) + + let env = { env with eIsControlFlow = true } + let tryExpr, tpenv = + let inner,tpenv = tcSequenceExprBody env genOuterTy tpenv innerTry + mkSeqDelayedExpr mTryToWith inner, tpenv + + // Compile the pattern twice, once as a filter with all succeeding targets returning "1", and once as a proper catch block. + let clauses, tpenv = + (tpenv, withList) ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, m, sp, _)) -> + let patR, condR, vspecs, envinner, tpenv = TcMatchPattern cenv g.exn_ty env tpenv pat cond + let envinner = + match sp with + | DebugPointAtTarget.Yes -> { envinner with eIsControlFlow = true } + | DebugPointAtTarget.No -> envinner + let matchBody, tpenv = tcSequenceExprBody envinner genOuterTy tpenv innerComp + let handlerClause = MatchClause(patR, condR, TTarget(vspecs, matchBody, None), patR.Range) + let filterClause = MatchClause(patR, condR, TTarget([], Expr.Const(Const.Int32 1,m,g.int_ty), None), patR.Range) + (handlerClause,filterClause), tpenv) + + let handlers, filterClauses = List.unzip clauses + let withRange = trivia.WithToEndRange + let v1, filterExpr = CompilePatternForMatchClauses cenv env withRange withRange true FailFilter None g.exn_ty g.int_ty filterClauses + let v2, handlerExpr = CompilePatternForMatchClauses cenv env withRange withRange true FailFilter None g.exn_ty genOuterTy handlers + + let filterLambda = mkLambda filterExpr.Range v1 (filterExpr, genOuterTy) + let handlerLambda = mkLambda handlerExpr.Range v2 (handlerExpr, genOuterTy) + + let combinatorExpr = mkSeqTryWith cenv env mTryToWith genOuterTy tryExpr filterLambda handlerLambda + Some (combinatorExpr,tpenv) | SynExpr.YieldOrReturnFrom ((isYield, _), synYieldExpr, m) -> let env = { env with eIsControlFlow = false } diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index e0297df382..063a6b973c 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1561,6 +1561,7 @@ featureErrorForNonVirtualMembersOverrides,"Raises errors for non-virtual members featureWarningWhenInliningMethodImplNoInlineMarkedFunction,"Raises warnings when 'let inline ... =' is used together with [] attribute. Function is not getting inlined." featureArithmeticInLiterals,"Allow arithmetic and logical operations in literals" featureErrorReportingOnStaticClasses,"Error reporting on static classes" +featureTryWithInSeqExpressions,"Support for try-with in sequence expressions" featureWarningWhenCopyAndUpdateRecordChangesAllFields,"Raises warnings when an copy-and-update record expression changes all fields of a record." 3353,fsiInvalidDirective,"Invalid directive '#%s %s'" 3354,tcNotAFunctionButIndexerNamedIndexingNotYetEnabled,"This value supports indexing, e.g. '%s.[index]'. The syntax '%s[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation." diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index 424e949eed..46748d6f88 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -61,6 +61,7 @@ type LanguageFeature = | EscapeDotnetFormattableStrings | ArithmeticInLiterals | ErrorReportingOnStaticClasses + | TryWithInSeqExpression | WarningWhenCopyAndUpdateRecordChangesAllFields /// LanguageVersion management @@ -139,6 +140,7 @@ type LanguageVersion(versionText) = LanguageFeature.EscapeDotnetFormattableStrings, previewVersion LanguageFeature.ArithmeticInLiterals, previewVersion LanguageFeature.ErrorReportingOnStaticClasses, previewVersion + LanguageFeature.TryWithInSeqExpression, previewVersion LanguageFeature.WarningWhenCopyAndUpdateRecordChangesAllFields, previewVersion ] @@ -254,6 +256,7 @@ type LanguageVersion(versionText) = | LanguageFeature.EscapeDotnetFormattableStrings -> FSComp.SR.featureEscapeBracesInFormattableString () | LanguageFeature.ArithmeticInLiterals -> FSComp.SR.featureArithmeticInLiterals () | LanguageFeature.ErrorReportingOnStaticClasses -> FSComp.SR.featureErrorReportingOnStaticClasses () + | LanguageFeature.TryWithInSeqExpression -> FSComp.SR.featureTryWithInSeqExpressions () | LanguageFeature.WarningWhenCopyAndUpdateRecordChangesAllFields -> FSComp.SR.featureWarningWhenCopyAndUpdateRecordChangesAllFields () /// Get a version string associated with the given feature. diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index 714639147b..8ab8b72704 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -51,6 +51,7 @@ type LanguageFeature = | EscapeDotnetFormattableStrings | ArithmeticInLiterals | ErrorReportingOnStaticClasses + | TryWithInSeqExpression | WarningWhenCopyAndUpdateRecordChangesAllFields /// LanguageVersion management diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index dd2f6e70f9..349d988fd4 100755 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -764,6 +764,7 @@ type TcGlobals( let v_seq_using_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateUsing" , None , None , [vara;varb;varc], ([[varaTy];[(varaTy --> varbTy)]], mkSeqTy varcTy)) let v_seq_generated_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateWhile" , None , None , [varb], ([[v_unit_ty --> v_bool_ty]; [mkSeqTy varbTy]], mkSeqTy varbTy)) let v_seq_finally_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateThenFinally" , None , None , [varb], ([[mkSeqTy varbTy]; [v_unit_ty --> v_unit_ty]], mkSeqTy varbTy)) + let v_seq_trywith_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateTryWith" , None , None , [varb], ([[mkSeqTy varbTy]; [mkNonGenericTy v_exn_tcr --> v_int32_ty]; [mkNonGenericTy v_exn_tcr --> mkSeqTy varbTy]], mkSeqTy varbTy)) let v_seq_of_functions_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateFromFunctions" , None , None , [vara;varb], ([[v_unit_ty --> varaTy]; [varaTy --> v_bool_ty]; [varaTy --> varbTy]], mkSeqTy varbTy)) let v_create_event_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "CreateEvent" , None , None , [vara;varb], ([[varaTy --> v_unit_ty]; [varaTy --> v_unit_ty]; [(v_obj_ty --> (varbTy --> v_unit_ty)) --> varaTy]], mkIEvent2Ty varaTy varbTy)) let v_cgh__useResumableCode_info = makeIntrinsicValRef(fslib_MFStateMachineHelpers_nleref, "__useResumableCode" , None , None , [vara], ([[]], v_bool_ty)) @@ -1624,8 +1625,8 @@ type TcGlobals( member val query_select_vref = ValRefForIntrinsic v_query_select_value_info member val query_where_vref = ValRefForIntrinsic v_query_where_value_info member val query_zero_vref = ValRefForIntrinsic v_query_zero_value_info - member val seq_to_list_vref = ValRefForIntrinsic v_seq_to_list_info - member val seq_to_array_vref = ValRefForIntrinsic v_seq_to_array_info + member val seq_to_list_vref = ValRefForIntrinsic v_seq_to_list_info + member val seq_to_array_vref = ValRefForIntrinsic v_seq_to_array_info member _.seq_collect_info = v_seq_collect_info member _.seq_using_info = v_seq_using_info @@ -1633,6 +1634,7 @@ type TcGlobals( member _.seq_append_info = v_seq_append_info member _.seq_generated_info = v_seq_generated_info member _.seq_finally_info = v_seq_finally_info + member _.seq_trywith_info = v_seq_trywith_info member _.seq_of_functions_info = v_seq_of_functions_info member _.seq_map_info = v_seq_map_info member _.seq_singleton_info = v_seq_singleton_info diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 17ce2d8e02..1873a63abe 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -7749,6 +7749,9 @@ let mkCallSeqGenerated g m elemTy arg1 arg2 = let mkCallSeqFinally g m elemTy arg1 arg2 = mkApps g (typedExprForIntrinsic g m g.seq_finally_info, [[elemTy]], [ arg1; arg2 ], m) + +let mkCallSeqTryWith g m elemTy origSeq exnFilter exnHandler = + mkApps g (typedExprForIntrinsic g m g.seq_trywith_info, [[elemTy]], [ origSeq; exnFilter; exnHandler ], m) let mkCallSeqOfFunctions g m ty1 ty2 arg1 arg2 arg3 = mkApps g (typedExprForIntrinsic g m g.seq_of_functions_info, [[ty1;ty2]], [ arg1; arg2; arg3 ], m) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 60bc899d66..c0a9785895 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2132,6 +2132,8 @@ val mkCallSeqAppend: TcGlobals -> range -> TType -> Expr -> Expr -> Expr val mkCallSeqFinally: TcGlobals -> range -> TType -> Expr -> Expr -> Expr +val mkCallSeqTryWith: TcGlobals -> range -> TType -> Expr -> Expr -> Expr -> Expr + val mkCallSeqGenerated: TcGlobals -> range -> TType -> Expr -> Expr -> Expr val mkCallSeqOfFunctions: TcGlobals -> range -> TType -> TType -> Expr -> Expr -> Expr -> Expr diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index c59befa7b1..b6ad7c62f3 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -382,11 +382,19 @@ reprezentace struktury aktivních vzorů + + + Support for try-with in sequence expressions + Support for try-with in sequence expressions + + + Raises warnings when an copy-and-update record expression changes all fields of a record. Raises warnings when an copy-and-update record expression changes all fields of a record. + Raises warnings when 'let inline ... =' is used together with [<MethodImpl(MethodImplOptions.NoInlining)>] attribute. Function is not getting inlined. Vyvolá upozornění, když se použije „let inline ... =“ společně s atributem [<MethodImpl(MethodImplOptions.NoInlining)>]. Funkce není vkládána. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index c4bcef73d3..52f3d52cf2 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -382,11 +382,19 @@ Strukturdarstellung für aktive Muster + + + Support for try-with in sequence expressions + Support for try-with in sequence expressions + + + Raises warnings when an copy-and-update record expression changes all fields of a record. Raises warnings when an copy-and-update record expression changes all fields of a record. + Raises warnings when 'let inline ... =' is used together with [<MethodImpl(MethodImplOptions.NoInlining)>] attribute. Function is not getting inlined. Löst Warnungen aus, wenn „let inline ... =“ zusammen mit dem Attribut [<MethodImpl(MethodImplOptions.NoInlining)>] verwendet wird. Die Funktion wird nicht inline gesetzt. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 073ff01278..298deb3113 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -382,11 +382,19 @@ representación de struct para modelos activos + + + Support for try-with in sequence expressions + Support for try-with in sequence expressions + + + Raises warnings when an copy-and-update record expression changes all fields of a record. Raises warnings when an copy-and-update record expression changes all fields of a record. + Raises warnings when 'let inline ... =' is used together with [<MethodImpl(MethodImplOptions.NoInlining)>] attribute. Function is not getting inlined. Genera advertencias cuando se usa "let inline ... =" junto con el atributo [<MethodImpl(MethodImplOptions.NoInlining)>]. La función no se está insertando. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index a6c5a50598..d41d7f0576 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -382,11 +382,19 @@ représentation de structure pour les modèles actifs + + + Support for try-with in sequence expressions + Support for try-with in sequence expressions + + + Raises warnings when an copy-and-update record expression changes all fields of a record. Raises warnings when an copy-and-update record expression changes all fields of a record. + Raises warnings when 'let inline ... =' is used together with [<MethodImpl(MethodImplOptions.NoInlining)>] attribute. Function is not getting inlined. Génère des avertissements lorsque « let inline ... = » est utilisé avec l’attribut [<MethodImpl(MethodImplOptions.NoInlining)>]. La fonction n’est pas inlined. diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 36fe7ce6e9..083f98e4df 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -382,11 +382,19 @@ rappresentazione struct per criteri attivi + + + Support for try-with in sequence expressions + Support for try-with in sequence expressions + + + Raises warnings when an copy-and-update record expression changes all fields of a record. Raises warnings when an copy-and-update record expression changes all fields of a record. + Raises warnings when 'let inline ... =' is used together with [<MethodImpl(MethodImplOptions.NoInlining)>] attribute. Function is not getting inlined. Genera avvisi quando 'let inline ... =' viene usato insieme all'attributo [<MethodImpl(MethodImplOptions.NoInlining)>]. La funzione non viene resa inline. diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index fc8aeb1aa8..85735c3b4e 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -382,11 +382,19 @@ アクティブなパターンの構造体表現 + + + Support for try-with in sequence expressions + Support for try-with in sequence expressions + + + Raises warnings when an copy-and-update record expression changes all fields of a record. Raises warnings when an copy-and-update record expression changes all fields of a record. + Raises warnings when 'let inline ... =' is used together with [<MethodImpl(MethodImplOptions.NoInlining)>] attribute. Function is not getting inlined. 'let inline ... =' が [<MethodImpl(MethodImplOptions.NoInlining)>] 属性と一緒に使用されるときに警告を生成します。関数はインライン化されていません。 diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index b167a41d44..2b32dd6594 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -382,11 +382,19 @@ 활성 패턴에 대한 구조체 표현 + + + Support for try-with in sequence expressions + Support for try-with in sequence expressions + + + Raises warnings when an copy-and-update record expression changes all fields of a record. Raises warnings when an copy-and-update record expression changes all fields of a record. + Raises warnings when 'let inline ... =' is used together with [<MethodImpl(MethodImplOptions.NoInlining)>] attribute. Function is not getting inlined. 'let inline ... ='을(를) [<MethodImpl(MethodImplOptions.NoInlining)>] 특성과 함께 사용하는 경우 경고를 발생합니다. 함수가 인라인되지 않습니다. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 7590c5fd9f..ee6b6afe9a 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -382,11 +382,19 @@ reprezentacja struktury aktywnych wzorców + + + Support for try-with in sequence expressions + Support for try-with in sequence expressions + + + Raises warnings when an copy-and-update record expression changes all fields of a record. Raises warnings when an copy-and-update record expression changes all fields of a record. + Raises warnings when 'let inline ... =' is used together with [<MethodImpl(MethodImplOptions.NoInlining)>] attribute. Function is not getting inlined. Zgłasza ostrzeżenia, gdy element „let inline ... =” jest używany razem z atrybutem [<MethodImpl(MethodImplOptions.NoInlining)>]. Funkcja nie jest wstawiana. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 620acbfb86..8ad44f41ea 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -382,11 +382,19 @@ representação estrutural para padrões ativos + + + Support for try-with in sequence expressions + Support for try-with in sequence expressions + + + Raises warnings when an copy-and-update record expression changes all fields of a record. Raises warnings when an copy-and-update record expression changes all fields of a record. + Raises warnings when 'let inline ... =' is used together with [<MethodImpl(MethodImplOptions.NoInlining)>] attribute. Function is not getting inlined. Gera avisos quando 'let inline ... =' é usado junto com o atributo [<MethodImpl(MethodImplOptions.NoInlining)>]. A função não está sendo embutida. diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 604ba38207..0cbd637dd4 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -382,11 +382,19 @@ представление структуры для активных шаблонов + + + Support for try-with in sequence expressions + Support for try-with in sequence expressions + + + Raises warnings when an copy-and-update record expression changes all fields of a record. Raises warnings when an copy-and-update record expression changes all fields of a record. + Raises warnings when 'let inline ... =' is used together with [<MethodImpl(MethodImplOptions.NoInlining)>] attribute. Function is not getting inlined. Выдает предупреждения, когда используется параметр "let inline ... =" вместе с атрибутом [<MethodImpl(MethodImplOptions.NoInlining)>]. Функция не встраивается. diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 3d816c0993..c9713648da 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -382,11 +382,19 @@ etkin desenler için yapı gösterimi + + + Support for try-with in sequence expressions + Support for try-with in sequence expressions + + + Raises warnings when an copy-and-update record expression changes all fields of a record. Raises warnings when an copy-and-update record expression changes all fields of a record. + Raises warnings when 'let inline ... =' is used together with [<MethodImpl(MethodImplOptions.NoInlining)>] attribute. Function is not getting inlined. [<MethodImpl(MethodImplOptions.NoInlining)>] özniteliği ile birlikte 'let inline ... =' kullanıldığında uyarı verir. İşlev satır içine alınmıyor. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index d729f95bd3..4072aaad79 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -382,11 +382,19 @@ 活动模式的结构表示形式 + + + Support for try-with in sequence expressions + Support for try-with in sequence expressions + + + Raises warnings when an copy-and-update record expression changes all fields of a record. Raises warnings when an copy-and-update record expression changes all fields of a record. + Raises warnings when 'let inline ... =' is used together with [<MethodImpl(MethodImplOptions.NoInlining)>] attribute. Function is not getting inlined. 当 "let inline ... =" 与 [<MethodImpl(MethodImplOptions.NoInlining)>] 属性一起使用时引发警告。函数未内联。 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index e0161fdf94..bd871bbba4 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -382,11 +382,19 @@ 現用模式的結構表示法 + + + Support for try-with in sequence expressions + Support for try-with in sequence expressions + + + Raises warnings when an copy-and-update record expression changes all fields of a record. Raises warnings when an copy-and-update record expression changes all fields of a record. + Raises warnings when 'let inline ... =' is used together with [<MethodImpl(MethodImplOptions.NoInlining)>] attribute. Function is not getting inlined. 當 'let inline ... =' 與 [<MethodImpl(MethodImplOptions.NoInlining)>] 屬性一起使用時引發警告。函數未內嵌。 diff --git a/src/FSharp.Core/seqcore.fs b/src/FSharp.Core/seqcore.fs index dcfda570ba..d5426d4ffe 100644 --- a/src/FSharp.Core/seqcore.fs +++ b/src/FSharp.Core/seqcore.fs @@ -387,6 +387,70 @@ module RuntimeHelpers = let EnumerateThenFinally (source: seq<'T>) (compensation: unit -> unit) = (FinallyEnumerable(compensation, (fun () -> source)) :> seq<_>) + + let EnumerateTryWith (source : seq<'T>) (exceptionFilter:exn -> int) (exceptionHandler:exn -> seq<'T>) = + let originalSource = lazy(source.GetEnumerator()) + let mutable shouldDisposeOriginalAtTheEnd = true + let mutable exceptionalSource : IEnumerator<'T> option = None + + let current() = + match exceptionalSource with + | Some es -> es.Current + | None -> originalSource.Value.Current + + let disposeOriginal() = + if shouldDisposeOriginalAtTheEnd = true then + shouldDisposeOriginalAtTheEnd <- false + originalSource.Value.Dispose() + + let moveExceptionHandler(exn) = + exceptionalSource <- Some ((exceptionHandler exn).GetEnumerator()) + exceptionalSource.Value.MoveNext() + + let tryIfDisposalLeadsToExceptionHandlerSeq() = + try + disposeOriginal() + false + with + | e when exceptionFilter e = 1 -> moveExceptionHandler(e) + + (mkSeq (fun () -> + { new IEnumerator<_> with + member x.Current = current() + + interface IEnumerator with + member x.Current = box (current()) + + [] + member x.MoveNext() = + match exceptionalSource with + | Some es -> es.MoveNext() + | None -> + try + let hasNext = originalSource.Value.MoveNext() + if not hasNext then + // What if Moving does not fail, but Disposing does? + // In that case, the 'when' guards could actually produce new elements to by yielded + // Let's try it. If the Dispose() call below fails and gets caught by the guards, enumeration might continue + disposeOriginal() + hasNext + with + // Try .Dispose() original. If that fails && also matches with guards, let's use the exn from. Dispose() call for next enumeration + | _ when tryIfDisposalLeadsToExceptionHandlerSeq() -> true + // We go here when either original's disposal not fail, or failed but with an unmatched exception + | e when exceptionFilter e = 1 -> moveExceptionHandler(e) + + member x.Reset() = IEnumerator.noReset() + + interface System.IDisposable with + member x.Dispose() = + match exceptionalSource with + | Some es -> es.Dispose() + // We are no longer at a phase where anyone should be calling .MoveNext() + // This will only happen if someone is doing MoveNext()+Dispose() calls manually and decides to .Dispose() before + // Enumeration has finished. In this case, we do NOT invoke the exception handlers for the .Dispose() call + | None -> disposeOriginal()})) + let CreateEvent (addHandler : 'Delegate -> unit) (removeHandler : 'Delegate -> unit) (createHandler : (obj -> 'Args -> unit) -> 'Delegate ) :IEvent<'Delegate,'Args> = { new obj() with member x.ToString() = "" diff --git a/src/FSharp.Core/seqcore.fsi b/src/FSharp.Core/seqcore.fsi index 701a92fc70..4753eebabd 100644 --- a/src/FSharp.Core/seqcore.fsi +++ b/src/FSharp.Core/seqcore.fsi @@ -84,6 +84,17 @@ module RuntimeHelpers = /// The result sequence. val EnumerateThenFinally: source: seq<'T> -> compensation: (unit -> unit) -> seq<'T> + /// The F# compiler emits calls to this function to + /// implement the try/with operator for F# sequence expressions. + /// + /// The input sequence. + /// Pattern matches after 'when' converted to return 1 + /// Pattern matches after 'when' with their actual execution code + /// + /// The result sequence. + val EnumerateTryWith: + source: seq<'T> -> exceptionFilter: (exn -> int) -> exceptionHandler: (exn -> seq<'T>) -> seq<'T> + /// The F# compiler emits calls to this function to implement the compiler-intrinsic /// conversions from untyped IEnumerable sequences to typed sequences. /// diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index f2e4de6576..9f8f23b83c 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -178,6 +178,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/Language/SequenceExpressionTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/SequenceExpressionTests.fs new file mode 100644 index 0000000000..5542717a94 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Language/SequenceExpressionTests.fs @@ -0,0 +1,444 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module FSharp.Compiler.ComponentTests.Language.SequenceExpressionTests + +open Xunit +open FSharp.Test.Compiler + + + +let fsiSession = getSessionForEval() + +let runCode = evalInSharedSession fsiSession + +[] +let ``Basic recursive case uses tail. recursion``() = + Fsx """ +let rec f () = seq { + try + yield 123 + yield (456/0) + with pat -> + yield 789 + yield! f() +} + """ + |> withLangVersionPreview + |> compile + |> verifyIL [" + .class auto ansi serializable sealed nested assembly beforefieldinit 'f@3-1' + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> + { + .field static assembly initonly class Test/'f@3-1' @_instance + .method assembly specialname rtspecialname + instance void .ctor() cil managed + { + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>::.ctor() + IL_0006: ret + } + + .method public strict virtual instance class [runtime]System.Collections.Generic.IEnumerable`1 + Invoke(class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed + { + + .maxstack 8 + IL_0000: ldc.i4.s 123 + IL_0002: call class [runtime]System.Collections.Generic.IEnumerable`1 [FSharp.Core]Microsoft.FSharp.Collections.SeqModule::Singleton(!!0) + IL_0007: ldsfld class Test/'f@5-2' Test/'f@5-2'::@_instance + IL_000c: call class [runtime]System.Collections.Generic.IEnumerable`1 [FSharp.Core]Microsoft.FSharp.Collections.SeqModule::Delay(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>) + IL_0011: tail. + IL_0013: call class [runtime]System.Collections.Generic.IEnumerable`1 [FSharp.Core]Microsoft.FSharp.Collections.SeqModule::Append(class [runtime]System.Collections.Generic.IEnumerable`1, + class [runtime]System.Collections.Generic.IEnumerable`1) + IL_0018: ret + } "] + +[] +let ``A seq{try/with} happy path with multiple language elements``() = + Fsx """ +let rec mySeq inputEnumerable = + seq { + for x in inputEnumerable do + try + match x with + | 0 -> yield 1 // - Single value + | 1 -> yield! (mySeq [0;3;6]) // - Recursion + | 2 -> () // - Empty + | 3 -> failwith "This should get caught!" // - Generic exn throw + | 4 -> yield (4/0) // - Specific exn throw + | 5 -> + yield 5 // - Two yields, will be a state machine + yield 5 + | _ -> failwith "This should get caught!" + with + | :? System.DivideByZeroException -> yield 4 // - Specific exn + | anyOther when x = 3 -> yield 3 // - Generic exn using 'x', no yield + | anyOther when x = 6 -> () // - Empty yield from 'with' clause + } + +if (mySeq [0..5] |> Seq.sum) <> (1+(1+3)+3+4+5+5) then + failwith $"Sum was {(mySeq [0..5] |> Seq.sum)} instead" + """ + |> runCode + |> shouldSucceed + +[] +let ``Inner try-finally's Dispose is executed before yielding from outer try-with``() = + Fsx """ +let mutable l = [] +let s() = seq { + try + try + l <- "Before try" :: l + yield (1/0) + l <- "After crash should never happen" :: l + finally + l <- "Inside finally" :: l + with ex when (l <- "Inside with pattern" :: l;true) -> + l <- "Inside with body" :: l + yield 1 + l <- "End of with body" :: l +} +l <- "Before sum" :: l +let totalSum = s() |> Seq.sum +l <- "After sum" :: l +if totalSum <> 1 then + failwith $"Sum was {{totalSum}} instead" + +l <- List.rev l +let expectedList = + [ "Before sum" // Seq is lazy, so we do not expect anything until iteration starts + "Before try" + "Inside finally" + "Inside with pattern" + "Inside with pattern" // Yes indeed, the exn matching pattern is executed twice + "Inside with body" + "End of with body" + "After sum"] +if l<> expectedList then + failwith $" List is %A{l}" + """ + |> runCode + |> shouldSucceed + +[] +[] +[] +[] +let ``A sequence expression can recurse itself from with clause``(recLevel:int) = + Fsx $""" +let rec f () = seq {{ + try + yield 1 + yield (1/0) + with pat -> + yield! f() +}} +let topNsum = f() |> Seq.take {recLevel} |> Seq.sum +if topNsum <> {recLevel} then + failwith $"Sum was {{topNsum}} instead" + """ + |> runCode + |> shouldSucceed + +[] +let ``A sequence expression can yield from with clause``() = + Fsx """ +let sum = + seq { + for x in [0;1] do + try + yield (10 / x) + with _ -> + yield 100 + } + |> Seq.sum +if sum <> 110 then + failwith $"Sum was {sum} instead" + """ + |> runCode + |> shouldSucceed + +[] +let ``A sequence expression can have try-with around foreach``() = + Fsx """ +let mySeq (providedInput: seq) = + seq { + try + for x in providedInput do + yield (6 / x) + with _ -> + yield 100 + } +let mySum = (mySeq [3;2;1;0]) |> Seq.sum +if mySum <> (6/3 + 6/2 + 6/1 + 100) then + failwith $"Sum was {mySum} instead" + """ + |> runCode + |> shouldSucceed + +[] +let ``A sequence expression can have try-with around while``() = + Fsx """ +let mySeq () = + seq { + let mutable x = 3 + try + while true do + yield (6/x) + x <- x-1 + with _ -> + yield 100 + } +let mySum = (mySeq () |> Seq.truncate 10) |> Seq.sum +if mySum <> (6/3 + 6/2 + 6/1 + 100) then + failwith $"Sum was {mySum} instead" + """ + |> runCode + |> shouldSucceed + +[] +let ``A sequence expression can yield! from with clause``() = + Fsx """ +let sum = + seq { + for x in [0;1] do + try + yield (10 / x) + with _ -> + yield! seq{1;2;3} + } + |> Seq.sum +if sum <> 16 then + failwith $"Sum was {sum} instead" + """ + |> runCode + |> shouldSucceed + +[] +let ``A sequence expression can fail later in try/with and still get caught``() = + Fsx """ +let sum = + seq { + try + yield 1 + yield 2 + yield 3 + yield (10/0) // This will crash + yield 4 // This will never be reached + with _ -> () + } + |> Seq.sum +if sum <> (1+2+3) then + failwith $"Sum was {sum} instead" + """ + |> runCode + |> shouldSucceed + +[] +let ``A sequence expression can have inner seq{try/with} in an outer try/with``() = + Fsx """ +let sum = + seq { + try + yield 1 + yield! seq{ try (10 / 0) with _ -> 1} + yield 1 + with _ -> yield 100000 // will not get hit, covered by inner 'with' + } + |> Seq.sum +if sum <> (1+1+1) then + failwith $"Sum was {sum} instead" + """ + |> runCode + |> shouldSucceed + +[] +let ``A sequence expression can do multiple yields from try/with clause``() = + Fsx """ +let sum = + seq { + for x in [0;1] do + try + yield 1 // Should work both times before failure + yield (10/x) // Will crash for 0 + yield 2 // Will only get there for 1 + with _ -> + yield 100 + yield 100 + } + |> Seq.sum +if sum <> (1+100+100+1+10+2) then + failwith $"Sum was {sum} instead" + """ + |> runCode + |> shouldSucceed + +[] +let ``A sequence expression can yield from try and have empty with``() = + Fsx """ +let sum = + seq { + for x in [1;0] do + try + yield (10 / x) + with _ -> + printfn "Crash" + } + |> Seq.sum +if sum <> 10 then + failwith $"Sum was {sum} instead" + """ + |> runCode + |> shouldSucceed + +[] +let ``A sequence expression can yield from with and have empty try``() = + Fsx """ +let sum = + seq { + for x in [1;0] do + try + let result = (10 / x) + printfn "%A" result + with _ -> + yield 100 + } + |> Seq.sum +if sum <> 100 then + failwith $"Sum was {sum} instead" + """ + |> runCode + |> shouldSucceed + + +[] +let ``A sequence expression can have implicit yields in try-with``() = + Fsx """ +let sum = + seq { + for x in [0;1] do + try + (10 / x) + with _ -> + 100 + } + |> Seq.sum +if sum <> 110 then + failwith $"Sum was {sum} instead" + """ + |> runCode + |> shouldSucceed + +[] +[] +[] +[] +[] +let ``Propper type matching in seq{try/with} with implicit yield``(valInTry,valInWith1,valInWith2) = + Fsx $""" +let typedSeq = + seq {{ + for x in [0;1] do + try + %s{valInTry} + with + |_ when x = 0 -> %s{valInWith1} + |_ when x = 0 -> %s{valInWith2} + }} + """ + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + +[] +[] +[] +let ``seq{try/with} using yield or implicit must be consistent``(valInTry,valInWith1,valInWith2) = + Fsx $""" +let typedSeq = + seq {{ + for x in [0;1] do + try + %s{valInTry} + with + |_ when x = 0 -> %s{valInWith1} + |_ when x = 0 -> %s{valInWith2} + }} + """ + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + +[] +[] +[] +let ``seq{try/with} mismatch implicit vs yield``(valInTry,valInWith1,valInWith2) = + Fsx $""" +let typedSeq = + seq {{ + for x in [0;1] do + try + %s{valInTry} + with + |_ when x = 0 -> %s{valInWith1} + |_ when x = 0 -> %s{valInWith2} + }} + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withDiagnosticMessageMatches "This expression returns a value of type 'int' but is implicitly discarded." + |> withDiagnosticMessageMatches "If you intended to use the expression as a value in the sequence then use an explicit 'yield'." + +[] +[] +[] +[] +let ``Type mismatch error in seq{try/with}``(valInTry,valInWith1,valInWith2) = + Fsx $""" +let typedSeq = + seq {{ + for x in [0;1] do + try + %s{valInTry} + with + |_ when x = 0 -> %s{valInWith1} + |_ when x = 0 -> %s{valInWith2} + }} + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withErrorCode 193 + |> withDiagnosticMessageMatches "Type constraint mismatch" + + +[] +let printCode = """ printfn "Hello there" """ + +[] +[] +[] +let ``Missing result type in seq{try/with}``(valInTry,valInWith1,valInWith2) = + Fsx $""" +let typedSeq = + seq {{ + for x in [0;1] do + try + %s{valInTry} + with + |_ when x = 0 -> %s{valInWith1} + |_ when x = 0 -> %s{valInWith2} + }} + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withErrorCode 30 + |> withDiagnosticMessageMatches "Value restriction. The value 'typedSeq' has been inferred to have generic type" + \ No newline at end of file diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.debug.bsl b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.debug.bsl index b0ec5cbb92..0a8deb3619 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.debug.bsl +++ b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.debug.bsl @@ -844,6 +844,7 @@ Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: Microsoft.FSharp.Control. Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[TResult] EnumerateFromFunctions[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult]) Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[TResult] EnumerateUsing[T,TCollection,TResult](T, Microsoft.FSharp.Core.FSharpFunc`2[T,TCollection]) Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[T] EnumerateThenFinally[T](System.Collections.Generic.IEnumerable`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) +Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[T] EnumerateTryWith[T](System.Collections.Generic.IEnumerable`1[T], Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,System.Int32], Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,System.Collections.Generic.IEnumerable`1[T]]) Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[T] EnumerateWhile[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,System.Boolean], System.Collections.Generic.IEnumerable`1[T]) Microsoft.FSharp.Core.CompilerServices.SetStateMachineMethodImpl`1[TData]: System.IAsyncResult BeginInvoke(Microsoft.FSharp.Core.CompilerServices.ResumableStateMachine`1[TData] ByRef, System.Runtime.CompilerServices.IAsyncStateMachine, System.AsyncCallback, System.Object) Microsoft.FSharp.Core.CompilerServices.SetStateMachineMethodImpl`1[TData]: Void .ctor(System.Object, IntPtr) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.release.bsl b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.release.bsl index bb1dd5db9d..ed33af7f83 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.release.bsl +++ b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.release.bsl @@ -844,6 +844,7 @@ Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: Microsoft.FSharp.Control. Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[TResult] EnumerateFromFunctions[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult]) Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[TResult] EnumerateUsing[T,TCollection,TResult](T, Microsoft.FSharp.Core.FSharpFunc`2[T,TCollection]) Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[T] EnumerateThenFinally[T](System.Collections.Generic.IEnumerable`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) +Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[T] EnumerateTryWith[T](System.Collections.Generic.IEnumerable`1[T], Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,System.Int32], Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,System.Collections.Generic.IEnumerable`1[T]]) Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[T] EnumerateWhile[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,System.Boolean], System.Collections.Generic.IEnumerable`1[T]) Microsoft.FSharp.Core.CompilerServices.SetStateMachineMethodImpl`1[TData]: System.IAsyncResult BeginInvoke(Microsoft.FSharp.Core.CompilerServices.ResumableStateMachine`1[TData] ByRef, System.Runtime.CompilerServices.IAsyncStateMachine, System.AsyncCallback, System.Object) Microsoft.FSharp.Core.CompilerServices.SetStateMachineMethodImpl`1[TData]: Void .ctor(System.Object, IntPtr) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.debug.bsl b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.debug.bsl index 028a4fee29..b20fac9a79 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.debug.bsl +++ b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.debug.bsl @@ -845,6 +845,7 @@ Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: Microsoft.FSharp.Control. Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[TResult] EnumerateFromFunctions[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult]) Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[TResult] EnumerateUsing[T,TCollection,TResult](T, Microsoft.FSharp.Core.FSharpFunc`2[T,TCollection]) Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[T] EnumerateThenFinally[T](System.Collections.Generic.IEnumerable`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) +Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[T] EnumerateTryWith[T](System.Collections.Generic.IEnumerable`1[T], Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,System.Int32], Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,System.Collections.Generic.IEnumerable`1[T]]) Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[T] EnumerateWhile[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,System.Boolean], System.Collections.Generic.IEnumerable`1[T]) Microsoft.FSharp.Core.CompilerServices.SetStateMachineMethodImpl`1[TData]: System.IAsyncResult BeginInvoke(Microsoft.FSharp.Core.CompilerServices.ResumableStateMachine`1[TData] ByRef, System.Runtime.CompilerServices.IAsyncStateMachine, System.AsyncCallback, System.Object) Microsoft.FSharp.Core.CompilerServices.SetStateMachineMethodImpl`1[TData]: Void .ctor(System.Object, IntPtr) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.release.bsl b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.release.bsl index 029951a590..a4701146aa 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.release.bsl +++ b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.release.bsl @@ -845,6 +845,7 @@ Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: Microsoft.FSharp.Control. Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[TResult] EnumerateFromFunctions[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult]) Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[TResult] EnumerateUsing[T,TCollection,TResult](T, Microsoft.FSharp.Core.FSharpFunc`2[T,TCollection]) Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[T] EnumerateThenFinally[T](System.Collections.Generic.IEnumerable`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) +Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[T] EnumerateTryWith[T](System.Collections.Generic.IEnumerable`1[T], Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,System.Int32], Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,System.Collections.Generic.IEnumerable`1[T]]) Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers: System.Collections.Generic.IEnumerable`1[T] EnumerateWhile[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,System.Boolean], System.Collections.Generic.IEnumerable`1[T]) Microsoft.FSharp.Core.CompilerServices.SetStateMachineMethodImpl`1[TData]: System.IAsyncResult BeginInvoke(Microsoft.FSharp.Core.CompilerServices.ResumableStateMachine`1[TData] ByRef, System.Runtime.CompilerServices.IAsyncStateMachine, System.AsyncCallback, System.Object) Microsoft.FSharp.Core.CompilerServices.SetStateMachineMethodImpl`1[TData]: Void .ctor(System.Object, IntPtr) diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index dee735dff4..ca4065f6b1 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -787,11 +787,8 @@ module rec Compiler = let compileExeAndRun = asExe >> compileAndRun - let private evalFSharp (fs: FSharpCompilationSource) : CompilationResult = + let private evalFSharp (fs: FSharpCompilationSource) (script:FSharpScript) : CompilationResult = let source = fs.Source.GetSourceText |> Option.defaultValue "" - let options = fs.Options |> Array.ofList - - use script = new FSharpScript(additionalArgs=options) let (evalResult: Result), (err: FSharpDiagnostic[]) = script.Eval(source) let diagnostics = err |> fromFSharpDiagnostic let result = @@ -811,7 +808,17 @@ module rec Compiler = let eval (cUnit: CompilationUnit) : CompilationResult = match cUnit with - | FS fs -> evalFSharp fs + | FS fs -> + let options = fs.Options |> Array.ofList + use script = new FSharpScript(additionalArgs=options) + evalFSharp fs script + | _ -> failwith "Script evaluation is only supported for F#." + + let getSessionForEval () = new FSharpScript() + + let evalInSharedSession (script:FSharpScript) (cUnit: CompilationUnit) : CompilationResult = + match cUnit with + | FS fs -> evalFSharp fs script | _ -> failwith "Script evaluation is only supported for F#." let runFsi (cUnit: CompilationUnit) : CompilationResult = @@ -1175,6 +1182,10 @@ module rec Compiler = match r.Output with | Some (ExecutionOutput output) -> sprintf "----output-----\n%s\n----error-------\n%s\n----------" output.StdOut output.StdErr + | Some (EvalOutput (Result.Error exn) ) -> + sprintf "----script error-----\n%s\n----------" (exn.ToString()) + | Some (EvalOutput (Result.Ok fsiVal) ) -> + sprintf "----script output-----\n%A\n----------" (fsiVal) | _ -> () ] |> String.concat "\n" failwith message