From b9d1bc3a47ea769f4619b0c1b091ee2b656eb6cb Mon Sep 17 00:00:00 2001 From: Andrii Kurdiumov Date: Mon, 14 Nov 2022 00:07:29 +0600 Subject: [PATCH 01/14] Unignore test (#14303) --- tests/fsharp/tests.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index e1ec4ad346d..d0a664d7cc5 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -72,7 +72,7 @@ module CoreTests = [] let ``array-no-dot-FSC_OPTIMIZED`` () = singleTestBuildAndRunVersion "core/array-no-dot" FSC_OPTIMIZED "preview" - [] + [] let ``array-no-dot-FSI`` () = singleTestBuildAndRunVersion "core/array-no-dot" FSI "preview" [] From e2f3a3e0ee713597d592647a343d2547eae363ac Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Sun, 13 Nov 2022 19:09:18 +0100 Subject: [PATCH 02/14] No errors for non-virtual members overrides (#14263) * No errors for non virtual members overrides * Check for isFSharpObjModelTy as we are interested on csharp virtual methods * More testing * Add a feature lang preview * More testing * Fix PR comment --- src/Compiler/Checking/CheckExpressions.fs | 25 +- src/Compiler/FSComp.txt | 1 + src/Compiler/Facilities/LanguageFeatures.fs | 3 + src/Compiler/Facilities/LanguageFeatures.fsi | 1 + src/Compiler/xlf/FSComp.txt.cs.xlf | 5 + src/Compiler/xlf/FSComp.txt.de.xlf | 5 + src/Compiler/xlf/FSComp.txt.es.xlf | 5 + src/Compiler/xlf/FSComp.txt.fr.xlf | 5 + src/Compiler/xlf/FSComp.txt.it.xlf | 5 + src/Compiler/xlf/FSComp.txt.ja.xlf | 5 + src/Compiler/xlf/FSComp.txt.ko.xlf | 5 + src/Compiler/xlf/FSComp.txt.pl.xlf | 5 + src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 5 + src/Compiler/xlf/FSComp.txt.ru.xlf | 5 + src/Compiler/xlf/FSComp.txt.tr.xlf | 5 + src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 5 + src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 5 + .../ErrorMessages/ClassesTests.fs | 424 +++++++++++++++++- 18 files changed, 512 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 48fee010206..043502372c2 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -10950,7 +10950,7 @@ and ComputeIsComplete enclosingDeclaredTypars declaredTypars ty = /// Determine if a uniquely-identified-abstract-slot exists for an override member (or interface member implementation) based on the information available /// at the syntactic definition of the member (i.e. prior to type inference). If so, we know the expected signature of the override, and the full slotsig /// it implements. Apply the inferred slotsig. -and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (argsAndRetTy, m, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, _objTy, intfSlotTyOpt, valSynData, memberFlags: SynMemberFlags, attribs) = +and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (baseValOpt: Val option) (argsAndRetTy, m, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, intfSlotTyOpt, valSynData, memberFlags: SynMemberFlags, attribs) = let g = cenv.g let ad = envinner.eAccessRights @@ -10997,7 +10997,21 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (argsAndRetTy, m, | _ -> [] // check that method to override is sealed is located at CheckOverridesAreAllUsedOnce (typrelns.fs) // We hit this case when it is ambiguous which abstract method is being implemented. - + if g.langVersion.SupportsFeature(LanguageFeature.ErrorForNonVirtualMembersOverrides) then + // Checks if the declaring type inherits from a base class and is not FSharpObjModelTy + // Raises an error if we try to override an non virtual member with the same name in both + match baseValOpt with + | Some ttype when not(isFSharpObjModelTy g ttype.Type) -> + match stripTyEqns g ttype.Type with + | TType_app(tyconRef, _, _) -> + let ilMethods = tyconRef.ILTyconRawMetadata.Methods.AsList() + let nameOpt = ilMethods |> List.tryFind(fun id -> id.Name = memberId.idText) + match nameOpt with + | Some name when not name.IsVirtual -> + errorR(Error(FSComp.SR.tcNoMemberFoundForOverride(), memberId.idRange)) + | _ -> () + | _ -> () + | _ -> () // If we determined a unique member then utilize the type information from the slotsig let declaredTypars = @@ -11159,14 +11173,14 @@ and AnalyzeRecursiveStaticMemberOrValDecl CheckForNonAbstractInterface declKind tcref memberFlags id.idRange let isExtrinsic = (declKind = ExtrinsicExtensionBinding) - let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy, _ = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars + let tcrefObjTy, enclosingDeclaredTypars, renaming, _, _ = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner let envinner = MakeInnerEnvForTyconRef envinner tcref isExtrinsic let (ExplicitTyparInfo(_, declaredTypars, infer)) = explicitTyparInfo let optInferredImplSlotTys, declaredTypars = - ApplyAbstractSlotInference cenv envinner (ty, mBinding, synTyparDecls, declaredTypars, id, tcrefObjTy, renaming, objTy, intfSlotTyOpt, valSynInfo, memberFlags, bindingAttribs) + ApplyAbstractSlotInference cenv envinner None (ty, mBinding, synTyparDecls, declaredTypars, id, tcrefObjTy, renaming, intfSlotTyOpt, valSynInfo, memberFlags, bindingAttribs) let explicitTyparInfo = ExplicitTyparInfo(declaredTypars, declaredTypars, infer) @@ -11231,7 +11245,6 @@ and AnalyzeRecursiveStaticMemberOrValDecl | _ -> envinner, tpenv, id, None, None, vis, vis2, None, [], None, explicitTyparInfo, bindingRhs, declaredTypars - and AnalyzeRecursiveInstanceMemberDecl (cenv: cenv, envinner: TcEnv, @@ -11290,7 +11303,7 @@ and AnalyzeRecursiveInstanceMemberDecl // at the member signature. If so, we know the type of this member, and the full slotsig // it implements. Apply the inferred slotsig. let optInferredImplSlotTys, declaredTypars = - ApplyAbstractSlotInference cenv envinner (argsAndRetTy, mBinding, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, objTy, intfSlotTyOpt, valSynInfo, memberFlags, bindingAttribs) + ApplyAbstractSlotInference cenv envinner baseValOpt (argsAndRetTy, mBinding, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, intfSlotTyOpt, valSynInfo, memberFlags, bindingAttribs) // Update the ExplicitTyparInfo to reflect the declaredTypars inferred from the abstract slot let explicitTyparInfo = ExplicitTyparInfo(declaredTypars, declaredTypars, infer) diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 9c9da192081..53cfa341667 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1561,6 +1561,7 @@ featureInitProperties,"support for consuming init properties" featureLowercaseDUWhenRequireQualifiedAccess,"Allow lowercase DU when RequireQualifiedAccess attribute" featureMatchNotAllowedForUnionCaseWithNoData,"Pattern match discard is not allowed for union case that takes no data." featureCSharpExtensionAttributeNotRequired,"Allow implicit Extension attribute on declaring types, modules" +featureErrorForNonVirtualMembersOverrides,"Raises errors for non-virtual members overrides" 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." 3354,tcNotAFunctionButIndexerIndexingNotYetEnabled,"This expression supports indexing, e.g. 'expr.[index]'. The syntax 'expr[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 00ddd74b6c5..14302b05132 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -56,6 +56,7 @@ type LanguageFeature = | SelfTypeConstraints | MatchNotAllowedForUnionCaseWithNoData | CSharpExtensionAttributeNotRequired + | ErrorForNonVirtualMembersOverrides /// LanguageVersion management type LanguageVersion(versionText) = @@ -128,6 +129,7 @@ type LanguageVersion(versionText) = LanguageFeature.FromEndSlicing, previewVersion LanguageFeature.MatchNotAllowedForUnionCaseWithNoData, previewVersion LanguageFeature.CSharpExtensionAttributeNotRequired, previewVersion + LanguageFeature.ErrorForNonVirtualMembersOverrides, previewVersion ] @@ -237,6 +239,7 @@ type LanguageVersion(versionText) = | LanguageFeature.SelfTypeConstraints -> FSComp.SR.featureSelfTypeConstraints () | LanguageFeature.MatchNotAllowedForUnionCaseWithNoData -> FSComp.SR.featureMatchNotAllowedForUnionCaseWithNoData () | LanguageFeature.CSharpExtensionAttributeNotRequired -> FSComp.SR.featureCSharpExtensionAttributeNotRequired () + | LanguageFeature.ErrorForNonVirtualMembersOverrides -> FSComp.SR.featureErrorForNonVirtualMembersOverrides () /// Get a version string associated with the given feature. static member GetFeatureVersionString feature = diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index 1b3d68e8f2a..f471f371b95 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -46,6 +46,7 @@ type LanguageFeature = | SelfTypeConstraints | MatchNotAllowedForUnionCaseWithNoData | CSharpExtensionAttributeNotRequired + | ErrorForNonVirtualMembersOverrides /// LanguageVersion management type LanguageVersion = diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 8c4a1300a7f..2afccb1fd40 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -177,6 +177,11 @@ literál float32 bez tečky + + Raises errors for non-virtual members overrides + Raises errors for non-virtual members overrides + + give error on deprecated access of construct with RequireQualifiedAccess attribute chyba při zastaralém přístupu konstruktoru s atributem RequireQualifiedAccess diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 688592092e3..b0eec3044bc 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -177,6 +177,11 @@ punktloses float32-Literal + + Raises errors for non-virtual members overrides + Raises errors for non-virtual members overrides + + give error on deprecated access of construct with RequireQualifiedAccess attribute Beim veralteten Zugriff auf das Konstrukt mit dem RequireQualifiedAccess-Attribut wird ein Fehler ausgegeben. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index a06daa1f7f1..89d57eacb65 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -177,6 +177,11 @@ literal float32 sin punto + + Raises errors for non-virtual members overrides + Raises errors for non-virtual members overrides + + give error on deprecated access of construct with RequireQualifiedAccess attribute error en el acceso en desuso de la construcción con el atributo RequireQualifiedAccess diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index f8a89904bfa..2db2d58f88f 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -177,6 +177,11 @@ littéral float32 sans point + + Raises errors for non-virtual members overrides + Raises errors for non-virtual members overrides + + give error on deprecated access of construct with RequireQualifiedAccess attribute donner une erreur sur l’accès déconseillé de la construction avec l’attribut RequireQualifiedAccess diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 37d11b74636..66011450a6b 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -177,6 +177,11 @@ valore letterale float32 senza punti + + Raises errors for non-virtual members overrides + Raises errors for non-virtual members overrides + + give error on deprecated access of construct with RequireQualifiedAccess attribute errore durante l'accesso deprecato del costrutto con l'attributo RequireQualifiedAccess diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index c42700c1d18..0ba2173b8fc 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -177,6 +177,11 @@ ドットなしの float32 リテラル + + Raises errors for non-virtual members overrides + Raises errors for non-virtual members overrides + + give error on deprecated access of construct with RequireQualifiedAccess attribute RequireQualifiedAccess 属性を持つコンストラクトの非推奨アクセスでエラーが発生しました diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 39e9a33001e..e97d0cf2eb2 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -177,6 +177,11 @@ 점이 없는 float32 리터럴 + + Raises errors for non-virtual members overrides + Raises errors for non-virtual members overrides + + give error on deprecated access of construct with RequireQualifiedAccess attribute RequireQualifiedAccess 특성을 사용하여 사용되지 않는 구문 액세스에 대한 오류 제공 diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index e3a61d7dd58..d39b72ca26f 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -177,6 +177,11 @@ bezkropkowy literał float32 + + Raises errors for non-virtual members overrides + Raises errors for non-virtual members overrides + + give error on deprecated access of construct with RequireQualifiedAccess attribute wskazywanie błędu w przypadku przestarzałego dostępu do konstrukcji z atrybutem RequireQualifiedAccess diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 78742938012..09d70721f8a 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -177,6 +177,11 @@ literal float32 sem ponto + + Raises errors for non-virtual members overrides + Raises errors for non-virtual members overrides + + give error on deprecated access of construct with RequireQualifiedAccess attribute fornecer erro no acesso preterido do constructo com o atributo RequireQualifiedAccess diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 837271832bf..01249439e53 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -177,6 +177,11 @@ литерал float32 без точки + + Raises errors for non-virtual members overrides + Raises errors for non-virtual members overrides + + give error on deprecated access of construct with RequireQualifiedAccess attribute выдать ошибку при устаревшем доступе к конструкции с атрибутом RequireQualifiedAccess diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 59d04a3fe94..113d6a42396 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -177,6 +177,11 @@ noktasız float32 sabit değeri + + Raises errors for non-virtual members overrides + Raises errors for non-virtual members overrides + + give error on deprecated access of construct with RequireQualifiedAccess attribute RequireQualifiedAccess özniteliğine sahip yapının kullanım dışı erişiminde hata diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index ebcafbf1852..b6a766f9cd5 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -177,6 +177,11 @@ 无点 float32 文本 + + Raises errors for non-virtual members overrides + Raises errors for non-virtual members overrides + + give error on deprecated access of construct with RequireQualifiedAccess attribute 对具有 RequireQualifiedAccess 属性的构造进行弃用的访问时出错 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 0606b9b48c4..f404d766e1c 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -177,6 +177,11 @@ 無點號的 float32 常值 + + Raises errors for non-virtual members overrides + Raises errors for non-virtual members overrides + + give error on deprecated access of construct with RequireQualifiedAccess attribute 對具有 RequireQualifiedAccess 屬性的建構的已取代存取發出錯誤 diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ClassesTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ClassesTests.fs index 621307f4e66..eeb3ab1d371 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ClassesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ClassesTests.fs @@ -120,4 +120,426 @@ type X() = |> withDiagnostics [ (Error 531, Line 4, Col 5, Line 4, Col 12, "Accessibility modifiers should come immediately prior to the identifier naming a construct") (Error 512, Line 4, Col 13, Line 4, Col 18, "Accessibility modifiers are not permitted on 'do' bindings, but 'Private' was given.") - (Error 222, Line 2, Col 1, Line 3, Col 1, "Files in libraries or multiple-file applications must begin with a namespace or module declaration, e.g. 'namespace SomeNamespace.SubNamespace' or 'module SomeNamespace.SomeModule'. Only the last source file of an application may omit such a declaration.")] + (Error 222, Line 2, Col 1, Line 3, Col 1, "Files in libraries or multiple-file applications must begin with a namespace or module declaration, e.g. 'namespace SomeNamespace.SubNamespace' or 'module SomeNamespace.SomeModule'. Only the last source file of an application may omit such a declaration.") + ] + + [] + let ``No abstract or interface member was found that corresponds to this override with lang preview``() = + Fsx """ +type A = + abstract member M1: unit -> unit + abstract member M2: unit -> unit + abstract member M3: unit -> unit + abstract member M4: unit -> unit + +type B() = + interface A with + override this.M1() = () + override this.M2() = () // error is expected + override this.M3() = () // error is expected + override this.M4() = () + +type C() = + inherit B() + override this.M1() = () + override this.M2() = () + override this.M3() = () + override this.M4() = () + member this.M5() = () + """ + |> withLangVersionPreview + |> compile + |> shouldFail + |> withDiagnostics [ + (Error 855, Line 17, Col 19, Line 17, Col 21, "No abstract or interface member was found that corresponds to this override") + (Error 855, Line 18, Col 19, Line 18, Col 21, "No abstract or interface member was found that corresponds to this override") + (Error 855, Line 19, Col 19, Line 19, Col 21, "No abstract or interface member was found that corresponds to this override") + (Error 855, Line 20, Col 19, Line 20, Col 21, "No abstract or interface member was found that corresponds to this override") + ] + + [] + let ``No abstract or interface member was found that corresponds to this override with lang version70``() = + Fsx """ +type A = + abstract member M1: unit -> unit + abstract member M2: unit -> unit + abstract member M3: unit -> unit + abstract member M4: unit -> unit + +type B() = + interface A with + override this.M1() = () + override this.M2() = () // error is expected + override this.M3() = () // error is expected + override this.M4() = () + +type C() = + inherit B() + override this.M1() = () + override this.M2() = () + override this.M3() = () + override this.M4() = () + member this.M5() = () + """ + |> withLangVersion70 + |> compile + |> shouldFail + |> withDiagnostics [ + (Error 855, Line 17, Col 19, Line 17, Col 21, "No abstract or interface member was found that corresponds to this override") + (Error 855, Line 18, Col 19, Line 18, Col 21, "No abstract or interface member was found that corresponds to this override") + (Error 855, Line 19, Col 19, Line 19, Col 21, "No abstract or interface member was found that corresponds to this override") + (Error 855, Line 20, Col 19, Line 20, Col 21, "No abstract or interface member was found that corresponds to this override") + ] + + [] + let ``Virtual member was found that corresponds to this override with lang version70`` () = + let CSLib = + CSharp """ +public class A +{ + public virtual void M1() { } + public virtual void M2() { } + public virtual void M3() { } + public virtual void M4() { } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ClassTests +type B() = + inherit A() + override this.M1() = () + override this.M2() = () + override this.M3() = () + override this.M4() = () + member this.M5() = () + """ |> withReferences [CSLib] + app + |> withLangVersion70 + |> compile + |> shouldSucceed + + [] + let ``Virtual member was found that corresponds to this override with lang preview`` () = + let CSLib = + CSharp """ +public class A +{ + public virtual void M1() { } + public virtual void M2() { } + public virtual void M3() { } + public virtual void M4() { } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ClassTests +type B() = + inherit A() + override this.M1() = () + override this.M2() = () + override this.M3() = () + override this.M4() = () + member this.M5() = () + """ |> withReferences [CSLib] + app + |> withLangVersionPreview + |> compile + |> shouldSucceed + + + [] + let ``Virtual member was not found that corresponds to this override simple base class with lang version preview`` () = + let CSLib = + CSharp """ +public class A +{ + public virtual void M1() { } + public void M2() { } + public virtual void M3() { } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ClassTests +type B() = + inherit A() + + override this.M1() = () + override this.M2() = () // error expected + override this.M3() = () + member this.M4() = () + """ |> withReferences [CSLib] + app + |> withLangVersionPreview + |> compile + |> shouldFail + |> withDiagnostics [ + (Error 855, Line 7, Col 19, Line 7, Col 21, "No abstract or interface member was found that corresponds to this override") + ] + + [] + let ``Virtual member was not found that corresponds to this override simple base class with lang version70`` () = + let CSLib = + CSharp """ +public class A +{ + public virtual void M1() { } + public void M2() { } + public virtual void M3() { } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ClassTests +type B() = + inherit A() + + override this.M1() = () + override this.M2() = () + override this.M3() = () + member this.M4() = () + """ |> withReferences [CSLib] + app + |> withLangVersion70 + |> compile + |> shouldFail + |> withDiagnostics [ + (Error 855, Line 7, Col 19, Line 7, Col 21, "No abstract or interface member was found that corresponds to this override") + ] + + [] + let ``Virtual member was not found that corresponds to this override nested base class with lang version preview`` () = + let CSLib = + CSharp """ +public class A +{ + public virtual void M1() { } + public virtual void M2() { } + public virtual void M3() { } + public virtual void M4() { } +} + +public class B : A +{ + public override void M1() { } + public void M2() { } + public new void M3() { } + public new virtual void M4() { } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ClassTests +type C() = + inherit B() + + override this.M1() = () + override this.M2() = () // error expected + override this.M3() = () // error expected + override this.M4() = () + member this.M5() = () + """ |> withReferences [CSLib] + app + |> withLangVersionPreview + |> compile + |> shouldFail + |> withDiagnostics [ + (Error 855, Line 7, Col 19, Line 7, Col 21, "No abstract or interface member was found that corresponds to this override") + (Error 855, Line 8, Col 19, Line 8, Col 21, "No abstract or interface member was found that corresponds to this override") + ] + + [] + let ``Virtual member was not found that corresponds to this override nested base class with lang version70`` () = + let CSLib = + CSharp """ +public class A +{ + public virtual void M1() { } + public virtual void M2() { } + public virtual void M3() { } + public virtual void M4() { } +} + +public class B : A +{ + public override void M1() { } + public void M2() { } + public new void M3() { } + public new virtual void M4() { } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ClassTests +type C() = + inherit B() + + override this.M1() = () + override this.M2() = () // error expected + override this.M3() = () // error expected + override this.M4() = () + member this.M5() = () + """ |> withReferences [CSLib] + app + |> withLangVersion70 + |> compile + |> shouldSucceed + + [] + let ``Virtual member was not found that corresponds to this override nested 2 base class with lang preview`` () = + let CSLib = + CSharp """ +public class A +{ + public virtual void M1() { } + public virtual void M2() { } + public virtual void M3() { } + public virtual void M4() { } +} + +public class B : A +{ + public void M2() { } + public new void M3() { } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ClassTests +type C() = + inherit B() + + override this.M1() = () + override this.M2() = () // error is expected + override this.M3() = () // error is expected + override this.M4() = () + member this.M5() = () + """ |> withReferences [CSLib] + app + |> withLangVersionPreview + |> compile + |> shouldFail + |> withDiagnostics [ + (Error 855, Line 7, Col 19, Line 7, Col 21, "No abstract or interface member was found that corresponds to this override") + (Error 855, Line 8, Col 19, Line 8, Col 21, "No abstract or interface member was found that corresponds to this override") + ] + + [] + let ``Virtual member was not found that corresponds to this override nested 2 base classes with lang version70`` () = + let CSLib = + CSharp """ +public class A +{ + public virtual void M1() { } + public virtual void M2() { } + public virtual void M3() { } + public virtual void M4() { } +} + +public class B : A +{ + public void M2() { } + public new void M3() { } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ClassTests +type C() = + inherit B() + + override this.M1() = () + override this.M2() = () // error is expected + override this.M3() = () // error is expected + override this.M4() = () + member this.M5() = () + """ |> withReferences [CSLib] + app + |> withLangVersion70 + |> compile + |> shouldSucceed + + [] + let ``Virtual member was not found that corresponds to this override nested 2 base classes and mixed methods with lang preview`` () = + let CSLib = + CSharp """ +public class A +{ + public virtual void M1() { } + public void M2() { } +} + +public class B : A +{ + public virtual void M3() { } + public new void M4() { } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ClassTests +type C() = + inherit B() + + override this.M1() = () + override this.M2() = () // error is expected + override this.M3() = () + override this.M4() = () // error is expected + member this.M5() = () + """ |> withReferences [CSLib] + app + |> withLangVersionPreview + |> compile + |> shouldFail + |> withDiagnostics [ + (Error 855, Line 7, Col 19, Line 7, Col 21, "No abstract or interface member was found that corresponds to this override") + (Error 855, Line 9, Col 19, Line 9, Col 21, "No abstract or interface member was found that corresponds to this override") + ] + + [] + let ``Virtual member was not found that corresponds to this override nested 2 base classes and mixed methods with lang version70`` () = + let CSLib = + CSharp """ +public class A +{ + public virtual void M1() { } + public void M2() { } +} + +public class B : A +{ + public virtual void M3() { } + public new void M4() { } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ClassTests +type C() = + inherit B() + + override this.M1() = () + override this.M2() = () // error is expected + override this.M3() = () + override this.M4() = () // error is expected + member this.M5() = () + """ |> withReferences [CSLib] + app + |> withLangVersion70 + |> compile + |> shouldFail + |> withDiagnostics [ + (Error 855, Line 7, Col 19, Line 7, Col 21, "No abstract or interface member was found that corresponds to this override") + (Error 855, Line 9, Col 19, Line 9, Col 21, "No abstract or interface member was found that corresponds to this override") + ] \ No newline at end of file From 80a23ee4dc012a785b3c41449481903394ee7be0 Mon Sep 17 00:00:00 2001 From: "Kevin Ransom (msft)" Date: Mon, 14 Nov 2022 04:11:07 -0800 Subject: [PATCH 03/14] debug fsharpqa tests (#14298) --- .../CompilerOptions/fsc/debug.fs | 42 +++++++++++++++++++ .../FSharp.Compiler.ComponentTests.fsproj | 1 + tests/FSharp.Test.Utilities/Compiler.fs | 24 +++++++++++ .../CompilerOptions/fsc/debug/debug01.fs | 37 ---------------- .../CompilerOptions/fsc/debug/debug02.fs | 37 ---------------- .../Source/CompilerOptions/fsc/debug/env.lst | 2 - .../ObjectConstructors/env.lst | 2 +- tests/fsharpqa/Source/test.lst | 19 ++++----- 8 files changed, 76 insertions(+), 88 deletions(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/debug.fs delete mode 100644 tests/fsharpqa/Source/CompilerOptions/fsc/debug/debug01.fs delete mode 100644 tests/fsharpqa/Source/CompilerOptions/fsc/debug/debug02.fs delete mode 100644 tests/fsharpqa/Source/CompilerOptions/fsc/debug/env.lst diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/debug.fs b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/debug.fs new file mode 100644 index 00000000000..335566ef175 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/debug.fs @@ -0,0 +1,42 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.ComponentTests.CompilerOptions + +open Xunit +open FSharp.Test +open FSharp.Test.Compiler + +module debug = + + [] + let ``fsc debug``() = + FSharp """ +printfn "Hello, World" + """ + |> asExe + |> withOptions ["--debug"] + |> compile + |> shouldSucceed + |> verifyHasPdb + + [] + let ``fsc debug plus``() = + FSharp """ +printfn "Hello, World" + """ + |> asExe + |> withOptions ["--debug+"] + |> compile + |> shouldSucceed + |> verifyHasPdb + + [] + let ``fsc debug minus``() = + FSharp """ +printfn "Hello, World" + """ + |> asExe + |> withOptions ["--debug-"] + |> compile + |> shouldSucceed + |> verifyNoPdb diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 240cf851b92..d84f43e1acf 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -187,6 +187,7 @@ + diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index b871032a23b..97808b58591 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -1072,6 +1072,30 @@ module rec Compiler = result + let verifyHasPdb (result: CompilationResult): unit = + let verifyPdbExists r = + match r.OutputPath with + | Some assemblyPath -> + let pdbPath = Path.ChangeExtension(assemblyPath, ".pdb") + if not (FileSystem.FileExistsShim pdbPath) then + failwith $"PDB file does not exists: {pdbPath}" + | _ -> failwith "Output path is not set, please make sure compilation was successfull." + match result with + | CompilationResult.Success r -> verifyPdbExists r + | _ -> failwith "Result should be \"Success\" in order to verify PDB." + + let verifyNoPdb (result: CompilationResult): unit = + let verifyPdbNotExists r = + match r.OutputPath with + | Some assemblyPath -> + let pdbPath = Path.ChangeExtension(assemblyPath, ".pdb") + if FileSystem.FileExistsShim pdbPath then + failwith $"PDB file exists: {pdbPath}" + | _ -> failwith "Output path is not set, please make sure compilation was successfull." + match result with + | CompilationResult.Success r -> verifyPdbNotExists r + | _ -> failwith "Result should be \"Success\" in order to verify PDB." + [] module Assertions = let private getErrorNumber (error: ErrorType) : int = diff --git a/tests/fsharpqa/Source/CompilerOptions/fsc/debug/debug01.fs b/tests/fsharpqa/Source/CompilerOptions/fsc/debug/debug01.fs deleted file mode 100644 index c97e53d56df..00000000000 --- a/tests/fsharpqa/Source/CompilerOptions/fsc/debug/debug01.fs +++ /dev/null @@ -1,37 +0,0 @@ -// #Regression #NoMT #CompilerOptions #NoMono -// Regression test for FSHARP1.0:5080 -// Verify that the assembly contains the full path to the .pdb file (we are compiling with --debug+) -// - -/// Search a sequence of char (the string 's') in a binary file (the 'assemblyFullPath') -let f (assemblyFullPath:string, s:string) = - - printfn "Searching '%s' in '%s'" s assemblyFullPath - - /// Make an array out of the string (will be used later to compare fragments of the file) - let expectedStringAsArray = seq { for i in s -> int i } |> Seq.toArray - - /// Open binary file - use assemblyStream = new System.IO.StreamReader( assemblyFullPath ) - - /// Makes sliding windows out of the sequence of bytes that make up the binary file - let z = seq { while not assemblyStream.EndOfStream do yield assemblyStream.Read() } |> Seq.windowed expectedStringAsArray.Length - - /// Try to find a matching sequence - let p = z |> Seq.tryFindIndex (fun t -> (Seq.toArray t) = expectedStringAsArray) - - /// Dump the result - p.IsSome - -/// Fully qualified path to ourselves -let assemblyFullPath = System.Reflection.Assembly.GetExecutingAssembly().Location - -/// Fully qualified path to pdb - we expect this info to be in the binary! -let pdbFullPath = System.IO.Path.ChangeExtension(assemblyFullPath, "pdb") - -if f(assemblyFullPath, pdbFullPath) then - printfn "OK: .pdb file found in assembly" - exit 0 - else - printfn "ERROR: No .pdb file found in assembly" - exit 1 diff --git a/tests/fsharpqa/Source/CompilerOptions/fsc/debug/debug02.fs b/tests/fsharpqa/Source/CompilerOptions/fsc/debug/debug02.fs deleted file mode 100644 index e2335d29b98..00000000000 --- a/tests/fsharpqa/Source/CompilerOptions/fsc/debug/debug02.fs +++ /dev/null @@ -1,37 +0,0 @@ -// #Regression #NoMT #CompilerOptions -// Regression test for FSHARP1.0:5080 -// Verify that the assembly DOES NOT contain the full path to the .pdb file (we are compiling with --debug-) -// - -/// Search a sequence of char (the string 's') in a binary file (the 'assemblyFullPath') -let f (assemblyFullPath:string, s:string) = - - printfn "Searching '%s' in '%s'" s assemblyFullPath - - /// Make an array out of the string (will be used later to compare fragments of the file) - let expectedStringAsArray = seq { for i in s -> int i } |> Seq.toArray - - /// Open binary file - use assemblyStream = new System.IO.StreamReader( assemblyFullPath ) - - /// Makes sliding windows out of the sequence of bytes that make up the binary file - let z = seq { while not assemblyStream.EndOfStream do yield assemblyStream.Read() } |> Seq.windowed expectedStringAsArray.Length - - /// Try to find a matching sequence - let p = z |> Seq.tryFindIndex (fun t -> (Seq.toArray t) = expectedStringAsArray) - - /// Dump the result - p.IsSome - -/// Fully qualified path to ourselves -let assemblyFullPath = System.Reflection.Assembly.GetExecutingAssembly().Location - -/// Fully qualified path to pdb - we expect this info to be in the binary! -let pdbFullPath = System.IO.Path.ChangeExtension(assemblyFullPath, "pdb") - -if f(assemblyFullPath, pdbFullPath) then - printfn "ERROR: .pdb file found in assembly" - exit 1 - else - printfn "OK: No .pdb file found in assembly" - exit 0 diff --git a/tests/fsharpqa/Source/CompilerOptions/fsc/debug/env.lst b/tests/fsharpqa/Source/CompilerOptions/fsc/debug/env.lst deleted file mode 100644 index 567c1865a20..00000000000 --- a/tests/fsharpqa/Source/CompilerOptions/fsc/debug/env.lst +++ /dev/null @@ -1,2 +0,0 @@ -NOMONO SOURCE=debug01.fs SCFLAGS="--debug+" # debug01.fs (--debug+) - SOURCE=debug02.fs SCFLAGS="--debug-" # debug02.fs (--debug-) diff --git a/tests/fsharpqa/Source/Conformance/DeclarationElements/ObjectConstructors/env.lst b/tests/fsharpqa/Source/Conformance/DeclarationElements/ObjectConstructors/env.lst index adee0212949..40f39e9785c 100644 --- a/tests/fsharpqa/Source/Conformance/DeclarationElements/ObjectConstructors/env.lst +++ b/tests/fsharpqa/Source/Conformance/DeclarationElements/ObjectConstructors/env.lst @@ -11,7 +11,7 @@ SOURCE=E_NoLetBindingsWOObjCtor.fs # E_NoLetBindingsWOObjCtor.fs SOURCE=E_NoObjectConstructorOnInterfaces.fs # E_NoObjectConstructorOnInterfaces.fs - SOURCE=AlternateGenericTypeSyntax01.fs # AlternateGenericTypeSyntax01.fs + SOURCE=AlternateGenericTypeSyntax01.fs SCFLAGS="--langversion:5.0" # AlternateGenericTypeSyntax01.fs SOURCE=MutuallyRecursive01.fs # MutuallyRecursive01.fs SOURCE=ImplicitCtorsCallingBaseclassPassingSelf.fs # ImplicitCtorsCallingBaseclassPassingSelf.fs diff --git a/tests/fsharpqa/Source/test.lst b/tests/fsharpqa/Source/test.lst index 31eac0a00f9..e72cbd11612 100644 --- a/tests/fsharpqa/Source/test.lst +++ b/tests/fsharpqa/Source/test.lst @@ -5,15 +5,13 @@ # ReqNOCov -- skip this test/suite if we are doing a code coverage run # ReqENU -- skip this test/suite if we are running on non-ENU (useful to exclude hard-to-localize tests) -CompilerOptions01,NoMT CompilerOptions\fsc\checked -CompilerOptions01,NoMT CompilerOptions\fsc\cliversion CompilerOptions01,NoMT CompilerOptions\fsc\codepage CompilerOptions01,NoMT CompilerOptions\fsc\crossoptimize -CompilerOptions01,NoMT CompilerOptions\fsc\debug +CompilerOptions01,NoMT,Determinism CompilerOptions\fsc\determinism CompilerOptions01,NoMT CompilerOptions\fsc\dumpAllCommandLineOptions CompilerOptions01,NoMT CompilerOptions\fsc\flaterrors CompilerOptions02,NoMT CompilerOptions\fsc\gccerrors -CompilerOptions01,NoMT,help CompilerOptions\fsc\help +CompilerOptions01,NoMT,help CompilerOptions\fsc\help CompilerOptions01,NoMT CompilerOptions\fsc\highentropyva CompilerOptions01,NoMT CompilerOptions\fsc\langversion CompilerOptions01,NoMT CompilerOptions\fsc\lib @@ -21,23 +19,22 @@ CompilerOptions01,NoMT CompilerOptions\fsc\noframework CompilerOptions01,NoMT CompilerOptions\fsc\nologo CompilerOptions01,NoMT CompilerOptions\fsc\optimize CompilerOptions01,NoMT CompilerOptions\fsc\out -CompilerOptions01,NoMT,pdbs CompilerOptions\fsc\pdb CompilerOptions01,NoMT CompilerOptions\fsc\platform +CompilerOptions01,NoMT,pdbs CompilerOptions\fsc\pdb CompilerOptions01,NoMT CompilerOptions\fsc\Removed +CompilerOptions01,NoMT CompilerOptions\fsc\responsefile CompilerOptions01,NoMT CompilerOptions\fsc\standalone -CompilerOptions01,NoMT,NoHostedCompiler CompilerOptions\fsc\staticlink +CompilerOptions01,NoMT,NoHostedCompiler CompilerOptions\fsc\staticlink CompilerOptions01,NoMT CompilerOptions\fsc\subsystemversion CompilerOptions01,NoMT CompilerOptions\fsc\tailcalls CompilerOptions01,NoMT CompilerOptions\fsc\target -CompilerOptions01,NoMT,NoHostedCompiler CompilerOptions\fsc\tokenize -CompilerOptions01,NoMT CompilerOptions\fsc\responsefile -CompilerOptions01,NoMT,help CompilerOptions\fsi\help +CompilerOptions01,NoMT,NoHostedCompiler CompilerOptions\fsc\tokenize + +CompilerOptions01,NoMT,help CompilerOptions\fsi\help CompilerOptions01,NoMT CompilerOptions\fsi\highentropyva CompilerOptions01,NoMT CompilerOptions\fsi\langversion CompilerOptions01,NoMT CompilerOptions\fsi\nologo CompilerOptions01,NoMT CompilerOptions\fsi\subsystemversion -CompilerOptions02,NoMT CompilerOptions\fsi\exename -CompilerOptions01,NoMT,Determinism CompilerOptions\fsc\determinism Conformance01 Conformance\BasicGrammarElements\Constants Conformance01 Conformance\BasicGrammarElements\OperatorNames From 2adeb15aa427761890ea4726b93885f0af4d71cc Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 14 Nov 2022 16:04:01 +0100 Subject: [PATCH 04/14] Update README.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 2026df28022..7ca82c9a92d 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # The F# compiler, F# core library, and F# editor tools [![Build Status](https://dev.azure.com/dnceng-public/public/_apis/build/status/dotnet/fsharp/fsharp-ci?branchName=main)](https://dev.azure.com/dnceng-public/public/_build/latest?definitionId=90&branchName=main) -[![Help Wanted](https://img.shields.io/github/issues/dotnet/fsharp/help%20wanted?style=flat-square&color=%232EA043&label=help%20wanted)](https://github.com/dotnet/runtime/labels/help%20wanted) +[![Help Wanted](https://img.shields.io/github/issues/dotnet/fsharp/help%20wanted?style=flat-square&color=%232EA043&label=help%20wanted)](https://github.com/dotnet/fsharp/labels/help%20wanted) You're invited to contribute to future releases of the F# compiler, core library, and tools. Development of this repository can be done on any OS supported by [.NET](https://dotnet.microsoft.com/). From 95d60694bf91c198a6181dcc9de5ca7a7e35b9a9 Mon Sep 17 00:00:00 2001 From: Nino Floris Date: Mon, 14 Nov 2022 21:06:31 +0100 Subject: [PATCH 05/14] Prefer nullable over other conversions, fixes #14302 --- src/Compiler/Checking/CheckExpressions.fs | 2 +- src/Compiler/Checking/ConstraintSolver.fs | 14 ++-- src/Compiler/Checking/MethodCalls.fs | 22 ++++--- src/Compiler/Checking/MethodCalls.fsi | 2 +- .../Language/TypeDirectedConversionTests.fs | 65 ++++++++++++++++++- 5 files changed, 88 insertions(+), 17 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 043502372c2..c25bbfa92ab 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -453,7 +453,7 @@ let UnifyOverallType (cenv: cenv) (env: TcEnv) m overallTy actualTy = | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes(warn, _) -> warning(warn env.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _, _) -> warning(warn env.DisplayEnv) | TypeDirectedConversionUsed.No -> () if AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m reqdTy2 actualTy then diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 751e71bff5c..6b0ef85d5e8 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -2738,7 +2738,7 @@ and ArgsMustSubsumeOrConvert msg csenv.DisplayEnv | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _, _) -> do! WarnD(warn csenv.DisplayEnv) | TypeDirectedConversionUsed.No -> () do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln (Some calledArg.CalledArgumentType) calledArgTy callerArg.CallerArgumentType if calledArg.IsParamArray && isArray1DTy g calledArgTy && not (isArray1DTy g callerArg.CallerArgumentType) then @@ -2769,7 +2769,7 @@ and ArgsMustSubsumeOrConvertWithContextualReport msg csenv.DisplayEnv | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _, _) -> do! WarnD(warn csenv.DisplayEnv) | TypeDirectedConversionUsed.No -> () do! SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln (Some calledArg.CalledArgumentType) calledArgTy callerArgTy (fun e -> ArgDoesNotMatchError(e :?> _, calledMeth, calledArg, callerArg)) return usesTDC @@ -2796,7 +2796,7 @@ and ReturnTypesMustSubsumeOrConvert (csenv: ConstraintSolverEnv) ad ndeep trace msg csenv.DisplayEnv | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _, _) -> do! WarnD(warn csenv.DisplayEnv) | TypeDirectedConversionUsed.No -> () do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln None reqdTy actualTy return usesTDC @@ -2813,7 +2813,7 @@ and ArgsEquivOrConvert (csenv: ConstraintSolverEnv) ad ndeep trace cxsln isConst msg csenv.DisplayEnv | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _, _) -> do! WarnD(warn csenv.DisplayEnv) | TypeDirectedConversionUsed.No -> () if not (typeEquiv csenv.g calledArgTy callerArgTy) then return! ErrorD(Error(FSComp.SR.csArgumentTypesDoNotMatch(), m)) @@ -3225,7 +3225,11 @@ and GetMostApplicableOverload csenv ndeep candidates applicableMeths calledMethG if c <> 0 then c else // Prefer methods that need less type-directed conversion - let c = compare (match usesTDC1 with TypeDirectedConversionUsed.Yes(_, false) -> 1 | _ -> 0) (match usesTDC2 with TypeDirectedConversionUsed.Yes(_, false) -> 1 | _ -> 0) + let c = compare (match usesTDC1 with TypeDirectedConversionUsed.Yes(_, false, _) -> 1 | _ -> 0) (match usesTDC2 with TypeDirectedConversionUsed.Yes(_, false, _) -> 1 | _ -> 0) + if c <> 0 then c else + + // Prefer methods that only have nullable type-directed conversions + let c = compare (match usesTDC1 with TypeDirectedConversionUsed.Yes(_, _, true) -> 1 | _ -> 0) (match usesTDC2 with TypeDirectedConversionUsed.Yes(_, _, true) -> 1 | _ -> 0) if c <> 0 then c else // Prefer methods that don't give "this code is less generic" warnings diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 1536277c506..c7523e7ba50 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -236,12 +236,16 @@ type TypeDirectedConversion = [] type TypeDirectedConversionUsed = - | Yes of (DisplayEnv -> exn) * isTwoStepConversion: bool + | Yes of (DisplayEnv -> exn) * isTwoStepConversion: bool * isNullable: bool | No static member Combine a b = match a, b with - | Yes(_,true), _ -> a - | _, Yes(_,true) -> b + // We want to know which candidates have one or more nullable conversions exclusively + // If one of the values is false we flow false for both. + | Yes(_, true, false), _ -> a + | _, Yes(_, true, false) -> b + | Yes(_, true, _), _ -> a + | _, Yes(_, true, _) -> b | Yes _, _ -> a | _, Yes _ -> b | No, No -> a @@ -282,25 +286,25 @@ let rec AdjustRequiredTypeForTypeDirectedConversions (infoReader: InfoReader) ad // Adhoc int32 --> int64 elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.int64_ty reqdTy && typeEquiv g g.int32_ty actualTy then - g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None + g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false, false), None // Adhoc int32 --> nativeint elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.nativeint_ty reqdTy && typeEquiv g g.int32_ty actualTy then - g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None + g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false, false), None // Adhoc int32 --> float64 elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.float_ty reqdTy && typeEquiv g g.int32_ty actualTy then - g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None + g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false, false), None elif g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop && isMethodArg && isNullableTy g reqdTy && not (isNullableTy g actualTy) then let underlyingTy = destNullableTy g reqdTy // shortcut if typeEquiv g underlyingTy actualTy then - actualTy, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None + actualTy, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false, true), None else let adjustedTy, _, _ = AdjustRequiredTypeForTypeDirectedConversions infoReader ad isMethodArg isConstraint underlyingTy actualTy m if typeEquiv g adjustedTy actualTy then - actualTy, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, true), None + actualTy, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, true, true), None else reqdTy, TypeDirectedConversionUsed.No, None @@ -308,7 +312,7 @@ let rec AdjustRequiredTypeForTypeDirectedConversions (infoReader: InfoReader) ad // eliminate articifical constrained type variables. elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions then match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with - | Some (minfo, _staticTy, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo), false), Some eqn + | Some (minfo, _staticTy, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo), false, false), Some eqn | None -> reqdTy, TypeDirectedConversionUsed.No, None else reqdTy, TypeDirectedConversionUsed.No, None diff --git a/src/Compiler/Checking/MethodCalls.fsi b/src/Compiler/Checking/MethodCalls.fsi index a70827d8fec..60a5ace7201 100644 --- a/src/Compiler/Checking/MethodCalls.fsi +++ b/src/Compiler/Checking/MethodCalls.fsi @@ -119,7 +119,7 @@ type CallerArgs<'T> = /// has been used in F# code [] type TypeDirectedConversionUsed = - | Yes of (DisplayEnv -> exn) * isTwoStepConversion: bool + | Yes of (DisplayEnv -> exn) * isTwoStepConversion: bool * isNullable: bool | No static member Combine: TypeDirectedConversionUsed -> TypeDirectedConversionUsed -> TypeDirectedConversionUsed diff --git a/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs b/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs index be31e72712e..9055740f2a1 100644 --- a/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs +++ b/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs @@ -303,7 +303,7 @@ let test(x: 'T) = (11, 5, 11, 11) """This construct causes code to be less generic than indicated by the type annotations. The type variable 'T has been constrained to be type 'int'.""" - [] + [] let ``Picking overload for typar fails when incompatible types are part of the candidate set``() = CompilerAssert.TypeCheckWithErrors """ @@ -440,3 +440,66 @@ let test() = if not (test().OtherArgs.Value.Name = "test") then failwith "Unexpected value was returned after setting Name" """ [] + + [] + let ``Prefer nullable conversion only candidate when multiple candidates require conversions``() = + CompilerAssert.RunScript + """ +type M() = + static member A(size: int64 array, dtype: System.Nullable) = 1 + static member A(size: System.ReadOnlySpan, dtype: System.Nullable) = 2 + +let test() = M.A([|10L|], 1) + +if test() <> 1 then failwith "Incorrect overload picked" + """ [] + + [] + let ``Prefer nullable conversion over numeric conversion``() = + CompilerAssert.RunScript + """ +type M() = + static member A(n: int64) = 1 + static member A(n: System.Nullable) = 2 + +let test() = M.A(0) + +if test() <> 2 then failwith "Incorrect overload picked" + """ [] + + [] + let ``Prefer nullable conversion over op_Implicit conversion``() = + + CompilerAssert.RunScript + """ +type M() = + static member A(n: System.DateTimeOffset) = 1 + static member A(n: System.Nullable) = 2 + +let test() = M.A(System.DateTime.UtcNow) + +if test() <> 2 then failwith "Incorrect overload picked" + """ [] + + + [] + let ``Picking overload for TDC candidate set fails as ambiguous while one candidate requires more conversions``() = + CompilerAssert.TypeCheckSingleError + """ +type M() = + static member A(m: int64 array, n: int64) = 1 + static member A(m: System.ReadOnlySpan, n: int64) = 2 + +let test() = M.A([|10L|], 1) + """ + FSharpDiagnosticSeverity.Error + 41 + (6, 14, 6, 29) + """A unique overload for method 'A' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known types of arguments: int64[] * int + +Candidates: + - static member M.A: m: System.ReadOnlySpan * n: int64 -> int + - static member M.A: m: System.ReadOnlySpan * n: int64 -> int + - static member M.A: m: int64 array * n: int64 -> int""" From b66628c40b972a2acfae4b2968c8aa9f17ec0b38 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 15 Nov 2022 11:14:41 +0100 Subject: [PATCH 06/14] F# 7 fixes (#14294) --- src/Compiler/TypedTree/TcGlobals.fs | 4 +- .../IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs | 48 +++++++++++-- .../Interop/RequiredAndInitOnlyProperties.fs | 67 ++++++++++++++++++- 3 files changed, 112 insertions(+), 7 deletions(-) diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 9eaac69024a..96dc59428e2 100755 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1831,12 +1831,12 @@ type TcGlobals( let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "atan2", None, Some "Atan2", [vara; varb], ([[varaTy]; [varaTy]], varbTy)) let tyargs = [aty;bty] Some (info, tyargs, argExprs) - | "get_Zero", _, Some aty, [_] -> + | "get_Zero", _, Some aty, ([] | [_]) -> // Call LanguagePrimitives.GenericZero let info = makeOtherIntrinsicValRef (fslib_MFLanguagePrimitives_nleref, "GenericZero", None, None, [vara], ([], varaTy)) let tyargs = [aty] Some (info, tyargs, []) - | "get_One", _, Some aty, [_] -> + | "get_One", _, Some aty, ([] | [_]) -> // Call LanguagePrimitives.GenericOne let info = makeOtherIntrinsicValRef (fslib_MFLanguagePrimitives_nleref, "GenericOne", None, None, [vara], ([], varaTy)) let tyargs = [aty] diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs index 9abba91ca2f..a328c5f3df2 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs @@ -19,6 +19,38 @@ let setupCompilation compilation = |> withReferences [typesModule] +[] +let ``Srtp call Zero property returns valid result`` () = + Fsx """ +let inline zero<'T when 'T: (static member Zero: 'T)> = 'T.Zero +let result = zero +if result <> 0 then failwith $"Something's wrong: {result}" + """ + |> runFsi + |> shouldSucceed + +[] +let ``Srtp call to custom property returns valid result`` () = + FSharp """ +module Foo +type Foo = + static member Bar = 1 + +type HasBar<'T when 'T: (static member Bar: int)> = 'T + +let inline bar<'T when HasBar<'T>> = + 'T.Bar + +[] +let main _ = + let result = bar + if result <> 0 then + failwith $"Unexpected result: {result}" + 0 + """ + |> asExe + |> compileAndRun + #if !NETCOREAPP [] #else @@ -775,7 +807,11 @@ module ``Active patterns`` = module ``Suppression of System Numerics interfaces on unitized types`` = - [] +#if !NETCOREAPP + [] +#else + [] +#endif let Baseline () = Fsx """ open System.Numerics @@ -785,16 +821,19 @@ module ``Suppression of System Numerics interfaces on unitized types`` = |> compile |> shouldSucceed - [] +#if !NETCOREAPP + [] +#else + [] [] [] [] [] [] - [] + [] [] [] - [] + [] [] [] [] @@ -814,6 +853,7 @@ module ``Suppression of System Numerics interfaces on unitized types`` = [] [] [] +#endif let ``Unitized type shouldn't be compatible with System.Numerics.I*`` name paramCount = let typeParams = Seq.replicate paramCount "'T" |> String.concat "," let genericType = $"{name}<{typeParams}>" diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/RequiredAndInitOnlyProperties.fs b/tests/FSharp.Compiler.ComponentTests/Interop/RequiredAndInitOnlyProperties.fs index a3e6b6b6ed7..0b2d4cc37ab 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/RequiredAndInitOnlyProperties.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/RequiredAndInitOnlyProperties.fs @@ -8,6 +8,14 @@ open System module ``Required and init-only properties`` = + let csharpRecord = + CSharp """ + namespace RequiredAndInitOnlyProperties + { + public record Recd(); + + }""" |> withCSharpLanguageVersion CSharpLanguageVersion.Preview |> withName "csLib" + let csharpBaseClass = CSharp """ namespace RequiredAndInitOnlyProperties @@ -228,7 +236,7 @@ let main _ = Error 810, Line 9, Col 5, Line 9, Col 21, "Cannot call 'set_GetInit' - a setter for init-only property, please use object initialization instead. See https://aka.ms/fsharp-assigning-values-to-properties-at-initialization" ] - #if !NETCOREAPP +#if !NETCOREAPP [] #else [] @@ -259,6 +267,63 @@ let main _ = Error 810, Line 9, Col 38, Line 9, Col 40, "Init-only property 'GetInit' cannot be set outside the initialization code. See https://aka.ms/fsharp-assigning-values-to-properties-at-initialization" ] +#if !NETCOREAPP + [] +#else + [] +#endif + let ``F# can change init-only property via SRTP`` () = + + let csharpLib = csharpBaseClass + + let fsharpSource = + """ +open System +open RequiredAndInitOnlyProperties + +let inline setGetInit<'T when 'T : (member set_GetInit: int -> unit)> (a: 'T) (x: int) = a.set_GetInit(x) + +[] +let main _ = + let raio = RAIO() + setGetInit raio 111 + 0 +""" + FSharp fsharpSource + |> asExe + |> withLangVersion70 + |> withReferences [csharpLib] + |> compile + |> shouldSucceed + + #if !NETCOREAPP + [] +#else + [] +#endif + let ``F# can call special-named methods via SRTP`` () = + + let csharpLib = csharpRecord + + let fsharpSource = + """ +open System +open RequiredAndInitOnlyProperties + +let inline clone<'T when 'T : (member ``$``: unit -> 'T)> (a: 'T) = a.``$``() + +[] +let main _ = + let recd = Recd() + let _ = clone recd + 0 +""" + FSharp fsharpSource + |> asExe + |> withLangVersion70 + |> withReferences [csharpLib] + |> compile + |> shouldSucceed #if !NETCOREAPP [] From d0696941e5c836237b8d01d1cc2a0b66c43d81b2 Mon Sep 17 00:00:00 2001 From: Nino Floris Date: Tue, 15 Nov 2022 14:48:53 +0100 Subject: [PATCH 07/14] Replace ROSpan for DateTimeOffset as op_Implicit target, ROSpan is not defined on all test TFMs --- .../Language/TypeDirectedConversionTests.fs | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs b/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs index 9055740f2a1..054664224c9 100644 --- a/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs +++ b/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs @@ -446,10 +446,10 @@ if not (test().OtherArgs.Value.Name = "test") then failwith "Unexpected value wa CompilerAssert.RunScript """ type M() = - static member A(size: int64 array, dtype: System.Nullable) = 1 - static member A(size: System.ReadOnlySpan, dtype: System.Nullable) = 2 + static member A(size: System.DateTime, dtype: System.Nullable) = 1 + static member A(size: System.DateTimeOffset, dtype: System.Nullable) = 2 -let test() = M.A([|10L|], 1) +let test() = M.A(System.DateTime.UtcNow, 1) if test() <> 1 then failwith "Incorrect overload picked" """ [] @@ -487,19 +487,19 @@ if test() <> 2 then failwith "Incorrect overload picked" CompilerAssert.TypeCheckSingleError """ type M() = - static member A(m: int64 array, n: int64) = 1 - static member A(m: System.ReadOnlySpan, n: int64) = 2 + static member A(m: System.DateTime, n: int64) = 1 + static member A(m: System.DateTimeOffset, n: int64) = 2 -let test() = M.A([|10L|], 1) +let test() = M.A(System.DateTime.UtcNow, 1) """ FSharpDiagnosticSeverity.Error 41 - (6, 14, 6, 29) + (6, 14, 6, 44) """A unique overload for method 'A' could not be determined based on type information prior to this program point. A type annotation may be needed. -Known types of arguments: int64[] * int +Known types of arguments: System.DateTime * int Candidates: - - static member M.A: m: System.ReadOnlySpan * n: int64 -> int - - static member M.A: m: System.ReadOnlySpan * n: int64 -> int - - static member M.A: m: int64 array * n: int64 -> int""" + - static member M.A: m: System.DateTime * n: int64 -> int + - static member M.A: m: System.DateTimeOffset * n: int64 -> int + - static member M.A: m: System.DateTimeOffset * n: int64 -> int""" From 8196f82f5115278bd8876b40d02412dea939c05a Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 15 Nov 2022 15:48:32 +0100 Subject: [PATCH 08/14] Move signature tests from cambridge suite to component tests (#14317) * Component tests for signature roundtrip --- .../FSharp.Compiler.ComponentTests.fsproj | 2 + .../Signatures/SigGenerationRoundTripTests.fs | 34 + .../access-minimal-repro.fsx | 8 + .../access.fsx | 287 + .../TestCasesForGenerationRoundTrip/array.fsx | 1151 ++++ .../class_struct_interface.fsx} | 0 .../function_types.fs} | 0 .../generic_measures.fsx | 74 + .../innerpoly.fsx | 448 ++ .../libtest.fsx | 5660 +++++++++++++++++ .../measures.fsx | 606 ++ .../members_basics.fs | 3454 ++++++++++ .../mix_curried_tupled.fsx} | 0 .../nested_module.fsx} | 0 .../nested_module_in_namespace.fsx} | 0 .../recursive_nested_module.fsx} | 0 .../struct_private_field_repro.fsx | 7 + .../type_alias_primitives.fsx} | 0 .../type_augmentation.fsx} | 0 .../union_with_function_type.fs} | 0 .../zero_constraint.fs} | 0 tests/fsharp/core/innerpoly/test.fsx | 5 +- tests/fsharp/single-test.fs | 20 - tests/fsharp/tests.fs | 51 - 24 files changed, 11732 insertions(+), 75 deletions(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/Signatures/SigGenerationRoundTripTests.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/access-minimal-repro.fsx create mode 100644 tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/access.fsx create mode 100644 tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/array.fsx rename tests/{fsharp/core/classStructInterface/test.fsx => FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/class_struct_interface.fsx} (100%) rename tests/{fsharp/core/functionTypes/test.fs => FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/function_types.fs} (100%) create mode 100644 tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/generic_measures.fsx create mode 100644 tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/innerpoly.fsx create mode 100644 tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/libtest.fsx create mode 100644 tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/measures.fsx create mode 100644 tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/members_basics.fs rename tests/{fsharp/core/mixCurriedTupled/test.fsx => FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/mix_curried_tupled.fsx} (100%) rename tests/{fsharp/core/nestedModule/test.fsx => FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/nested_module.fsx} (100%) rename tests/{fsharp/core/nestedModuleInNamespace/test.fsx => FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/nested_module_in_namespace.fsx} (100%) rename tests/{fsharp/core/recursiveNestedModule/test.fsx => FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/recursive_nested_module.fsx} (100%) create mode 100644 tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/struct_private_field_repro.fsx rename tests/{fsharp/core/typeAliasPrimitives/test.fsx => FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/type_alias_primitives.fsx} (100%) rename tests/{fsharp/core/typeAugmentation/test.fsx => FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/type_augmentation.fsx} (100%) rename tests/{fsharp/core/unionWithFunctionType/test.fs => FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/union_with_function_type.fs} (100%) rename tests/{fsharp/core/zeroConstraint/test.fs => FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/zero_constraint.fs} (100%) diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index d84f43e1acf..85239d5a3c0 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -207,6 +207,7 @@ + @@ -223,6 +224,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/SigGenerationRoundTripTests.fs b/tests/FSharp.Compiler.ComponentTests/Signatures/SigGenerationRoundTripTests.fs new file mode 100644 index 00000000000..0b4be741d50 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/SigGenerationRoundTripTests.fs @@ -0,0 +1,34 @@ +module FSharp.Compiler.ComponentTests.Signatures.SigGenerationRoundTripTests + +open Xunit +open FSharp.Test +open FSharp.Test.Compiler +open System.IO + +let testCasesDir = Path.Combine(__SOURCE_DIRECTORY__,"TestCasesForGenerationRoundTrip") +let allTestCases = + Directory.EnumerateFiles(testCasesDir) + |> Seq.toArray + |> Array.map Path.GetFileName + |> Array.map (fun f -> [|f :> obj|]) + +[] +[] +let ``Generate and compile`` implFileName = + let implContents = File.ReadAllText (Path.Combine(testCasesDir,implFileName)) + + let generatedSignature = + Fs implContents + |> withLangVersionPreview + |> withDefines ["TESTS_AS_APP";"COMPILED"] + |> printSignatures + + Fsi generatedSignature + |> withAdditionalSourceFile (FsSource implContents) + |> withLangVersionPreview + |> withDefines ["TESTS_AS_APP";"COMPILED"] + |> ignoreWarnings + |> asExe + |> compile + |> shouldSucceed + diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/access-minimal-repro.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/access-minimal-repro.fsx new file mode 100644 index 00000000000..830c81fb47d --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/access-minimal-repro.fsx @@ -0,0 +1,8 @@ +module Core_access + +[] +type MyClassPropertyGetters = + member internal x.InstInternal = 12 + member private x.InstPrivate = 12 + member public x.InstPublic = 12 + member x.InstDefault = 12 diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/access.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/access.fsx new file mode 100644 index 00000000000..6c067a82125 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/access.fsx @@ -0,0 +1,287 @@ +module Core_access + +#light +let failures = ref [] + +let report_failure (s : string) = + stderr.Write" NO: " + stderr.WriteLine s + failures.Value <- failures.Value @ [s] + +let test (s : string) b = + stderr.Write(s) + if b then stderr.WriteLine " OK" + else report_failure (s) + +(*--------------------*) + +// Test cases for bug://1562 +// Checking that generated signature can be compiled against the file. + +type internal typInternal = | AAA1 +type private typPrivate = | AAA2 +type public typPublic = | AAA3 +type typDefault = | AAA4 +type internal rrr = | AAA + +let internal ValInternal = 1212 +let private ValPrivate = 1212 +let public ValPublic = 1212 +let ValDefault = 1212 + +[] +type MyClassFields = + val internal fieldInternal : int + val private fieldPrivate : int + val public fieldPublic : int + +[] +type MyClassMutableFields = + val mutable internal mfieldInternal : int + val mutable private mfieldPrivate : int + val mutable public mfieldPublic : int + +[] +type MyClassStaticMembers = + static member internal SInternal = 12 + static member private SPrivate = 12 + static member public SPublic = 12 + static member SDefault = 12 + static member internal SMInternal() = 12 + static member private SMPrivate() = 12 + static member public SMPublic() = 12 + static member SMDefault() = 12 + +[] +type MyClassPropertiyGetters = + member internal x.InstInternal = 12 + member private x.InstPrivate = 12 + member public x.InstPublic = 12 + member x.InstDefault = 12 + +type MyClassExplicitCtors = + val v : int + internal new(x) = { v = x } + private new(x,y) = { v = x + y} + public new(x,y,z) = { v = x + y + z} + +type MyClassExplicitCtors2 = + new() = {} + internal new(x) = let v : int = x in {} + private new(x,y) = let v : int = x + y in {} + public new(x,y,z) = let v : int = x + y + z in {} + +[] +type MyClassPropertyGetSetterMatrix = + //-- + member obj.PropGetSetInternalInternal + with internal get() = 1 + and internal set(x:int) = () + member obj.PropGetSetInternalPrivate + with internal get() = 1 + and private set(x:int) = () + member obj.PropGetSetInternalPublic + with internal get() = 1 + and public set(x:int) = () + //-- + member obj.PropGetSetPrivateInternal + with private get() = 1 + and internal set(x:int) = () + member obj.PropGetSetPrivatePrivate + with private get() = 1 + and private set(x:int) = () + member obj.PropGetSetPrivatePublic + with private get() = 1 + and public set(x:int) = () + //-- + member obj.PropGetSetPublicInternal + with public get() = 1 + and internal set(x:int) = () + member obj.PropGetSetPublicPrivate + with public get() = 1 + and private set(x:int) = () + member obj.PropGetSetPublicPublic + with public get() = 1 + and public set(x:int) = () + +[] +type MyClassImplicitCtorInternal internal() = + member obj.Res = 12 + +[] +type MyClassImplicitCtorPrivate private() = + member obj.Res = 12 + +module internal ModInternal = begin end +module private ModPrivate = begin end +module public ModPublic = begin end + +type recordRepInternal = internal { rfA1 : int } +type recordRepPrivate = private { rfA2 : int } +type recordRepPublic = public { rfA3 : int } + +type dtypeRepInternal = internal | AA1 | BB1 +type dtypeRepPrivate = private | AA2 | BB2 +type dtypeRepPublic = public | AA3 | BB3 + +type internal dtypeRepPublic2 = private | AA3 | BB3 +type private dtypeRepPublic3 = internal | AA3 | BB3 + +type internal dtypeRepPublic4 = + private + | AA3 + | BB3 + +module internal M = + module private PP = + type dtypeRepPublic5 = + | AA3 + | BB3 + +module private M2 = + module internal P = + let vv = 12 + + +module RestrictedRecordsAndUnionsUsingPrivateAndInternalTypes = + + module public Test1 = + + type internal Data = + { + Datum: int + } + + type public Datum = + internal + { + Thing: Data + } + + type public Datum2 = + internal | A of Data * Data | B of Data + + module public Test2 = + + type internal Data = + { + Datum: int + } + + type internal Datum = + { + Thing: Data + } + + type internal Datum2 = + | A of Data * Data | B of Data + + module public Test3 = + + type public Data = + internal + { + Datum: int + } + + type internal Datum = + { + Thing: Data + } + + type internal Datum2 = + internal | A of Data * Data | B of Data + + + module public Test4 = + + type internal Data = + { + Datum: int + } + + type public Datum = + internal + { + Thing: Data + } + + type public Datum2 = + internal | A of Data * Data | B of Data + + + module public Test5 = + + type private Data = + { + Datum: int + } + + type public Datum = + private + { + Thing: Data + } + + type public Datum2 = + private | A of Data * Data | B of Data + + + module Test6 = + module internal HelperModule = + + type public Data = + private + { + Datum: int + } + + let internal handle (data:Data): int = data.Datum + + module public Module = + + type public Data = + private + { + Thing: HelperModule.Data + } + + let public getInt (data:Data): int = HelperModule.handle data.Thing + + module Test7 = + module internal HelperModule = + + type Data = + { + Datum: int + } + + let handle (data:Data): int = data.Datum + + module Module = + + type Data = + internal + { + Thing: HelperModule.Data + } + + let getInt (data:Data): int = HelperModule.handle data.Thing + + + (*--------------------*) + +#if TESTS_AS_APP +let RUN() = failures.Value +#else +let aa = + match failures.Value with + | [] -> + stdout.WriteLine "Test Passed" + System.IO.File.WriteAllText("test.ok","ok") + exit 0 + | _ -> + stdout.WriteLine "Test Failed" + exit 1 +#endif + diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/array.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/array.fsx new file mode 100644 index 00000000000..82914ce60f6 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/array.fsx @@ -0,0 +1,1151 @@ +// #Conformance #Arrays #Stress #Structs #Mutable #ControlFlow #LetBindings +#if TESTS_AS_APP +module Core_array +#endif + +let mutable failures = [] +let report_failure (s) = + stderr.WriteLine " NO"; failures <- s :: failures +let test s b = if not b then (stderr.Write(s:string); report_failure(s) ) +let check s b1 b2 = test s (b1 = b2) + + +(* TEST SUITE FOR Array *) + +let test_make_get_set_length () = + let arr = Array.create 3 0 in + test "fewoih" (Array.get arr 0 = 0); + test "vvrew0" (Array.get arr 2 = 0); + ignore (Array.set arr 0 4); + test "vsdiuvs" (Array.get arr 0 = 4); + test "vropivrwe" (Array.length arr = 3) + +let test_const () = + let arr = [| 4;3;2 |] in + test "sdvjk2" (Array.get arr 0 = 4); + test "cedkj" (Array.get arr 2 = 2); + ignore (Array.set arr 0 4); + test "ds9023" (Array.get arr 0 = 4); + test "sdio2" (Array.length arr = 3) + +let test_const_empty () = + let arr = [| |] in + test "sdio2" (Array.length arr = 0) + +let test_map () = + let arr = Array.map (fun x -> x + 1) ( [| 4;3;2 |]) in + test "test2927: sdvjk2" (Array.get arr 0 = 5); + test "test2927: cedkj" (Array.get arr 2 = 3) + +let test_iter () = + Array.iter (fun x -> test "fuo" (x <= 4)) ( [| 4;3;2 |]) + +let test_iteri () = + let arr = [| 4;3;2 |] in + Array.iteri (fun i x -> test "fuo" (arr.[i] = x)) arr + +let test_mapi () = + let arr = [| 4;3;2 |] in + let arr2 = Array.mapi (fun i x -> test "dwqfuo" (arr.[i] = x); i + x) arr in + test "test2927: sdvjk2" (Array.get arr2 0 = 4); + test "test2927: cedkj" (Array.get arr2 2 = 4) + +let test_isEmpty () = + test "isEmpty a" (Array.isEmpty [||]) + test "isEmpty b" (Array.isEmpty <| Array.create 0 42) + test "isEmpty c" <| not (Array.isEmpty <| [| 1 |]) + test "isEmpty d" (Array.isEmpty <| Array.empty) + +let test_create () = + let arr = Array.create 10 10 + for i in 0 .. 9 do + test "test_create" (arr.[i] = 10) + +let test_concat () = + let make n = [| for i in n .. n + 9 -> i |] + let arr = [| for i in 0..+10..50 -> make i|] + test "concat a" (Array.concat arr = [|0..59|]) + + let arr2 = [| for i in 0..50 -> [||] |] + test "concat b" (Array.concat arr2 = [| |]) + + let arr3 = [| [||]; [||]; [|1; 2|]; [||] |] + test "concat c" (Array.concat arr3 = [|1; 2|]) + +let test_sub () = + test "sub a" (Array.sub [|0..100|] 10 20 = [|10..29|]) + test "sub b" (Array.sub [|0..100|] 0 101 = [|0..100|]) + test "sub c" (Array.sub [|0..100|] 0 1 = [|0|]) + test "sub d" (Array.sub [|0..100|] 0 0 = [||]) + +let test_fold2 () = + test "fold2 a" + (Array.fold2 (fun i j k -> i+j+k) 100 [|1;2;3|] [|1;2;3|] = 112) + + test "fold2_b" + (Array.fold2 (fun i j k -> i-j-k) 100 [|1;2;3|] [|1;2;3|] = 100-12) + +let test_foldBack2 () = + test "foldBack2 a" + (Array.foldBack2 (fun i j k -> i+j+k) [|1;2;3|] [|1;2;3|] 100 = 112) + + test "foldBack2_b" + (Array.foldBack2 (fun i j k -> k-i-j) [|1;2;3|] [|1;2;3|] 100 = 100-12) + +let test_scan () = + test "scan" + (Array.scan (+) 0 [|1..5|] = [|0; 1; 3; 6; 10; 15|]) + + test "scanBack" + (Array.scanBack (+) [|1..5|] 0 = [|15; 14; 12; 9; 5; 0|]) + +let test_iter2 () = + let c = ref -1 + Array.iter2 (fun x y -> c.Value <- c.Value + 1; test "iter2" (c.Value = x && c.Value = y)) [|0..100|] [|0..100|] + test "iter2" (c.Value = 100) + +let test_iteri2 () = + let c = ref 0 + Array.iteri2 (fun i j k -> c.Value <- c.Value+i+j+k) [|1;2;3|] [|10;20;30|] + test "iteri2" (c.Value = 6+60+3) + +let test_map2 () = + test "map2" + (Array.map2 (+) [|0..100|] [|0..100|] = [|0..+2..200|]) + +let test_mapi2 () = + test "mapi2 a" + (Array.mapi2 (fun i j k -> i+j+k) [|1..10|] [|1..10|] = [|2..+3..29|]) + + test "mapi2_b" + (try Array.mapi2 (fun i j k -> i+j+k) [||] [|1..10|] |> ignore; false + with _ -> true) + +let test_exists () = + test "exists a" + ([|1..100|] |> Array.exists ((=) 50)) + + test "exists b" <| not + ([|1..100|] |> Array.exists ((=) 150)) + +let test_forall () = + test "forall a" + ([|1..100|] |> Array.forall (fun x -> x < 150)) + + test "forall b" <| not + ([|1..100|] |> Array.forall (fun x -> x < 80)) + +let test_exists2 () = + test "exists2 a" <| Array.exists2 (=) + [|1; 2; 3; 4; 5; 6|] + [|2; 3; 4; 5; 6; 6|] + + test "exists2 b" <| not (Array.exists2 (=) + [|1; 2; 3; 4; 5; 6|] + [|2; 3; 4; 5; 6; 7|]) + +let test_forall2 () = + test "forall2 a" + (Array.forall2 (=) [|1..10|] [|1..10|]) + + test "forall2_b" <| not + (Array.forall2 (=) [|1;2;3;4;5|] [|1;2;3;0;5|]) + +let test_filter () = + test "filter a" + (Array.filter (fun x -> x % 2 = 0) [|0..100|] = [|0..+2..100|]) + + test "filter b" + (Array.filter (fun x -> false) [|0..100|] = [||]) + + test "filter c" + (Array.filter (fun x -> true) [|0..100|] = [|0..100|]) + + +let test_partition () = + let p1, p2 = Array.partition (fun x -> x % 2 = 0) [|0..100|] + test "partition" + (p1 = [|0..+2..100|] && p2 = [|1..+2..100|]) + +let test_choose () = + test "choose" + (Array.choose (fun x -> if x % 2 = 0 then Some (x/2) else None) [|0..100|] = [|0..50|]) + +let test_find () = + test "find a" + ([|1..100|] |> Array.find (fun x -> x > 50) = 51) + + test "find b" + (try [|1..100|] |> Array.find (fun x -> x > 180) |> ignore; false + with _ -> true) + +module Array = + let findIndexi f (array : array<_>) = + let len = array.Length + let rec go n = + if n >= len then + failwith "fail" + elif f n array.[n] then + n + else + go (n+1) + go 0 + + let tryFindIndexi f (array : array<_>) = + let len = array.Length + let rec go n = if n >= len then None elif f n array.[n] then Some n else go (n+1) + go 0 + +let test_findIndex () = + test "findIndex a" + (Array.findIndex (fun i -> i >= 4) [|0..10|] = 4) + + test "findIndex b" + (try Array.findIndex (fun i -> i >= 20) [|0..10|] |> ignore; false + with _ -> true) + + test "findIndexi a" + (Array.findIndexi (=) [|1; 2; 3; 3; 2; 1|] = 3) + + test "findIndexi b" + (try Array.findIndexi (=) [|1..10|] |> ignore; false + with _ -> true) + +let test_tryfind () = + test "tryFind" + ([|1..100|] |> Array.tryFind (fun x -> x > 50) = Some 51) + + test "tryFind b" + ([|1..100|] |> Array.tryFind (fun x -> x > 180) = None) + + test "tryfind_index a" + (Array.tryFindIndex (fun x -> x = 4) [|0..10|] = Some 4) + + test "tryfind_index b" + (Array.tryFindIndex (fun x -> x = 42) [|0..10|] = None) + + test "tryFindIndexi a" + (Array.tryFindIndexi (=) [|1;2;3;4;4;3;2;1|] = Some 4) + + test "tryFindIndexi b" + (Array.tryFindIndexi (=) [|1..10|] = None) + +let test_first () = + test "first a" + ([|1..100|] |> Array.tryPick (fun x -> if x > 50 then Some (x*x) else None) = Some (51*51)) + + test "first b" + ([|1..100|] |> Array.tryPick (fun x -> None) = None) + + test "first c" + ([||] |> Array.tryPick (fun _ -> Some 42) = None) + +let test_sort () = + + test "sort a" (Array.sort [||] = [||]) + test "sort b" (Array.sort [|1|] = [|1|]) + test "sort c" (Array.sort [|1;2|] = [|1;2|]) + test "sort d" (Array.sort [|2;1|] = [|1;2|]) + test "sort e" (Array.sort [|1..1000|] = [|1..1000|]) + test "sort f" (Array.sort [|1000..-1..1|] = [|1..1000|]) + +let test_sort_by () = + + test "Array.sortBy a" (Array.sortBy int [||] = [||]) + test "Array.sortBy b" (Array.sortBy int [|1|] = [|1|]) + test "Array.sortBy c" (Array.sortBy int [|1;2|] = [|1;2|]) + test "Array.sortBy d" (Array.sortBy int [|2;1|] = [|1;2|]) + test "Array.sortBy e" (Array.sortBy int [|1..1000|] = [|1..1000|]) + test "Array.sortBy f" (Array.sortBy int [|1000..-1..1|] = [|1..1000|]) + + let testGen s f = + test ("Array.sortBy a "+s) (Array.sortBy f [||] = [||]) + test ("Array.sortBy b "+s) (Array.sortBy f [|1|] = [|1|]) + test ("Array.sortBy c "+s) (Array.sortBy f [|1;2|] = [|1;2|]) + test ("Array.sortBy d "+s) (Array.sortBy f [|2;1|] = [|1;2|]) + test ("Array.sortBy e "+s) (Array.sortBy f [|1..1000|] = [|1..1000|]) + test ("Array.sortBy f "+s) (Array.sortBy f [|1000..-1..1|] = [|1..1000|]) + + // All these projects from integers preserve the expected key ordering for the tests in 'testGen()' + testGen "int" int + testGen "uint32" uint32 + testGen "int16" int16 + testGen "uint16" uint16 + testGen "int64" int64 + testGen "uint64" uint64 + testGen "nativeint" nativeint + testGen "unativeint" unativeint + testGen "float" float + testGen "float32" float32 + testGen "decimal" decimal + + test "Array.sortBy g" (Array.sortBy int [|"4";"2";"3";"1";"5"|] = [|"1";"2";"3";"4";"5"|]) + test "Array.sortBy h" (Array.sortBy abs [|1;-2;5;-4;0;-6;3|] = [|0;1;-2;3;-4;5;-6|]) + test "Array.sortBy i" (Array.sortBy String.length [|"a";"abcd";"ab";"";"abc"|] = [|"";"a";"ab";"abc";"abcd"|]) + + +let test_list_stableSortBy() = + for lo in 0 .. 100 do + for hi in lo .. 100 do + test (sprintf "vre9u0rejkn, lo = %d, hi = %d" lo hi) (List.sortBy snd [ for i in lo .. hi -> (i, i % 17) ] = [ for key in 0 .. 16 do for i in lo .. hi do if i % 17 = key then yield (i, i % 17) ]) + +test_list_stableSortBy() + + +[] +type Key = + | Key of int * int + interface System.IComparable with + member x.CompareTo(yobj:obj) = + match yobj with + | :? Key as y -> + let (Key(y1,y2)) = y in + let (Key(x1,x2)) = x in + compare x2 y2 + | _ -> failwith "failure" + + override x.Equals(yobj) = + match yobj with + | :? Key as y -> + let (Key(y1,y2)) = y in + let (Key(x1,x2)) = x in + x2 = y2 + | _ -> false + + override x.GetHashCode() = + let (Key(x1,x2)) = x in + hash x2 + +let test_list_stableSort() = + for lo in 0 .. 100 do + for hi in lo .. 100 do + test (sprintf "vre9u0rejkn, lo = %d, hi = %d" lo hi) (List.sort [ for i in lo .. hi -> Key(i, i % 17) ] = [ for key in 0 .. 16 do for i in lo .. hi do if i % 17 = key then yield Key(i, i % 17) ]) + +test_list_stableSort() + +let test_list_stableSortByNonIntegerKey() = + for lo in 0 .. 100 do + for hi in lo .. 100 do + test (sprintf "vre9u0rejkn, lo = %d, hi = %d" lo hi) (List.sortBy (fun (Key(a,b)) -> Key(0,b)) [ for i in lo .. hi -> Key(i, i % 17) ] = [ for key in 0 .. 16 do for i in lo .. hi do if i % 17 = key then yield Key(i, i % 17) ]) + +test_list_stableSortByNonIntegerKey() + + +let test_zip () = + test "zip" + (Array.zip [|1..10|] [|1..10|] = [|for i in 1..10 -> i, i|]) + + let unzip1, unzip2 = Array.unzip <| [|for i in 1..10 -> i, i+1|] + test "unzip" (unzip1 = [|1..10|] && unzip2 = [|2..11|]) + +let test_zip3 () = + test "zip3" + (Array.zip3 [|1..10|] [|1..10|] [|1..10|] = [|for i in 1..10 -> i, i, i|]) + + let unzip1, unzip2, unzip3 = Array.unzip3 <| [|for i in 1..10 -> i, i+1, i+2|] + test "unzip3" (unzip1 = [|1..10|] && unzip2 = [|2..11|] && unzip3 = [|3..12|]) + + +let test_rev () = + test "rev a" + (Array.rev [|0..100|] = [|100..-1 ..0|]) + + test "rev b" + (Array.rev [|1|] = [|1|]) + + test "rev c" + (Array.rev [||] = [||]) + + test "rev d" + (Array.rev [|1; 2|] = [|2; 1|]) + +let test_sum () = + test "sum a" (Array.sum [||] = 0) + test "sum b" (Array.sum [|42|] = 42) + test "sum c" (Array.sum [|42;-21|] = 21) + test "sum d" (Array.sum [|1..1000|] = (1000*1001) / 2) + test "sum e" (Array.sum [|1.;2.;3.|] = 6.) + test "sum f" (Array.sum [|1.;2.;infinity;3.|] = infinity) + +let test_sum_by () = + test "sum_by a" (Array.sumBy int [||] = 0) + test "sum_by b" (Array.sumBy int [|42|] = 42) + test "sum_by c" (Array.sumBy int [|42;-21|] = 21) + test "sum_by d" (Array.sumBy int [|1..1000|] = (1000*1001) / 2) + test "sum_by e" (Array.sumBy float [|1.;2.;3.|] = 6.) + test "sum_by f" (Array.sumBy float [|1.;2.;infinity;3.|] = infinity) + test "sum_by g" (Array.sumBy abs [|1; -2; 3; -4|] = 10) + test "sum_by h" (Array.sumBy String.length [|"abcd";"efg";"hi";"j";""|] = 10) + +let test_average () = + test "average a1" (try Array.average ([||]: float array) |> ignore; false with :? System.ArgumentException -> true) + test "average a2" (try Array.average ([||]: float32 array) |> ignore; false with :? System.ArgumentException -> true) + test "average a3" (try Array.average ([||]: decimal array) |> ignore; false with :? System.ArgumentException -> true) + test "average a4" (Array.average [|0.|] = 0.) + test "average b" (Array.average [|4.|] = 4.) + test "average c" (Array.average [|4.;6.|] = 5.) + + test "average_by a1" (try Array.averageBy id ([||]: float array) |> ignore; false with :? System.ArgumentException -> true) + test "average_by a2" (try Array.averageBy id ([||]: float32 array) |> ignore; false with :? System.ArgumentException -> true) + test "average_by a3" (try Array.averageBy id ([||]: decimal array) |> ignore; false with :? System.ArgumentException -> true) + test "average_by a4" (Array.averageBy float [|0..1000|] = 500.) + test "average_by b" (Array.averageBy (String.length >> float) [|"ab";"cdef"|] = 3.) + +let test_min () = + test "min a" (Array.min [|42|] = 42) + test "min b" (Array.min [|42;21|] = 21) + test "min c" (Array.min [|'a';'b'|] = 'a') + + test "max a" (Array.max [|42|] = 42) + test "max b" (Array.max [|42;21|] = 42) + test "max c" (Array.max [|'a';'b'|] = 'b') + +let test_min_by () = + test "min_by a" (Array.minBy int [|42|] = 42) + test "min_by b" (Array.minBy abs [|-42;-21|] = -21) + test "min_by c" (Array.minBy int [|'a';'b'|] = 'a') + + test "max_by a" (Array.maxBy int [|42|] = 42) + test "max_by b" (Array.maxBy abs [|-42;-21|] = -42) + test "max_by c" (Array.maxBy int [|'a';'b'|] = 'b') + +let test_seq () = + test "to_seq" (Array.ofSeq [1..100] = [|1..100|]) + test "to_seq" ([|1..100|] |> Array.toSeq |> Array.ofSeq = [|1..100|]) + + +let test_zero_create () = + let arr = Array.zeroCreate 3 in + ignore (Array.set arr 0 4); + ignore (Array.set arr 1 3); + ignore (Array.set arr 2 2); + test "fewoih" (Array.get arr 0 = 4); + test "vvrew0" (Array.get arr 1 = 3); + test "vvrew0" (Array.get arr 2 = 2) + +let test_zero_create_2 () = + let arr = Array.zeroCreate 0 in + test "sdio2" (Array.length arr = 0) + +let test_init () = + let arr = Array.init 4 (fun x -> x + 1) in + test "test2927: sdvjk2" (Array.get arr 0 = 1); + test "test2927: cedkj" (Array.get arr 2 = 3) + +let test_init_empty () = + let arr = Array.init 0 (fun x -> x + 1) in + test "test2927: sdvjk2" (Array.length arr = 0) + +let test_append () = + let arr = Array.append ( [| "4";"3" |]) ( [| "2" |]) in + test "test2928: sdvjk2" (Array.get arr 0 = "4"); + test "test2928: cedkj" (Array.get arr 2 = "2"); + test "test2928: cedkj" (Array.length arr = 3) + +let test_append_empty () = + let arr = Array.append ( [| |]) ( [| |]) in + test "test2928: cedkj" (Array.length arr = 0) + +let test_fill () = + let arr = [| "4";"3";"2" |] in + Array.fill arr 1 2 "1"; + test "test2929: sdvjk2" (Array.get arr 0 = "4"); + test "test2929: cedkj" (Array.get arr 2 = "1") + +let test_copy () = + let arr = [| "4";"3";"2" |] in + let arr2 = Array.copy arr in + test "test2929: sdvjk2" (Array.get arr2 0 = "4"); + test "test2929: cedkj" (Array.get arr2 2 = "2"); + test "feio" (not (LanguagePrimitives.PhysicalEquality arr arr2)) + +let test_blit () = + let arr = [| "4";"3";"2";"0" |] in + let arr2 = [| "4";"3";"-1"; "-1" |] in + Array.blit arr 1 arr2 2 2; + test "test2930: sdvjk2" (Array.get arr2 0 = "4"); + test "test2930: cedkj" (Array.get arr2 1 = "3"); + test "test2930: ceddwkj" (Array.get arr2 2 = "3"); + test "test2930: ceqwddkj" (Array.get arr2 3 = "2") + +let test_of_list () = + let arr = Array.ofList [ "4";"3";"2";"0" ] in + test "test2931: sdvjk2" (Array.get arr 0 = "4"); + test "test2931: cedkj" (Array.get arr 1 = "3"); + test "test2931: ceddwkj" (Array.get arr 2 = "2"); + test "test2931: ceqwddkj" (Array.get arr 3 = "0") + +let test_to_list () = + test "test2932" (Array.toList ( [| "4";"3";"2";"0" |]) = [ "4";"3";"2";"0" ]) + +let test_to_list_of_list () = + test "test2933" (Array.toList (Array.ofList [ "4";"3";"2";"0" ]) = [ "4";"3";"2";"0" ]) + +let test_fold_left () = + let arr = Array.ofList [ 4;3;2;1 ] in + test "test2931: sdvjk2few" (Array.fold (fun x y -> x/y) (5*4*3*2*1) arr = 5) + +let test_fold_right () = + let arr = Array.ofList [ 4;3;2;1 ] in + test "test2931: sdvjk2ew" (Array.foldBack (fun y x -> x/y) arr (6*4*3*2*1) = 6) + +let test_reduce_left () = + test "test2931: array.reduce" (Array.reduce (fun x y -> x/y) [|5*4*3*2; 4;3;2;1|] = 5) + +let test_reduce_right () = + let arr = Array.ofList [ 4;3;2;1;5 ] in + test "test2931: array.reduceBack" (Array.reduceBack (fun y x -> x/y) [|4;3;2;1; 5*4*3*2|] = 5) + + +let _ = test_make_get_set_length () +let _ = test_const () +let _ = test_const_empty () +let _ = test_map () +let _ = test_mapi () +let _ = test_iter () +let _ = test_iteri () +let _ = test_mapi () +let _ = test_isEmpty () +let _ = test_create () +let _ = test_concat () +let _ = test_sub () +let _ = test_fold2 () +let _ = test_foldBack2 () +let _ = test_scan () +let _ = test_iter2 () +let _ = test_iteri2 () +let _ = test_iter () +let _ = test_map2 () +let _ = test_mapi2 () +let _ = test_exists () +let _ = test_forall () +let _ = test_iter () +let _ = test_exists2 () +let _ = test_forall2 () +let _ = test_filter () +let _ = test_partition () +let _ = test_choose () +let _ = test_find () +let _ = test_findIndex () +let _ = test_tryfind () +let _ = test_first () +let _ = test_sort () +let _ = test_sort_by () +let _ = test_zip () +let _ = test_zip3 () +let _ = test_rev () +let _ = test_sum () +let _ = test_sum_by () +let _ = test_average () +let _ = test_min () +let _ = test_min_by () +let _ = test_seq () +let _ = test_zero_create () +let _ = test_zero_create_2 () +let _ = test_append () +let _ = test_append_empty () +let _ = test_init () +let _ = test_init_empty () +let _ = test_fill () +let _ = test_blit () +let _ = test_of_list () +let _ = test_to_list () +let _ = test_to_list_of_list () +let _ = test_copy () +let _ = test_iter () +let _ = test_iteri () +let _ = test_fold_left () +let _ = test_fold_right () +let _ = test_reduce_left () +let _ = test_reduce_right () + +module Array2Tests = begin + + let test_make_get_set_length () = + let arr = Array2D.create 3 4 0 in + test "fewoih1" (Array2D.get arr 0 0 = 0); + test "fewoih2" (Array2D.get arr 0 1 = 0); + test "vvrew03" (Array2D.get arr 2 2 = 0); + test "vvrew04" (Array2D.get arr 2 3 = 0); + + ignore (Array2D.set arr 0 2 4); + test "vsdiuvs5" (Array2D.get arr 0 2 = 4); + arr.[0,2] <- 2; + + test "vsdiuvs6" (arr.[0,2] = 2); + test "vropivrwe7" (Array2D.length1 arr = 3); + test "vropivrwe8" (Array2D.length2 arr = 4) + + let a = Array2D.init 10 10 (fun i j -> i,j) + let b = Array2D.init 2 2 (fun i j -> i+1,j+1) + //test "a2_sub" + // (Array2D.sub a 1 1 2 2 = b) + + + Array2D.blit b 0 0 a 0 0 2 2 + //test "a2_blit" + // (Array2D.sub a 0 0 2 2 = b) + + let _ = test_make_get_set_length () + + +end + +module ArrayNonZeroBasedTestsSlice = + let runTest () = + let arr = (Array2D.initBased 5 4 3 2 (fun i j -> (i,j))) + test "fewoih1" (arr.[6,*] = [|(6, 4); (6, 5)|]) + test "fewoih2" (arr.[*,*].[1,*] = [|(6, 4); (6, 5)|]) + test "fewoih3" (arr.[*,5] = [|(5, 5); (6, 5); (7, 5)|]) + test "fewoih4" (arr.[*,*].[*,1] = [|(5, 5); (6, 5); (7, 5)|]) + test "fewoih5" (arr.GetLowerBound(0) = 5) + test "fewoih6" (arr.GetLowerBound(1) = 4) + test "fewoih7" (arr.[*,*].GetLowerBound(0) = 0) + test "fewoih8" (arr.[*,*].GetLowerBound(1) = 0) + test "fewoih9" (arr.[*,*].[0..,1] = [|(5, 5); (6, 5); (7, 5)|]) + test "fewoih10" (arr.[*,*].[1..,1] = [|(6, 5); (7, 5)|]) + let arr2d = + let arr = Array2D.zeroCreateBased 5 4 3 2 + for i in 5..7 do for j in 4..5 do arr.[i,j] <- (i,j) + arr + let arr2d2 = + let arr = Array2D.zeroCreate 3 2 + for i in 0..2 do for j in 0..1 do arr.[i,j] <- (j,i) + arr + test "fewoih11" (arr2d.[6..6,5] = [|(6, 5)|]) + test "fewoih11" (arr2d.[..6,5] = [|(5, 5); (6, 5)|]) + test "fewoih11" (arr2d.[6..,5] = [|(6, 5); (7, 5)|]) + test "fewoih12" (arr2d.[*,*].[1..,1] = [|(6, 5); (7, 5)|]) + arr2d.[*,*] <- arr2d2 + test "fewoih13" (arr2d.[*,*].[0..0,1] = [|(1, 0)|]) + test "fewoih13" (arr2d.[*,*].[1..,1] = [|(1, 1); (1, 2)|]) + test "fewoih13" (arr2d.[*,*].[1,1..] = [|(1, 1)|]) + test "fewoih13" (arr2d.[*,*].[1,0..0] = [|(0, 1)|]) + let arr3d = + let arr = System.Array.CreateInstance(typeof, [| 3;2;1 |], [|5;4;3|]) :?> (int*int*int)[,,] + for i in 5..7 do for j in 4..5 do for k in 3..3 do arr.[i,j,k] <- (i,j,k) + arr + let arr3d2 = + let arr = System.Array.CreateInstance(typeof, [| 3;2;1 |]) :?> (int*int*int)[,,] + for i in 0..2 do for j in 0..1 do for k in 0..0 do arr.[i,j,k] <- (k,j,i) + arr + + test "fewoih14" (arr3d.[5,4,3] = (5,4,3)) + test "fewoih15" (arr3d.[*,*,*].[0,0,0] = (5,4,3)) + arr3d.[*,*,*] <- arr3d2 + test "fewoih16" (arr3d.[5,4,3] = (0,0,0)) + test "fewoih16" (arr3d.[5,5,3] = (0,1,0)) + test "fewoih16" (arr3d.[6,5,3] = (0,1,1)) + let _ = runTest() + +module Array3Tests = begin + + let test_make_get_set_length () = + let arr = Array3D.create 3 4 5 0 in + test "fewoih1" (Array3D.get arr 0 0 0 = 0); + test "fewoih2" (Array3D.get arr 0 1 0 = 0); + test "vvrew03" (Array3D.get arr 2 2 2 = 0); + test "vvrew04" (Array3D.get arr 2 3 4 = 0); + ignore (Array3D.set arr 0 2 3 4); + test "vsdiuvs5" (Array3D.get arr 0 2 3 = 4); + arr.[0,2,3] <- 2; + test "vsdiuvs6" (arr.[0,2,3] = 2); + arr.[0,2,3] <- 3; + test "vsdiuvs" (arr.[0,2,3] = 3); + test "vropivrwe7" (Array3D.length1 arr = 3); + test "vropivrwe8" (Array3D.length2 arr = 4); + test "vropivrwe9" (Array3D.length3 arr = 5) + + let _ = test_make_get_set_length () + +end + +module Array4Tests = begin + + let test_make_get_set_length () = + let arr = Array4D.create 3 4 5 6 0 in + arr.[0,2,3,4] <- 2; + test "vsdiuvsq" (arr.[0,2,3,4] = 2); + arr.[0,2,3,4] <- 3; + test "vsdiuvsw" (arr.[0,2,3,4] = 3); + test "vsdiuvsw" (Array4D.get arr 0 2 3 4 = 3); + Array4D.set arr 0 2 3 4 5; + test "vsdiuvsw" (Array4D.get arr 0 2 3 4 = 5); + test "vropivrwee" (Array4D.length1 arr = 3); + test "vropivrwer" (Array4D.length2 arr = 4); + test "vropivrwet" (Array4D.length3 arr = 5) + test "vropivrwey" (Array4D.length4 arr = 6) + + let test_init () = + let arr = Array4D.init 3 4 5 6 (fun i j k m -> i+j+k+m) in + test "vsdiuvs1" (arr.[0,2,3,4] = 9); + test "vsdiuvs2" (arr.[0,2,3,3] = 8); + test "vsdiuvs3" (arr.[0,0,0,0] = 0); + arr.[0,2,3,4] <- 2; + test "vsdiuvs4" (arr.[0,2,3,4] = 2); + arr.[0,2,3,4] <- 3; + test "vsdiuvs5" (arr.[0,2,3,4] = 3); + test "vropivrwe1" (Array4D.length1 arr = 3); + test "vropivrwe2" (Array4D.length2 arr = 4); + test "vropivrwe3" (Array4D.length3 arr = 5) + test "vropivrwe4" (Array4D.length4 arr = 6) + + let _ = test_make_get_set_length () + let _ = test_init () + +end + +// nb. PERF TESTING ONLY WITH v2.0 (GENERICS) +#if PERF +let test_map_perf () = + let arr1 = [| 4;3;2 |] in + let res = ref (Array.map (fun x -> x + 1) arr1) in + for i = 1 to 20000000 do + res := Array.map (fun x -> x + 1) arr1 + done; + test "test2927: sdvjk2" (Array.get !res 0 = 5) + +let _ = test_map_perf() +#endif + +module SeqCacheAllTest = + let s2 = + let count = ref 0 + let s = Seq.cache (seq { for i in 0 .. 10 -> (count.Value <- count.Value + 1; i) }) :> seq<_> + let test0 = (count.Value = 0) + let e1 = s.GetEnumerator() + let test1 = (count.Value = 0) + printf "test1 = %b\n" test1; + for i = 1 to 1 do (e1.MoveNext() |> ignore; e1.Current |> ignore) + let test2 = (count.Value = 1) + printf "test2 = %b\n" test2; + let e2 = s.GetEnumerator() + for i = 1 to 5 do (e2.MoveNext() |> ignore; e2.Current |> ignore) + let test3 = (count.Value = 5) + printf "test3 = %b\n" test3; + let e3 = s.GetEnumerator() + for i = 1 to 5 do (e3.MoveNext() |> ignore; e3.Current |> ignore) + let test4 = (count.Value = 5) + printf "test4 = %b\n" test4; + let e4 = s.GetEnumerator() + for i = 1 to 3 do (e4.MoveNext() |> ignore; e4.Current |> ignore) + let test5 = (count.Value = 5) + printf "test5 = %b\n" test5; + + let test6 = [ for x in s -> x ] = [ 0 .. 10 ] + printf "test6 = %b\n" test6; + for x in s do () + let test7 = (count.Value = 11) + let test8 = [ for x in s -> x ] = [ 0 .. 10 ] + let test9 = count.Value = 11 + test "test0" test0 + test "test1" test1 + test "test2" test2 + test "test3" test3 + test "test4" test4 + test "test5" test5 + test "test6" test6 + test "test7" test7 + test "test8" test8 + test "test9" test9 + + +module ArrayStructMutation = + module Array1D = + module Test1 = + [] + type T = + val mutable i : int + let a = Array.create 10 Unchecked.defaultof + a.[0].i <- 27 + check "wekvw0301" 27 a.[0].i + + + module Test2 = + + [] + type T = + val mutable public i : int + member public this.Set i = this.i <- i + let a = Array.create 10 Unchecked.defaultof + a.[0].Set 27 + a.[2].Set 27 + check "wekvw0302" 27 a.[0].i + check "wekvw0303" 27 a.[2].i + + module Array2D = + module Test1 = + [] + type T = + val mutable i : int + let a = Array2D.create 10 10 Unchecked.defaultof + a.[0,0].i <- 27 + check "wekvw0304" 27 a.[0,0].i + + + module Test2 = + + [] + type T = + val mutable public i : int + member public this.Set i = this.i <- i + let a = Array2D.create 10 10 Unchecked.defaultof + a.[0,0].Set 27 + a.[0,2].Set 27 + check "wekvw0305" 27 a.[0,0].i + check "wekvw0306" 27 a.[0,2].i + + + module Array3D = + module Test1 = + [] + type T = + val mutable i : int + let a = Array3D.create 10 10 10 Unchecked.defaultof + a.[0,0,0].i <- 27 + a.[0,2,3].i <- 27 + check "wekvw0307" 27 a.[0,0,0].i + check "wekvw0308" 27 a.[0,2,3].i + + + module Test2 = + + [] + type T = + val mutable public i : int + member public this.Set i = this.i <- i + let a = Array3D.create 10 10 10 Unchecked.defaultof + a.[0,0,0].Set 27 + a.[0,2,3].Set 27 + check "wekvw0309" 27 a.[0,0,0].i + check "wekvw030q" 27 a.[0,2,3].i + + module Array4D = + module Test1 = + [] + type T = + val mutable i : int + let a = Array4D.create 10 10 10 10 Unchecked.defaultof + a.[0,0,0,0].i <- 27 + a.[0,2,3,4].i <- 27 + check "wekvw030w" 27 a.[0,0,0,0].i + check "wekvw030e" 27 a.[0,2,3,4].i + + + module Test2 = + + [] + type T = + val mutable public i : int + member public this.Set i = this.i <- i + let a = Array4D.create 10 10 10 10 Unchecked.defaultof + a.[0,0,0,0].Set 27 + a.[0,2,3,4].Set 27 + check "wekvw030r" 27 a.[0,0,0,0].i + check "wekvw030t" 27 a.[0,2,3,4].i + +module LoopTests = + let loop3 a N = + let mutable x = 0 in + // In this loop, the types of 'a' and 'N' are not known prior to the loop + for i in (min a a) .. N do + x <- x + 1 + done; + check (sprintf "clkrerev90-%A" (a,N)) x (if N < a then 0 else N - a + 1) + + + do loop3 0 10 + do loop3 0 0 + do loop3 0 -1 + do loop3 10 9 + + let loop4 a N = + let mutable x = 0 in + for i in OperatorIntrinsics.RangeInt32 a 1 N do + x <- x + 1 + done; + check (sprintf "clkrerev91-%A" (a,N)) x (if N < a then 0 else N - a + 1) + + do loop4 0 10 + do loop4 0 0 + do loop4 0 -1 + do loop4 10 9 + + let loop5 a N = + let mutable x = 0 in + // In this loop, the types of 'a' and 'N' are not known prior to the loop + for i in (min a a) .. 2 .. (min N N) do + x <- x + 1 + done; + check (sprintf "clkrerev92-%A" (a,N)) x ((if N < a then 0 else N - a + 2) / 2) + + do loop5 0 10 + do loop5 0 0 + do loop5 0 -1 + do loop5 10 9 + + + let loop6 a N = + let mutable x = 0 in + // In this loop, the types of 'a' and 'N' are not known prior to the loop + for i in (min a a) .. 200 .. (min N N) do + x <- x + 1 + done; + check (sprintf "clkrerev93-%A" (a,N)) x ((if N < a then 0 else N - a + 200) / 200) + + do loop6 0 10 + do loop6 0 0 + do loop6 0 -1 + do loop6 10 9 + + + let loop7 a step N = + let mutable x = 0 in + // In this loop, the types of 'a' and 'N' are not known prior to the loop + for i in (min a a) .. step .. (min N N) do + x <- x + 1 + done; + check (sprintf "clkrerev95-%A" (a,step,N)) x (if step < 0 then (if a < N then 0 else (a - N + abs step) / abs step) else (if N < a then 0 else N - a + step) / step) + + do loop7 0 1 10 + do loop7 0 -1 0 + do loop7 0 2 -1 + do loop7 10 -2 9 + + let loop8 a N = + let mutable x = 0 in + // In this loop, the types of 'a' and 'N' are not known prior to the loop + for i in (min a a) .. -1 .. (min N N) do + x <- x + 1 + done; + check (sprintf "clkrerev96-%A" (a,N)) x (abs (if a < N then 0 else (a - N + 1) / 1)) + + do loop8 0 10 + do loop8 0 0 + do loop8 0 -1 + do loop8 10 9 + +// Some more adhoc testing - the use of 'min' gives rise to a let binding in optimized code +module MoreLoopTestsWithLetBindings = + let loop3 a N = + let mutable x = 0 in + // In this loop, the types of 'a' and 'N' are not known prior to the loop + for i in (min a a) .. (min N N) do + x <- x + 1 + done; + check (sprintf "ffclkrerev90-%A" (a,N)) x (if N < a then 0 else N - a + 1) + + + do loop3 0 10 + do loop3 0 0 + do loop3 0 -1 + do loop3 10 9 + do for start in -3 .. 3 do for finish in -3 .. 3 do loop3 start finish + + let loop4 a N = + let mutable x = 0 in + for i in OperatorIntrinsics.RangeInt32 a 1 N do + x <- x + 1 + done; + check (sprintf "ffclkrerev91-%A" (a,N)) x (if N < a then 0 else N - a + 1) + + do loop4 0 10 + do loop4 0 0 + do loop4 0 -1 + do loop4 10 9 + do for start in -3 .. 3 do for finish in -3 .. 3 do loop4 start finish + + let loop5 a N = + let mutable x = 0 in + // In this loop, the types of 'a' and 'N' are not known prior to the loop + for i in (min a a) .. 2 .. (min N N) do + x <- x + 1 + done; + check (sprintf "ffclkrerev92-%A" (a,N)) x ((if N < a then 0 else N - a + 2) / 2) + + do loop5 0 10 + do loop5 0 0 + do loop5 0 -1 + do loop5 10 9 + do for start in -3 .. 3 do for finish in -3 .. 3 do loop5 start finish + + + let loop6 a N = + let mutable x = 0 in + // In this loop, the types of 'a' and 'N' are not known prior to the loop + for i in (min a a) .. 200 .. (min N N) do + x <- x + 1 + done; + check (sprintf "ffclkrerev93-%A" (a,N)) x ((if N < a then 0 else N - a + 200) / 200) + + do loop6 0 10 + do loop6 0 0 + do loop6 0 -1 + do loop6 10 9 + do for start in -3 .. 3 do for finish in -3 .. 3 do loop6 start finish + + + let loop7 a step N = + let mutable x = 0 in + // In this loop, the types of 'a' and 'N' are not known prior to the loop + for i in (min a a) .. step .. (min N N) do + x <- x + 1 + done; + check (sprintf "ffclkrerev95-%A" (a,step,N)) x (if step < 0 then (if a < N then 0 else (a - N + abs step) / abs step) else (if N < a then 0 else N - a + step) / step) + + do loop7 0 1 10 + do loop7 0 -1 0 + do loop7 0 2 -1 + do loop7 10 -2 9 + do for start in -3 .. 3 do for finish in -3 .. 3 do for step in [-2; -1; 1; 2] do loop7 start step finish + + let loop8 a N = + let mutable x = 0 in + // In this loop, the types of 'a' and 'N' are not known prior to the loop + for i in (min a a) .. -1 .. (min N N) do + x <- x + 1 + done; + check (sprintf "ffclkrerev96-%A" (a,N)) x (abs (if a < N then 0 else (a - N + 1) / 1)) + + do loop8 0 10 + do loop8 0 0 + do loop8 0 -1 + do loop8 10 9 + do for start in -3 .. 3 do for finish in -3 .. 3 do loop8 start finish + +module bug872632 = + type MarkerStyle = + | None = 0 + | Square = 1 + | Circle = 2 + | Diamond = 3 + | Triangle = 4 + | Triangle1 = 10 + | Cross = 5 + | Star4 = 6 + | Star5 = 7 + | Star6 = 8 + | Star10 = 9 + + + + module Foo = + let x = [| + MarkerStyle.Circle + MarkerStyle.Cross + MarkerStyle.Star6 + MarkerStyle.Diamond + MarkerStyle.Square + MarkerStyle.Star10 + MarkerStyle.Triangle + MarkerStyle.Triangle1 + |] + + do check "bug872632" Foo.x.Length 8 + +module CheckUnionTypesAreSealed = + open System +#if NETCOREAPP + open System.Reflection + type System.Type with + member this.IsSealed + with get () = this.GetTypeInfo().IsSealed +#endif + + do check "vwllfewlkefw1" (typedefof>.IsSealed) true + do check "vwllfewlkefw2" (typedefof>.IsSealed) true + type X1 = A | B + do check "vwllfewlkefw3" (typedefof.IsSealed) true + type X2 = A | B of string + do check "vwllfewlkefw4" (typedefof.IsSealed) false + type X3 = A | B | C + do check "vwllfewlkefw5" (typedefof.IsSealed) true + type X4 = A | B | C | D | E | F | G | H | I + do check "vwllfewlkefw5" (typedefof.IsSealed) true + + [] + type SetTree<'T> = + | SetEmpty + | SetNode of 'T * SetTree<'T> * SetTree<'T> + do check "vwllfewlkefw6" (typedefof>.IsSealed) true + + type SetTree2<'T> = + | SetEmpty + | SetNode of 'T * SetTree2<'T> * SetTree2<'T> + do check "vwllfewlkefw6" (typedefof>.IsSealed) false + +module manyIndexes = + open System + + // Bug in F# 3.1: Indexer Properties was incorrectly limited to 4 arguments. There were no limits in previous versions of F#, and shouldn't be in future versions + // Repro code for bug in F# 3.1. This compiles perfectly in F# 3.0 + + // ---------------------------------------------------------------------------- + type Test () = + /// Variable number of arguments with indexer property + member x.Item with get ([] objs: obj[]) = objs + + /// PASS: Variable number of arguments with member function + member x.Foo ([] objs: obj[]) = objs + + // ---------------------------------------------------------------------------- + let CompileIndexerTest = + let test = Test () + + // No problems with method having vaiable number of parameters + let u1 = test.Foo(null, null, null, null) + let u2 = test.Foo(null, null, null, null, null) + let u3 = test.Foo(null, null, null, null, null, null, null, null, null) + + // Bug was that the indexer Property was limited to 4 parameters (Issue introduced by matrix slicing code) + let u4 = test.[null] + let u5 = test.[null, null] + let u6 = test.[null, null, null] + let u7 = test.[null, null, null, null] + let u8 = test.[null, null, null, null, null] // Ensure that F# 3.1 is not unhappy with more than 4 arguments + let u9 = test.[null, null, null, null, null, null, null, null, null, null, null, null, null] // Ensure that F# 3.1 is not unhappy with many more than 4 arguments, 13 arguments would be really unlucky + 0 + + +#if !NETCOREAPP +module bug6447 = + let a = System.Array.CreateInstance(typeof, [|1|], [|1|]) + let a1 = System.Array.CreateInstance(typeof, [|1|], [|3|]) + let a2 = System.Array.CreateInstance(typeof, [|3|], [|1|]) + + do check "bug6447_bound1" a a + do check "bug6447_bound3" a1 a1 + do check "bug6447_bound1_3" a2 a2 + do check "bug6447_a_lt_a" (Unchecked.compare a a) 0 + do check "bug6447_a_eq_a1" (Unchecked.equals a a1) false + do check "bug6447_a_lt_a1" (Unchecked.compare a a1) -1 + do check "bug6447_a_lt_a1" (Unchecked.compare a1 a) 1 + do check "bug6447_a_eq_a2" (Unchecked.equals a a2) false + do check "bug6447_a_lt_a2" (Unchecked.compare a a2) -1 + do check "bug6447_a_lt_a2" (Unchecked.compare a2 a) 1 + do check "bug6447_a1_eq_a2" (Unchecked.equals a1 a2) false + do check "bug6447_a1_gt_a2" (Unchecked.compare a2 a1) 1 + do check "bug6447_a1_lt_a2" (Unchecked.compare a1 a2) -1 + do check "bug6447_a1_lt_a2" (Unchecked.compare a2 a1) 1 + do check "bug6447_a2_eq_a1" (Unchecked.equals a2 a1) false + do check "bug6447_a2_gt_a2" (Unchecked.compare a2 a1) 1 + do check "bug6447_a2_lt_a1" (Unchecked.compare a1 a2) -1 + do check "bug6447_hash_a" (hash a) 631 + do check "bug6447_hash_a1" (hash a1) 1893 + do check "bug6447_hash_a2" (hash a2) 10727 +#endif + +#if TESTS_AS_APP +let RUN() = failures +#else +let aa = + match failures with + | [] -> + stdout.WriteLine "Test Passed" + System.IO.File.WriteAllText("test.ok","ok") + exit 0 + | _ -> + stdout.WriteLine "Test Failed" + exit 1 +#endif + diff --git a/tests/fsharp/core/classStructInterface/test.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/class_struct_interface.fsx similarity index 100% rename from tests/fsharp/core/classStructInterface/test.fsx rename to tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/class_struct_interface.fsx diff --git a/tests/fsharp/core/functionTypes/test.fs b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/function_types.fs similarity index 100% rename from tests/fsharp/core/functionTypes/test.fs rename to tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/function_types.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/generic_measures.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/generic_measures.fsx new file mode 100644 index 00000000000..58980f9d51f --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/generic_measures.fsx @@ -0,0 +1,74 @@ +module Core_genericMeasures + +[] +[] + type C<'T> () = + member val P = 1 with get,set + +[] type t +[] type t2 +let f1 (_ : int) = () +let f2 (_ : float) = () +let f3 (_ : int<_>) = () +let f4 (_ : float<_>) = () +let f5 (_ : C<'a>) = () +let f6 (xs : list<'a>) = + match box xs with + | null -> failwith "unexpected null list" + | _ -> if List.length xs <> 0 then failwith "expected empty list" +let f7 (xs : list<'a>) = + match box xs with + | null -> failwith "unexpected null list" + | _ -> if List.length xs <> 0 then failwith "expected empty list" + +let foo() = + let a = 0<_> + let b = 0.0<_> + let c = null : C> + let c2 = c : C> + let d = null : C> + let e = [] : list> + let f = [] : list> + let g = null : C * _> + let h = null : C<_ * int<_> * _> + let i : List> = List.empty + let j : List> = List.empty + let k : List> = j + + f1 a + f2 b + f3 a + f4 b + f5 c + f5 c2 + f5 d + f6 e + f6 f + f5 g + f5 h + f6 i + f6 j + f7 (i : List>) + f7 (i : List>) + f7 (j : List>) + f7 (j : List>) + f7 (k : List>) + f7 (k : List>) + +[] +type T = + static member Foo(_ : int) = () + static member Foo1(_ : int<_>) = () + + static member Bar() = + let x = 0<_> + T.Foo(x) + + static member Baz() = + let x = 0<_> + T.Foo1(x) + +let RunAll() = + foo() + T.Bar() + T.Baz() \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/innerpoly.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/innerpoly.fsx new file mode 100644 index 00000000000..140c584ed79 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/innerpoly.fsx @@ -0,0 +1,448 @@ +// #Conformance #Regression #LetBindings #TypeInference +#if TESTS_AS_APP +module Core_innerpoly +#endif + +let failures = ref [] + +let report_failure (s : string) = + stderr.Write" NO: " + stderr.WriteLine s + failures.Value <- failures.Value @ [s] + +let test (s : string) b = + stderr.Write(s) + if b then stderr.WriteLine " OK" + else report_failure (s) + +let check s b1 b2 = test s (b1 = b2) + +module TestNullIsGeneralizeable = begin + + open System.Collections.Generic + let nullList : List<'a> = null + + // check this is generic + + let v1 = (nullList : List) + let v2 = (nullList : List) +end + +let f (x:'a) = + let rec g1 y z = g2 y z + and g2 y z = g1 y z in + g1 "a" 1, g1 1 "a", g2 "a" "b", g2 3 4 + + +#if OCAML_RECORD_FIELDS +type z = { x : 'a. int -> 'a } + +let z2 = { x = (fun x -> failwith "a") } + +let f3 (x:int) = failwith "a" +let z3 = { x = f3 } + +let f2 n = + let z2 = { x = (fun (x:int) -> failwith (string_of_int (x+n))) } in + let f3 (x:int) = failwith "a" in + z2 + +let _ : string = try (f2 3).x(3) ^ "unused" with Failure _ -> "" +#endif + + + + +let id x = x + +type ('a,'b) r = {a : 'a list; b: 'b list list } +type ('a,'b) r2 = R2 of 'a list * 'b list list + +let () = + // yes folks, OCaml and F# support let-polymorphism for non-trivial patterns such as these + let a,b = None,None in + let _ = (a : int option) in + let _ = (a : string option) in + let _ = (b : int option) in + let _ = (b : string option) in + let f (x:'a) (y:'b) = + let _ = (a : 'a option) in + let _ = (a : 'b option) in + let _ = (b : 'a option) in + let _ = (b : 'b option) in + () in + f 1 "a"; + f 1 1; + let {a=a;b=b} = {a=[];b=[[]]} in + let _ = (a : int list) in + let _ = (a : string list) in + let _ = (b : int list list) in + let _ = (b : string list list) in + let f (x:'a) (y:'b) = + let _ = (a : 'a list) in + let _ = (a : 'a list) in + let _ = (b : 'b list list) in + let _ = (b : 'b list list) in + () in + f 1 "a"; + f 1 1; + let (R2(a,b)) = R2 ([],[[]]) in + let _ = (a : int list) in + let _ = (a : string list) in + let _ = (b : int list list) in + let _ = (b : string list list) in + let f (x:'a) (y:'b) = + let _ = (a : 'a list) in + let _ = (a : 'a list) in + let _ = (b : 'b list list) in + let _ = (b : 'b list list) in + () in + f 1 "a"; + f 1 1; + let (R2((a as a2),(b as b2))) = R2 ([],[[]]) in + let _ = (a2 : int list) in + let _ = (a2 : string list) in + let _ = (b2 : int list list) in + let _ = (b2 : string list list) in + let f (x:'a) (y:'b) = + let _ = (a2 : 'a list) in + let _ = (a2 : 'a list) in + let _ = (b2 : 'b list list) in + let _ = (b2 : 'b list list) in + () in + f 1 "a"; + f 1 1; + // possibly-failing versions of the above + + let [(a,b)] = [(None,None)] in + let _ = (a : int option) in + let _ = (a : string option) in + let _ = (b : int option) in + let _ = (b : string option) in + let f (x:'a) (y:'b) = + let _ = (a : 'a option) in + let _ = (a : 'b option) in + let _ = (b : 'a option) in + let _ = (b : 'b option) in + () in + f 1 "a"; + f 1 1; + let [{a=a;b=b}] = [{a=[];b=[[]]}] in + let _ = (a : int list) in + let _ = (a : string list) in + let _ = (b : int list list) in + let _ = (b : string list list) in + let f (x:'a) (y:'b) = + let _ = (a : 'a list) in + let _ = (a : 'a list) in + let _ = (b : 'b list list) in + let _ = (b : 'b list list) in + () in + f 1 "a"; + f 1 1; + let [(R2(a,b))] = [R2 ([],[[]])] in + let _ = (a : int list) in + let _ = (a : string list) in + let _ = (b : int list list) in + let _ = (b : string list list) in + let f (x:'a) (y:'b) = + let _ = (a : 'a list) in + let _ = (a : 'a list) in + let _ = (b : 'b list list) in + let _ = (b : 'b list list) in + () in + f 1 "a"; + f 1 1; + let [(R2((a as a2),(b as b2)))] = [R2 ([],[[]])] in + let _ = (a2 : int list) in + let _ = (a2 : string list) in + let _ = (b2 : int list list) in + let _ = (b2 : string list list) in + let f (x:'a) (y:'b) = + let _ = (a2 : 'a list) in + let _ = (a2 : 'a list) in + let _ = (b2 : 'b list list) in + let _ = (b2 : 'b list list) in + () in + f 1 "a"; + f 1 1; + () + + + +let _ = + let f x = x in + f (printfn "%s") "Hello, world!\n"; + f (printfn "%d") 3; + f (printfn "%s") "Hello, world!\n" + +let test5365() = + let f x = x in + f (printfn "%s") "Hello, world!\n"; + f (printfn "%d") 3; + f (printfn "%s") "Hello, world!\n" + +do test5365() +do test5365() + +module TestOptimizationOfTypeFunctionsWithSideEffects = begin + let mutable count = 0 + let f<'a> = count <- (count + 1); count + + + do test "eoeo23c1" (f = 1) + do test "eoeo23c2" (f = 2) + do test "eoeo23c3" (f = 3) + + let x1 = f + + do test "eoeo23c4" (x1 = 4) + do test "eoeo23c5" (x1 = 4) +end + +module Bug1126BenjaminTeuber = begin + let Run() = + // put in the declaration and the error vanishes + let PrintAll (values(* : int seq*)) = + for value in values do + printf "%i" value + done + let CallPrintAll (values : int seq) = + printfn "Caling Sum" ; + values |> PrintAll in + printfn "Done" ; + let MyFun () = + let mySeq = [5 ; 5] |> List.toSeq in + mySeq |> CallPrintAll in + MyFun() + + do Run() +end + +module FSharp_1_0_Bug1024 = begin + let mutable count = 1 + let x<'a> = (count <- count + 1); typeof<'a> + + do test "vnwo9wu1" (count = 1) + let z0<'a> = x<'a> + do test "vnwo9wu1" (count = 1) + let z1 = x + do test "vnwo9wu2" (count = 2) + let z2 = x + do test "vnwo9wu3" (count = 3) + +end +module FSharp_1_0_Bug1024B = begin + let mutable count = 1 + let r<'a> = (count <- count + 1); ref ([] : 'a list) + do test "vnwo9wu1" (count = 1) + let x1 = r + + do test "vnwo9wu1" (count = 2) + let z0 = x1 + do test "vnwo9wu1" (count = 2) + let (z1,z2) = (x1,x1) + do test "vnwo9wu2" (count = 2) + let z3 = x1 + do test "vnwo9wu3" (count = 2) + +end + + + +module CheckGenericInnerMethodWithClassConstraint = begin + let Main() = + // null Seq + let func x = null + let initFinite = Seq.init 3 func + let expectedNullSeq = seq [ null;null;null] + printfn "%A" initFinite + + Main() +end + +module CheckGenericInnerMethodWithNullableConstraint = begin + let Main() = + // null Seq + let func x = System.Nullable(2) + let initFinite = Seq.init 3 func + printfn "%A" initFinite + + Main() +end + +module CheckGenericInnerMethodWithNullConstraintMicro = begin + let Main() = + // null Seq + let func (x:int) : 'T when 'T : null = Unchecked.defaultof<'T> + let initFinite = Seq.init 3 func + printfn "%A" initFinite + + Main() +end + +module CheckGenericInnerMethodWithStructConstraintMicro = begin + let Main() = + // null Seq + let func (x:int) : 'T when 'T : struct = Unchecked.defaultof<'T> + let initFinite = Seq.init 3 func + + + printfn "%A" initFinite + + Main() +end + +module CheckGenericInnerMethodWithClassConstraintMicro = begin + let Main() = + // null Seq + let func (x:int) : 'T when 'T : not struct = Unchecked.defaultof<'T> + let initFinite = Seq.init 3 func + + printfn "%A" initFinite + + Main() +end + +module CheckGenericInnerMethodWithUnmanagedConstraintMicro = begin + let Main() = + // null Seq + let func (x:int) : 'T when 'T : unmanaged = Unchecked.defaultof<'T> + let initFinite = Seq.init 3 func + printfn "%A" initFinite + + Main() +end + +module CheckGenericInnerMethodWithDefaultCtorConstraintMicro = begin + let Main() = + // null Seq + let func (x:int) : 'T when 'T : (new : unit -> 'T) = Unchecked.defaultof<'T> + let initFinite = Seq.init 3 func + + + printfn "%A" initFinite + + Main() +end + + +module CheckGenericInnerMethodWithEnumConstraintMicro = begin + let Main() = + // null Seq + let func (x:int) : 'T when 'T : enum = Unchecked.defaultof<'T> + let initFinite = Seq.init 3 func + printfn "%A" initFinite + + Main() +end + +module CheckGenericInnerMethodWithDelegateConstraintMicro = begin + let Main() = + // null Seq + let func (x:int) : 'T when 'T : delegate = Unchecked.defaultof<'T> + let initFinite = Seq.init 3 func + printfn "%A" initFinite + + Main() +end + +module CheckExplicitSignatureWhichHidesDefaultConstraint_DevDiv2_FSharp_95481 = begin + + let inline sincos< ^t when ^t : (static member Sin : ^t -> ^t) + and ^t : (static member Cos : ^t -> ^t)> (a: ^t) = + let y = sin a + let x = cos a + y, x + +end + +// try a "let rec" +module CheckExplicitSignatureWhichHidesDefaultConstraint_DevDiv2_FSharp_95481_Variation1 = begin + + let rec inline sincos< ^t when ^t : (static member Sin : ^t -> ^t) + and ^t : (static member Cos : ^t -> ^t)> (a: ^t) = + let y = sin a + let x = cos a + y, x + + +end + +module CheckExplicitSignatureWhichHidesDefaultConstraint_DevDiv2_FSharp_95481_Variation2 = begin + + let inline sincos (a: ^t) = + let y = sin a + let x = cos a + y, x + +end + +module InnerGenericBindingsInComputationExpressions = begin + let f() = + let r = [| + let N x = System.Nullable<_>(x) + for i in 1..3 do + yield N i + |] + r + f() +end + +module LocalTypeFunctionRequiredForWitnessPassingOfGenericInnerFunctionsConstrainedByMemberConstraints = + let inline clamp16 v = uint16 (max 0. (min 65535. v)) + let inline clamp8 v = uint8 (max 0. (min 255. v)) + [] + type Clampage = + static member inline FromFloat (_ : byte, _ : Clampage) = fun (x : float) -> clamp8 x + static member inline FromFloat (_ : uint16, _ : Clampage) = fun (x : float) -> clamp16 x + + static member inline Invoke (x: float) : 'Num = + let inline call2 (a: ^a, b: ^b) = ((^a or ^b) : (static member FromFloat : _*_ -> _) (b, a)) + let inline call (a: 'a) = fun (x: 'x) -> call2 (a, Unchecked.defaultof<'r>) x : 'r + call Unchecked.defaultof x + + let inline clamp x = Clampage.Invoke x + let x1 : byte = clamp 3.0 + let x2 : uint16 = clamp 3.0 + let x3 : byte = clamp 257.0 + check "clecqwe1" x1 3uy + check "clecqwe2" x2 3us + check "clecqwe3" x3 255uy + +// Same as the above but capturing an extra constrained free type variable 'Free +module LocalTypeFunctionRequiredForWitnessPassingOfGenericInnerFunctionsConstrainedByMemberConstraints2 = + let inline clamp16 v = uint16 (max 0. (min 65535. v)) + let inline clamp8 v = uint8 (max 0. (min 255. v)) + [] + type Clampage = + static member inline FromFloat (_ : byte, _ : Clampage) = fun (x : float) -> clamp8 x + static member inline FromFloat (_ : uint16, _ : Clampage) = fun (x : float) -> clamp16 x + + static member inline Invoke (x: float) (free: 'Free) : 'Num * 'Free = + let inline call2 (a: ^a, b: ^b) = ((^a or ^b) : (static member FromFloat : _*_ -> _) (b, a)) + let inline call (a: 'a) = (fun (x: 'x) -> call2 (a, Unchecked.defaultof<'r>) x : 'r), free + free + let f, info = call Unchecked.defaultof + f x, info + + let inline clamp x free = Clampage.Invoke x free + let (x1a1: byte, x1a2: int64) = clamp 3.0 1L + let (x1b1: uint16, x1b2: string) = clamp 3.0 "abc" + check "clecqwea1" x1a1 3uy + check "clecqwea2" x1a2 2L + check "clecqwea3" x1b1 3us + check "clecqwea4" x1b2 "abcabc" + +module Bug10408 = + let test x = + match x with + | [| |] -> x + | _ -> x + +module Bug11620A = + + let createService (metadata: 'T) : 'Data when 'Data :> System.IComparable = Unchecked.defaultof<'Data> + + let getCreateServiceCallback<'T> (thing: 'T) = + let getService () : 'Data = createService thing + (fun () -> getService) \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/libtest.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/libtest.fsx new file mode 100644 index 00000000000..49a199b5ff3 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/libtest.fsx @@ -0,0 +1,5660 @@ +// #Regression #Conformance #Regression #Exceptions #Constants #LetBindings #Lists #Collections #Stress #Sequences #Optimizations #Records #Unions +#if TESTS_AS_APP +module Core_libtest +#endif + +let (!) (r: 'T ref) = r.Value +let (:=) (r: 'T ref) (v: 'T) = r.Value <- v +let incr (r: int ref) = r.Value <- r.Value + 1 +let decr (r: int ref) = r.Value <- r.Value - 1 + +#nowarn "62" +#nowarn "44" + +let failures = ref [] +let reportFailure s = + stdout.WriteLine "\n................TEST FAILED...............\n"; failures.Value <- failures.Value @ [s] + +let check s e r = + if r = e then stdout.WriteLine (s^": YES") + else (stdout.WriteLine ("\n***** "^s^": FAIL\n"); reportFailure s) + +let test s b = + if b then ( (* stdout.WriteLine ("passed: " + s) *) ) + else (stderr.WriteLine ("failure: " + s); + reportFailure s) + + +let format_uint64 outc formatc width left_justify add_zeros num_prefix_if_pos (n:uint64) = + let _ = match formatc with 'd' | 'i' | 'u' -> 10UL | 'o' -> 8UL | 'x' | 'X'-> 16UL | _ -> failwith "invalid value" in + failwith "hello" + + +(*--------------------------------------------------------------------------- +!* Exceptions + *--------------------------------------------------------------------------- *) + +let myFunc x y = + if x > y then stdout.WriteLine "greater"; + if x < y then stdout.WriteLine "less"; + try + if x = y then stdout.WriteLine "equal"; + failwith "fail"; + reportFailure "ABCDE" + with Failure s -> + stdout.WriteLine "caught!"; + +let _ = myFunc 1 4 +let _ = myFunc "a" "b" +let _ = myFunc "c" "b" +let _ = myFunc "c" "c" +let _ = + myFunc + begin + try + failwith "string1"; + with Failure s -> + s; + end + begin + try + failwith "string2"; + with Failure s -> + s; + end + +let _ = + myFunc + begin + try + begin + try + failwith "yes"; + with e -> + reraise (); failwith "no" + end + with Failure "yes" -> "yes" + end + begin + try + begin + try + failwith "yes"; + with e -> + reraise (); failwith "no" + end + with Failure "yes" -> "yes" + end + + +//--------------------------------------------------------------------------- +// Basic operations +//--------------------------------------------------------------------------- + +#if INVARIANT_CULTURE_STRING_COMPARISON +// These check we are using InvariantCulture string comparison, not Ordinal comparison +let _ = check "vknwwer41" (";" > "0") false +let _ = check "vknwwer42" (";" >= "0") false +let _ = check "vknwwer43" (";" = "0") false +let _ = check "vknwwer44" (";" <> "0") true +let _ = check "vknwwer53" (";" <= "0") true +let _ = check "vknwwer54" (";" < "0") true +let _ = check "vknwwer55" (compare ";" "0") -1 +let _ = check "vknwwer55" (compare "0" ";") 1 + +(* +// check consistency with characters +let _ = check "vknwwer41" (';' > '0') false +let _ = check "vknwwer42" (';' >= '0') false +let _ = check "vknwwer43" (';' = '0') false +let _ = check "vknwwer44" (';' <> '0') true +let _ = check "vknwwer53" (';' <= '0') true +let _ = check "vknwwer54" (';' < '0') true +let _ = check "vknwwer55" (compare ';' '0') -1 +let _ = check "vknwwer55" (compare '0' ';') 1 +*) + +// check consistency with lists of strings +let _ = check "vknwwer41" ([";"] > ["0"]) false +let _ = check "vknwwer42" ([";"] >= ["0"]) false +let _ = check "vknwwer43" ([";"] = ["0"]) false +let _ = check "vknwwer44" ([";"] <> ["0"]) true +let _ = check "vknwwer53" ([";"] <= ["0"]) true +let _ = check "vknwwer54" ([";"] < ["0"]) true +let _ = check "vknwwer55" (compare [";"] ["0"]) -1 +let _ = check "vknwwer55" (compare ["0"] [";"]) 1 + +(* +// check consistency with lists of chars +let _ = check "vknwwer41" ([';'] > ['0']) false +let _ = check "vknwwer42" ([';'] >= ['0']) false +let _ = check "vknwwer43" ([';'] = ['0']) false +let _ = check "vknwwer44" ([';'] <> ['0']) true +let _ = check "vknwwer53" ([';'] <= ['0']) true +let _ = check "vknwwer54" ([';'] < ['0']) true +let _ = check "vknwwer55" (compare [';'] ['0']) -1 +let _ = check "vknwwer55" (compare ['0'] [';']) 1 +*) +#endif + +let getObjectHashCode (x:'a) = (box x).GetHashCode() +let (===) (x:'a) (y:'a) = (box x).Equals(box y) + +let _ = stdout.WriteLine "90erw9" +let _ = if true && true then stdout.WriteLine "YES" else reportFailure "intial test" +let _ = if true && false then reportFailure "basic test 1" else stdout.WriteLine "YES" +let _ = if false && true then reportFailure "basic test 2" else stdout.WriteLine "YES" +let _ = if false && false then reportFailure "basic test 3" else stdout.WriteLine "YES" +let _ = if true || true then stdout.WriteLine "YES" else reportFailure "basic test Q1" +let _ = if true || false then stdout.WriteLine "YES" else reportFailure "basic test Q2" +let _ = if false || true then stdout.WriteLine "YES" else reportFailure "basic test Q3" +let _ = if false || false then reportFailure "basic test 4" else stdout.WriteLine "YES" + +let _ = stdout.WriteLine "vwlkew0" +let _ = if true && true then stdout.WriteLine "YES" else reportFailure "basic test Q4" +let _ = if true && false then reportFailure "basic test 5" else stdout.WriteLine "YES" +let _ = if false && true then reportFailure "basic test 6" else stdout.WriteLine "YES" +let _ = if false && false then reportFailure "basic test 7" else stdout.WriteLine "YES" +let _ = if true || true then stdout.WriteLine "YES" else reportFailure "basic test Q5" +let _ = if true || false then stdout.WriteLine "YES" else reportFailure "basic test Q6" +let _ = if false || true then stdout.WriteLine "YES" else reportFailure "basic test Q7" +let _ = if false || false then reportFailure "basic test 8" else stdout.WriteLine "YES" + +let _ = stdout.WriteLine "vr90vr90" +let truE () = (stdout.WriteLine "."; true) +let falsE () = (stdout.WriteLine "."; false) +let _ = if truE() && truE() then stdout.WriteLine "YES" else reportFailure "basic test Q8" +let _ = if truE() && falsE() then reportFailure "basic test 9" else stdout.WriteLine "YES" +let _ = if falsE() && truE() then reportFailure "basic test 10" else stdout.WriteLine "YES" +let _ = if falsE() && falsE() then reportFailure "basic test 11" else stdout.WriteLine "YES" +let _ = if truE() || truE() then stdout.WriteLine "YES" else reportFailure "basic test Q9" +let _ = if truE() || falsE() then stdout.WriteLine "YES" else reportFailure "basic test Q10" +let _ = if falsE() || truE() then stdout.WriteLine "YES" else reportFailure "basic test Q11" +let _ = if falsE() || falsE() then reportFailure "basic test 12" else stdout.WriteLine "YES" + +let _ = stdout.WriteLine "tgbri123d: " +let truERR () = (reportFailure "basic test 13" ; true) +let falsERR () = (reportFailure "basic test 14" ; false) +let _ = if false && truERR() then reportFailure "basic test 15" else stdout.WriteLine "YES" +let _ = if false && falsERR() then reportFailure "basic test 16" else stdout.WriteLine "YES" +let _ = if true || truERR() then stdout.WriteLine "YES" else reportFailure "basic test Q12" +let _ = if true || falsERR() then stdout.WriteLine "YES" else reportFailure "basic test Q13" + +let _ = stdout.WriteLine "d298c123d: " +let _ = if falsE() && truERR() then reportFailure "basic test 17" else stdout.WriteLine "YES" +let _ = if falsE() && falsERR() then reportFailure "basic test 18" else stdout.WriteLine "YES" +let _ = if truE() || truERR() then stdout.WriteLine "YES" else reportFailure "basic test Q14" +let _ = if truE() || falsERR() then stdout.WriteLine "YES" else reportFailure "basic test Q15" + +let _ = stdout.WriteLine "ddwqd123d: " +let _ = if falsE() && truERR() then reportFailure "basic test 19" else stdout.WriteLine "YES" +let _ = if falsE() && falsERR() then reportFailure "basic test 20" else stdout.WriteLine "YES" +let _ = if truE() || truERR() then stdout.WriteLine "YES" else reportFailure "basic test Q16" +let _ = if truE() || falsERR() then stdout.WriteLine "YES" else reportFailure "basic test Q17" + + +let _ = stdout.WriteLine "d3wq123d: " +let _ = if 1 = 1 then stdout.WriteLine "YES" else reportFailure "basic test Q18" +let _ = if 1 === 1 then stdout.WriteLine "YES" else reportFailure "basic test Q19" +let _ = if 1 < 2 then stdout.WriteLine "YES" else reportFailure "basic test Q20" +let _ = if 2 > 1 then stdout.WriteLine "YES" else reportFailure "basic test Q21" +let _ = if 2 >= 2 then stdout.WriteLine "YES" else reportFailure "basic test Q22" +let _ = if 1 <= 2 then stdout.WriteLine "YES" else reportFailure "basic test Q23" +let _ = if 2 <= 2 then stdout.WriteLine "YES" else reportFailure "basic test Q24" +let _ = if 'c' < 'd' then stdout.WriteLine "YES" else reportFailure "basic test Q25" +let _ = if 'c' <= 'c' then stdout.WriteLine "YES" else reportFailure "basic test Q26" +let _ = if 'c' < 'c' then reportFailure "basic test 21" else stdout.WriteLine "YES" + +let printString (s:string) = System.Console.Write s +let printInt (i:int) = System.Console.Write (string i) +let printNewLine () = System.Console.WriteLine () + +type fpclass = + | CaseA + | CaseB + | CaseC + | CaseD + +let _ = printString "d3123d: "; if CaseA = CaseA then stdout.WriteLine "YES" else reportFailure "basic test Q27" +(*let _ = if FP_subnormal = FP_subnormal then stdout.WriteLine "YES" else reportFailure "basic test Q28" *) +let _ = if CaseB = CaseB then stdout.WriteLine "YES" else reportFailure "basic test Q29" +let _ = if CaseB === CaseB then stdout.WriteLine "YES" else reportFailure "basic test Q30" +let _ = if CaseC = CaseC then stdout.WriteLine "YES" else reportFailure "basic test Q31" +let _ = if CaseD = CaseD then stdout.WriteLine "YES" else reportFailure "basic test Q32" +let _ = if CaseD === CaseD then stdout.WriteLine "YES" else reportFailure "basic test Q33" +let _ = if CaseA <= CaseA then stdout.WriteLine "YES" else reportFailure "basic test Q34" +(* let _ = if FP_subnormal <= FP_subnormal then stdout.WriteLine "YES" else reportFailure "basic test Q35"*) +let _ = if CaseB <= CaseB then stdout.WriteLine "YES" else reportFailure "basic test Q36" +let _ = if CaseC <= CaseC then stdout.WriteLine "YES" else reportFailure "basic test Q37" +let _ = if CaseD <= CaseD then stdout.WriteLine "YES" else reportFailure "basic test Q38" +let _ = if CaseA >= CaseA then stdout.WriteLine "YES" else reportFailure "basic test Q39" +(* let _ = if FP_subnormal >= FP_subnormal then stdout.WriteLine "YES" else reportFailure "basic test Q40" *) +let _ = if CaseB >= CaseB then stdout.WriteLine "YES" else reportFailure "basic test Q41" +let _ = if CaseC >= CaseC then stdout.WriteLine "YES" else reportFailure "basic test Q42" +let _ = if CaseD >= CaseD then stdout.WriteLine "YES" else reportFailure "basic test Q43" + +let _ = printString "d1t43: "; if CaseA < CaseA then reportFailure "basic test 22" else stdout.WriteLine "YES" +(* let _ = if CaseA < FP_subnormal then stdout.WriteLine "YES" else reportFailure "basic test Q44"*) +let _ = if CaseA < CaseB then stdout.WriteLine "YES" else reportFailure "basic test Q45" +let _ = if CaseA < CaseC then stdout.WriteLine "YES" else reportFailure "basic test Q46" +let _ = if CaseA < CaseD then stdout.WriteLine "YES" else reportFailure "basic test Q47" + +(* let _ = printString "er321: "; if FP_subnormal < CaseA then reportFailure "basic test Q48" else stdout.WriteLine "YES" +let _ = if FP_subnormal < FP_subnormal then reportFailure "basic test Q49" else stdout.WriteLine "YES" +let _ = if FP_subnormal < CaseB then stdout.WriteLine "YES" else reportFailure "basic test Q50" +let _ = if FP_subnormal < CaseC then stdout.WriteLine "YES" else reportFailure "basic test Q51" +let _ = if FP_subnormal < CaseD then stdout.WriteLine "YES" else reportFailure "basic test Q52" *) + +let _ = printString "ff23f2: ";if CaseB < CaseA then reportFailure "basic test 23" else stdout.WriteLine "YES" +(* let _ = if CaseB < FP_subnormal then reportFailure "basic test Q53" else stdout.WriteLine "YES" *) +let _ = if CaseB < CaseB then reportFailure "basic test 24" else stdout.WriteLine "YES" +let _ = if CaseB < CaseC then stdout.WriteLine "YES" else reportFailure "basic test Q54" +let _ = if CaseB < CaseD then stdout.WriteLine "YES" else reportFailure "basic test Q55" + +let _ = printString "f2234g54: ";if CaseC < CaseA then reportFailure "basic test 25" else stdout.WriteLine "YES" +(* let _ = if CaseC < FP_subnormal then reportFailure "basic test Q56" else stdout.WriteLine "YES" *) +let _ = if CaseC < CaseB then reportFailure "basic test 26" else stdout.WriteLine "YES" +let _ = if CaseC < CaseC then reportFailure "basic test 27" else stdout.WriteLine "YES" +let _ = if CaseC < CaseD then stdout.WriteLine "YES" else reportFailure "basic test Q57" + +let _ = printString "dw432b4: "; if CaseD < CaseA then reportFailure "basic test 28" else stdout.WriteLine "YES" +(* let _ = if CaseD < FP_subnormal then reportFailure "basic test Q58" else stdout.WriteLine "YES" *) +let _ = if CaseD < CaseB then reportFailure "basic test 29" else stdout.WriteLine "YES" +let _ = if CaseD < CaseC then reportFailure "basic test 30" else stdout.WriteLine "YES" +let _ = if CaseD < CaseD then reportFailure "basic test 31" else stdout.WriteLine "YES" + +let _ = printString "fdew093 "; if 1 < 2 then stdout.WriteLine "YES" else reportFailure "basic test Q59" +let _ = if 1 < 1 then reportFailure "basic test 32" else stdout.WriteLine "YES" +let _ = if 1 < 0 then reportFailure "basic test 33" else stdout.WriteLine "YES" +let _ = if -1 < 0 then stdout.WriteLine "YES" else reportFailure "basic test Q60" +let _ = if -1 < 1 then stdout.WriteLine "YES" else reportFailure "basic test Q61" + +let _ = stdout.WriteLine "dwqfwe3t:" +let _ = printInt (compare "abc" "def"); printNewLine() +let _ = printInt (compare "def" "abc"); printNewLine() +let _ = printInt (compare "abc" "abc"); printNewLine() +let _ = printInt (compare "aaa" "abc"); printNewLine() +let _ = printInt (compare "abc" "aaa"); printNewLine() +let _ = printInt (compare "longlonglong" "short"); printNewLine() +let _ = printInt (compare "short" "longlonglong"); printNewLine() +let _ = printInt (compare "" "a"); printNewLine() +let _ = printInt (compare "a" ""); printNewLine() + +let _ = printString "grfwe3t " +let _ = if "abc" < "def" then stdout.WriteLine "YES" else reportFailure "basic test Q62" +let _ = if "def" < "abc" then reportFailure "basic test 34" else stdout.WriteLine "YES" +let _ = if "abc" < "abc" then reportFailure "basic test 35" else stdout.WriteLine "YES" +let _ = if "aaa" < "abc" then stdout.WriteLine "YES" else reportFailure "basic test Q63" +let _ = if "abc" < "aaa" then reportFailure "basic test 36" else stdout.WriteLine "YES" +let _ = if "longlonglong" < "short" then stdout.WriteLine "YES" else reportFailure "basic test Q64" +let _ = if "short" < "longlonglong" then reportFailure "basic test 37" else stdout.WriteLine "YES" +let _ = if "" < "a" then stdout.WriteLine "YES" else reportFailure "basic test Q65" +let _ = if "a" < "" then reportFailure "basic test 38" else stdout.WriteLine "YES" + +let _ = printString "df32v4 " +let _ = if "abc" = "def" then reportFailure "basic test 39" else stdout.WriteLine "YES" +let _ = if "abc" === "def" then reportFailure "basic test 40" else stdout.WriteLine "YES" +let _ = if "def" = "abc" then reportFailure "basic test 41" else stdout.WriteLine "YES" +let _ = if "def" === "abc" then reportFailure "basic test 42" else stdout.WriteLine "YES" +let _ = if "abc" = "abc" then stdout.WriteLine "YES" else reportFailure "basic test Q66" +let _ = if "abc" === "abc" then stdout.WriteLine "YES" else reportFailure "basic test Q67" +let _ = if "aaa" = "abc" then reportFailure "basic test 43" else stdout.WriteLine "YES" +let _ = if "aaa" === "abc" then reportFailure "basic test 44" else stdout.WriteLine "YES" +let _ = if "abc" = "aaa" then reportFailure "basic test 45" else stdout.WriteLine "YES" +let _ = if "abc" === "aaa" then reportFailure "basic test 46" else stdout.WriteLine "YES" +let _ = if "longlonglong" = "short" then reportFailure "basic test 47" else stdout.WriteLine "YES" +let _ = if "longlonglong" === "short" then reportFailure "basic test 48" else stdout.WriteLine "YES" +let _ = if "short" = "longlonglong" then reportFailure "basic test 49" else stdout.WriteLine "YES" +let _ = if "short" === "longlonglong" then reportFailure "basic test 50" else stdout.WriteLine "YES" +let _ = if "" = "" then stdout.WriteLine "YES" else reportFailure "basic test Q68" +let _ = if "" === "" then stdout.WriteLine "YES" else reportFailure "basic test Q69" +let _ = if "" = "a" then reportFailure "basic test 51" else stdout.WriteLine "YES" +let _ = if "" === "a" then reportFailure "basic test 52" else stdout.WriteLine "YES" +let _ = if "a" = "" then reportFailure "basic test 53" else stdout.WriteLine "YES" +let _ = if "a" === "" then reportFailure "basic test 54" else stdout.WriteLine "YES" + + + + +type abcde = A of int | B of abcde | C of string | D | E +let _ = printString "32432465: "; if A 1 = A 1 then stdout.WriteLine "YES" else reportFailure "basic test Q70" +let _ = if B E = B E then stdout.WriteLine "YES" else reportFailure "basic test Q71" +let _ = if B E === B E then stdout.WriteLine "YES" else reportFailure "basic test Q72" +let _ = if C "3" = C "3" then stdout.WriteLine "YES" else reportFailure "basic test Q73" +let _ = if C "3" === C "3" then stdout.WriteLine "YES" else reportFailure "basic test Q74" +let _ = if D = D then stdout.WriteLine "YES" else reportFailure "basic test Q75" +let _ = if D === D then stdout.WriteLine "YES" else reportFailure "basic test Q76" +let _ = if E = E then stdout.WriteLine "YES" else reportFailure "basic test Q77" +let _ = if E === E then stdout.WriteLine "YES" else reportFailure "basic test Q78" +let _ = printString "320-vrklm: "; if A 1 <= A 1 then stdout.WriteLine "YES" else reportFailure "basic test Q79" +let _ = if B E <= B E then stdout.WriteLine "YES" else reportFailure "basic test Q80" +let _ = if C "3" <= C "3" then stdout.WriteLine "YES" else reportFailure "basic test Q81" +let _ = if D <= D then stdout.WriteLine "YES" else reportFailure "basic test Q82" +let _ = if E <= E then stdout.WriteLine "YES" else reportFailure "basic test Q83" +let _ = printString "9032c32nij: "; if A 1 >= A 1 then stdout.WriteLine "YES" else reportFailure "basic test Q84" +let _ = if B E >= B E then stdout.WriteLine "YES" else reportFailure "basic test Q85" +let _ = if C "3" >= C "3" then stdout.WriteLine "YES" else reportFailure "basic test Q86" +let _ = if D >= D then stdout.WriteLine "YES" else reportFailure "basic test Q87" +let _ = if E >= E then stdout.WriteLine "YES" else reportFailure "basic test Q88" + + +let _ = printString "98vriu32: ";if A 1 < A 1 then reportFailure "basic test Q89" else stdout.WriteLine "YES" +let _ = if A 1 < B E then stdout.WriteLine "YES" else reportFailure "basic test Q90" +let _ = if A 1 < C "3" then stdout.WriteLine "YES" else reportFailure "basic test Q91" +let _ = if A 1 < D then stdout.WriteLine "YES" else reportFailure "basic test Q92" +let _ = if A 1 < E then stdout.WriteLine "YES" else reportFailure "basic test Q93" + +let _ = if B E < A 1 then reportFailure "basic test 55" else stdout.WriteLine "YES" +let _ = if B E < B E then reportFailure "basic test 56" else stdout.WriteLine "YES" +let _ = if B E < C "3" then stdout.WriteLine "YES" else reportFailure "basic test Q94" +let _ = if B E < D then stdout.WriteLine "YES" else reportFailure "basic test Q95" +let _ = if B E < E then stdout.WriteLine "YES" else reportFailure "basic test Q96" + +let _ = if C "3" < A 1 then reportFailure "basic test 57" else stdout.WriteLine "YES" +let _ = if C "3" < B E then reportFailure "basic test 58" else stdout.WriteLine "YES" +let _ = if C "3" < C "3" then reportFailure "basic test 59" else stdout.WriteLine "YES" +let _ = if C "3" < D then stdout.WriteLine "YES" else reportFailure "basic test Q97" +let _ = if C "3" < E then stdout.WriteLine "YES" else reportFailure "basic test Q99" + +let _ = if D < A 1 then reportFailure "basic test 60" else stdout.WriteLine "YES" +let _ = if D < B E then reportFailure "basic test 61" else stdout.WriteLine "YES" +let _ = if D < C "3" then reportFailure "basic test 62" else stdout.WriteLine "YES" +let _ = if D < D then reportFailure "basic test 63" else stdout.WriteLine "YES" +let _ = if D < E then stdout.WriteLine "YES" else reportFailure "basic test Q100" + +let _ = if E < A 1 then reportFailure "basic test 64" else stdout.WriteLine "YES" +let _ = if E < B E then reportFailure "basic test 65" else stdout.WriteLine "YES" +let _ = if E < C "3" then reportFailure "basic test 66" else stdout.WriteLine "YES" +let _ = if E < D then reportFailure "basic test 67" else stdout.WriteLine "YES" +let _ = if E < E then reportFailure "basic test 68" else stdout.WriteLine "YES" + + +(* We put this test in as well as ILX uses a different rep. past 4 non-nullary constructors *) +type abcde2 = Z2 | A2 of int | B2 of abcde2 | C2 of string | D2 of string +let _ = printString "32432ew465: "; if A2 1 = A2 1 then stdout.WriteLine "YES" else reportFailure "basic test Q101" +let _ = printString "32432ew465: "; if A2 1 === A2 1 then stdout.WriteLine "YES" else reportFailure "basic test Q102" +let _ = if B2 Z2 = B2 Z2 then stdout.WriteLine "YES" else reportFailure "basic test Q103" +let _ = if B2 Z2 === B2 Z2 then stdout.WriteLine "YES" else reportFailure "basic test Q104" +let _ = if C2 "3" = C2 "3" then stdout.WriteLine "YES" else reportFailure "basic test Q105" +let _ = if C2 "3" === C2 "3" then stdout.WriteLine "YES" else reportFailure "basic test Q106" +let _ = if D2 "a" = D2 "a" then stdout.WriteLine "YES" else reportFailure "basic test Q107" +let _ = if D2 "a" === D2 "a" then stdout.WriteLine "YES" else reportFailure "basic test Q108" +let _ = if Z2 = Z2 then stdout.WriteLine "YES" else reportFailure "basic test Q109" +let _ = if Z2 === Z2 then stdout.WriteLine "YES" else reportFailure "basic test Q110" +let _ = printString "3vwa20-vrklm: "; if A2 1 <= A2 1 then stdout.WriteLine "YES" else reportFailure "basic test Q111" +let _ = if B2 Z2 <= B2 Z2 then stdout.WriteLine "YES" else reportFailure "basic test Q112" +let _ = if C2 "3" <= C2 "3" then stdout.WriteLine "YES" else reportFailure "basic test Q113" +let _ = if D2 "a" <= D2 "a" then stdout.WriteLine "YES" else reportFailure "basic test Q114" +let _ = if Z2 <= Z2 then stdout.WriteLine "YES" else reportFailure "basic test Q115" +let _ = printString "9vaw032c32nij: "; if A2 1 >= A2 1 then stdout.WriteLine "YES" else reportFailure "basic test Q116" +let _ = if B2 Z2 >= B2 Z2 then stdout.WriteLine "YES" else reportFailure "basic test Q117" +let _ = if C2 "3" >= C2 "3" then stdout.WriteLine "YES" else reportFailure "basic test Q118" +let _ = if D2 "a" >= D2 "a" then stdout.WriteLine "YES" else reportFailure "basic test Q119" +let _ = if Z2 >= Z2 then stdout.WriteLine "YES" else reportFailure "basic test Q120" + +let _ = printString "vae98vriu32: " + +let _ = if Z2 < A2 1 then stdout.WriteLine "YES" else reportFailure "basic test Q121" +let _ = if Z2 < B2 Z2 then stdout.WriteLine "YES" else reportFailure "basic test Q122" +let _ = if Z2 < C2 "3" then stdout.WriteLine "YES" else reportFailure "basic test Q123" +let _ = if Z2 < D2 "a" then stdout.WriteLine "YES" else reportFailure "basic test Q124" +let _ = if Z2 < Z2 then reportFailure "basic test 69" else stdout.WriteLine "YES" + +let _ = printString "vae98312332: " + +let _ = if None < None then reportFailure "basic test 70" else stdout.WriteLine "YES" +let _ = if None > None then reportFailure "basic test 71" else stdout.WriteLine "YES" +let _ = if [] < [] then reportFailure "basic test 72" else stdout.WriteLine "YES" +let _ = if [] > [] then reportFailure "basic test 73" else stdout.WriteLine "YES" +let _ = if None <= None then stdout.WriteLine "YES" else reportFailure "basic test Q125" +let _ = if None >= None then stdout.WriteLine "YES" else reportFailure "basic test Q126" +let _ = if [] <= [] then stdout.WriteLine "YES" else reportFailure "basic test Q127" +let _ = if [] >= [] then stdout.WriteLine "YES" else reportFailure "basic test Q128" + +let _ = printString "rege98312332: " + +let _ = if A2 1 < Z2 then reportFailure "basic test 74" else stdout.WriteLine "YES" +let _ = if A2 1 < A2 1 then reportFailure "basic test 75" else stdout.WriteLine "YES" +let _ = if A2 1 < B2 Z2 then stdout.WriteLine "YES" else reportFailure "basic test Q129" +let _ = if A2 1 < C2 "3" then stdout.WriteLine "YES" else reportFailure "basic test Q130" +let _ = if A2 1 < D2 "a" then stdout.WriteLine "YES" else reportFailure "basic test Q131" + +let _ = printString "328we32: " + +let _ = if B2 Z2 < Z2 then reportFailure "basic test 76" else stdout.WriteLine "YES" +let _ = if B2 Z2 < A2 1 then reportFailure "basic test 77" else stdout.WriteLine "YES" +let _ = if B2 Z2 < B2 Z2 then reportFailure "basic test 78" else stdout.WriteLine "YES" +let _ = if B2 Z2 < C2 "3" then stdout.WriteLine "YES" else reportFailure "basic test Q132" +let _ = if B2 Z2 < D2 "a" then stdout.WriteLine "YES" else reportFailure "basic test Q133" + +let _ = printString "ewknjs232: " + +let _ = if C2 "3" < Z2 then reportFailure "basic test 79" else stdout.WriteLine "YES" +let _ = if C2 "3" < A2 1 then reportFailure "basic test 80" else stdout.WriteLine "YES" +let _ = if C2 "3" < B2 Z2 then reportFailure "basic test 81" else stdout.WriteLine "YES" +let _ = if C2 "3" < C2 "3" then reportFailure "basic test 82" else stdout.WriteLine "YES" +let _ = if C2 "3" < D2 "a" then stdout.WriteLine "YES" else reportFailure "basic test Q134" + +let _ = printString "v30js232: " + +let _ = if D2 "a" < Z2 then reportFailure "basic test 83" else stdout.WriteLine "YES" +let _ = if D2 "a" < A2 1 then reportFailure "basic test 84" else stdout.WriteLine "YES" +let _ = if D2 "a" < B2 Z2 then reportFailure "basic test 85" else stdout.WriteLine "YES" +let _ = if D2 "a" < C2 "3" then reportFailure "basic test 86" else stdout.WriteLine "YES" +let _ = if D2 "a" < D2 "a" then reportFailure "basic test 87" else stdout.WriteLine "YES" + +let _ = printString "erv9232: " + +exception E1 of int +exception E2 of int +exception E3 of int * exn +let _ = printString "exception equality 1"; if (E1(1) = E1(1)) then stdout.WriteLine "YES" else reportFailure "basic test Q135" +let _ = printString "exception equality 2"; if (E1(1) <> E2(1)) then stdout.WriteLine "YES" else reportFailure "basic test Q136" + +let _ = printString "exception equality 3"; if (E3(1,E1(2)) = E3(1,E1(2))) then stdout.WriteLine "YES" else reportFailure "basic test Q137" +let _ = printString "exception equality 4"; if (E3(1,E1(2)) <> E3(1,E2(2))) then stdout.WriteLine "YES" else reportFailure "basic test Q138" + + +let _ = printString "match []? "; if (match [] with [] -> true | _ -> false) then stdout.WriteLine "YES" else reportFailure "basic test Q139" +let _ = printString "[] = []? "; if ([] = []) then stdout.WriteLine "YES" else reportFailure "basic test Q140" + +let _ = printString "2033elk " +let _ = if 1 = 0 then reportFailure "basic test 88" else stdout.WriteLine "YES" +let _ = if 0 = 1 then reportFailure "basic test 89" else stdout.WriteLine "YES" +let _ = if -1 = -1 then stdout.WriteLine "YES" else reportFailure "basic test Q141" + +let _ = printString "209fedq3lk " +let _ = if 1 = 0 then reportFailure "basic test 90" else stdout.WriteLine "YES" +let _ = if 1 === 0 then reportFailure "basic test 91" else stdout.WriteLine "YES" +let _ = if 0 = 1 then reportFailure "basic test 92" else stdout.WriteLine "YES" +let _ = if 0 === 1 then reportFailure "basic test 93" else stdout.WriteLine "YES" +let _ = if -1 = -1 then stdout.WriteLine "YES" else reportFailure "basic test Q142" +let _ = if -1 === -1 then stdout.WriteLine "YES" else reportFailure "basic test Q143" +let _ = if 1 = 1 then stdout.WriteLine "YES" else reportFailure "basic test Q144" +let _ = if 1 === 1 then stdout.WriteLine "YES" else reportFailure "basic test Q145" +let _ = if (LanguagePrimitives.PhysicalEquality CaseB CaseC) then reportFailure "basic test 94" else stdout.WriteLine "YES" +let _ = if (CaseB === CaseC) then reportFailure "basic test 95" else stdout.WriteLine "YES" + +let _ = if (LanguagePrimitives.PhysicalEquality (ref 1) (ref 1)) then reportFailure "basic test 96" else stdout.WriteLine "YES" + + +type abc = A | B | C + + +do test "cwewvewho5" (match box(None: int option) with :? option as v -> (v = None) | _ -> false) + + +do test "cwewe0981" (LanguagePrimitives.IntrinsicFunctions.UnboxGeneric(box(1)) = 1 ) +do test "cwewe0982" ((try ignore(LanguagePrimitives.IntrinsicFunctions.UnboxGeneric(box(1))); false with :? System.InvalidCastException -> true)) +do test "cwewe0983" ((try ignore(LanguagePrimitives.IntrinsicFunctions.UnboxGeneric(null)); false with :? System.NullReferenceException -> true)) +do test "cwewe0984" (LanguagePrimitives.IntrinsicFunctions.UnboxGeneric(box("a")) = "a") +do test "cwewe0985" (LanguagePrimitives.IntrinsicFunctions.UnboxGeneric(null) = null) +do test "cwewe0986" (LanguagePrimitives.IntrinsicFunctions.UnboxGeneric(box(None: int option)) = None) +do test "cwewe0987" (LanguagePrimitives.IntrinsicFunctions.UnboxGeneric(box(None: int option)) = None) +do test "cwewe0988" (LanguagePrimitives.IntrinsicFunctions.UnboxGeneric(box([]: int list)) = []) +do test "cwewe0989" ((try ignore(LanguagePrimitives.IntrinsicFunctions.UnboxGeneric(null)); false with :? System.NullReferenceException -> true)) +do test "cwewe0980" ((try ignore(LanguagePrimitives.IntrinsicFunctions.UnboxGeneric(null)); false with :? System.NullReferenceException -> true)) + +do test "cwewe0981" (unbox(box(1)) = 1 ) +do test "cwewe0982" ((try ignore(unbox(box(1))); false with :? System.InvalidCastException -> true)) +do test "cwewe0983" ((try ignore(unbox(null)); false with :? System.NullReferenceException -> true)) +do test "cwewe0984" (unbox(box("a")) = "a") +do test "cwewe0985" (unbox(null) = null) +do test "cwewe0986" (unbox(box(None: int option)) = None) +do test "cwewe0987" (unbox(box(None: int option)) = None) +do test "cwewe0988" (unbox(box([]: int list)) = []) +do test "cwewe0989" ((try ignore(unbox(null)); false with :? System.NullReferenceException -> true)) +do test "cwewe0980" ((try ignore(unbox(null)); false with :? System.NullReferenceException -> true)) + +do test "cwewe098q" (LanguagePrimitives.IntrinsicFunctions.UnboxFast(box(1)) = 1) +do test "cwewe098w" ((try ignore(LanguagePrimitives.IntrinsicFunctions.UnboxFast(box(1))); false with :? System.InvalidCastException -> true)) +do test "cwewe098e" ((try ignore(LanguagePrimitives.IntrinsicFunctions.UnboxFast(null)); false with :? System.NullReferenceException -> true)) +do test "cwewe098r" (LanguagePrimitives.IntrinsicFunctions.UnboxFast(box("a")) = "a") +do test "cwewe098t" (LanguagePrimitives.IntrinsicFunctions.UnboxFast(null) = null) +do test "cwewe098y" (LanguagePrimitives.IntrinsicFunctions.UnboxFast(box(None: int option)) = None) +do test "cwewe098u" (LanguagePrimitives.IntrinsicFunctions.UnboxFast(box(None: int option)) = None) +//These don't qualify for the quick entry +// unbox_quick(box([]: int list)) = [] +// (try ignore(unbox_quick(null)); false with :? System.NullReferenceException -> true) +// (try ignore(unbox_quick(null)); false with :? System.NullReferenceException -> true) + + +do test "cwewe098a" (LanguagePrimitives.IntrinsicFunctions.TypeTestGeneric(box(1)) ) +do test "cwewe098s" (not(LanguagePrimitives.IntrinsicFunctions.TypeTestGeneric(null))) +do test "cwewe098d" (LanguagePrimitives.IntrinsicFunctions.TypeTestGeneric(box("a")) ) +do test "cwewe098f" (not(LanguagePrimitives.IntrinsicFunctions.TypeTestGeneric(null))) +do test "cwewe098g" (LanguagePrimitives.IntrinsicFunctions.TypeTestGeneric(box(None: int option)) ) +do test "cwewe098h" (LanguagePrimitives.IntrinsicFunctions.TypeTestGeneric(box(None: int option)) ) +do test "cwewe098j" (LanguagePrimitives.IntrinsicFunctions.TypeTestGeneric(box([]: int list)) ) +do test "cwewe098k" (not(LanguagePrimitives.IntrinsicFunctions.TypeTestGeneric(null))) +do test "cwewe098l" (not(LanguagePrimitives.IntrinsicFunctions.TypeTestGeneric(null))) + +do test "cwewe098z" (LanguagePrimitives.IntrinsicFunctions.TypeTestFast(box(1)) ) +do test "cwewe098x" (not(LanguagePrimitives.IntrinsicFunctions.TypeTestFast(null))) +do test "cwewe098c" (LanguagePrimitives.IntrinsicFunctions.TypeTestFast(box("a")) ) +do test "cwewe098v" (not(LanguagePrimitives.IntrinsicFunctions.TypeTestFast(null))) +do test "cwewe098b" (LanguagePrimitives.IntrinsicFunctions.TypeTestFast(box([]: int list)) ) +do test "cwewe098n" (not(LanguagePrimitives.IntrinsicFunctions.TypeTestFast(null))) +do test "cwewe098m" (not(LanguagePrimitives.IntrinsicFunctions.TypeTestFast(null))) + +(* +let istype<'a>(obj:obj) = (obj :? 'a) +let _ = + test "cwewe098z" (istype(box(1)) ); + test "cwewe098x" (not(istype(null))); + test "cwewe098c" (istype(box("a")) ); + test "cwewe098v" (not(istype(null))); + test "cwewe098b" (istype(box([]: int list)) ); + test "cwewe098n" (not(istype(null))); + test "cwewe098m" (not(istype(null))); + () + +*) + +do test "cwewvewho1" (match box(1) with :? int as v -> v = 1 | _ -> true) +do test "cwewvewho2" (match (null:obj) with :? int -> false | _ -> true) +do test "cwewvewho3" (match box("a") with :? string as v -> v = "a" | _ -> true) +do test "cwewvewho4" (match (null:obj) with :? string -> false | _ -> true) +do test "cwewvewho5" (match box(None: int option) with :? option as v -> (v = None) | _ -> false) +do test "cwewvewho6" (match (null:obj) with :? option as v -> (v = None) | _ -> false) +do test "cwewvewho7" (match box(None: int option) with :? option as v -> (v = None) | _ -> false) +do test "cwewvewho8" (match (null:obj) with :? option as v -> (v = None) | _ -> false) +do test "cwewvewho9" (match box(Some 3) with :? option as v -> (v = Some(3)) | _ -> false) +do test "cwewvewho0" (match box(Some 3) with :? option -> false | _ -> true) +do test "cwewvewho-" (match box([3]) with :? list as v -> (v = [3]) | _ -> false) +do test "cwewvewhoa" (match box([3]) with :? list as v -> false | _ -> true) + +do test "cwewvewhos" (match (null:obj) with :? list as v -> false | _ -> true) + +let pattest<'a> (obj:obj) fail (succeed : 'a -> bool) = match obj with :? 'a as x -> succeed x | _ -> fail() + +do test "cwewvewhoq" (pattest (box(1)) (fun () -> false) (fun v -> v = 1)) +do test "cwewvewhow" (pattest (null) (fun () -> true ) (fun _ -> false)) +do test "cwewvewhoe" (pattest(box("a")) (fun () -> false) (fun v -> v = "a")) +do test "cwewvewhor" (pattest(null) (fun () -> true) (fun _ -> false)) +do test "cwewvewhot" (pattest (box(None: int option)) (fun () -> false) (function None -> true | _ -> false)) +do test "cwewvewhoy" (pattest (null) (fun () -> false) (function None -> true | _ -> false)) +do test "cwewvewhou" (pattest(box(None: int option)) (fun () -> false) (function None -> true | _ -> false)) +do test "cwewvewhoi" (pattest(null) (fun () -> false) (function None -> true | _ -> false)) +do test "cwewvewhoo" (pattest (box(Some 3)) (fun () -> false) (function Some 3 -> true | _ -> false)) +do test "cwewvewhop" (pattest(box(Some 3)) (fun () -> true) (fun _ -> false)) +do test "cwewvewhog" (pattest (box(["1"])) (fun () -> false) (fun _ -> true)) +do test "cwewvewhoj" (pattest null (fun () -> true) (fun _ -> false)) + + + + + +let _ = printString "string list structural equality (1): "; if ["abc"] = ["def"] then reportFailure "basic test Q146" else stdout.WriteLine "YES" +let _ = printString "string list object equality (1): "; if ["abc"] === ["def"] then reportFailure "basic test Q147" else stdout.WriteLine "YES" +let _ = printString "string list structural equality (2): "; if ["abc"] = ["abc"] then stdout.WriteLine "YES" else reportFailure "basic test Q148" +let _ = printString "string list object equality (2): "; if ["abc"] === ["abc"] then stdout.WriteLine "YES" else reportFailure "basic test Q149" +let _ = printString "hash respects equality (1): "; if hash [] = hash [] then stdout.WriteLine "YES" else reportFailure "basic test Q150" +let _ = printString "hash respects equality (2): "; if hash [1] = hash [1] then stdout.WriteLine "YES" else reportFailure "basic test Q151" +let _ = printString "hash respects equality (1a): "; if hash A = hash A then stdout.WriteLine "YES" else reportFailure "basic test Q152" +let _ = printString "hash respects equality (3): "; if hash ["abc"] = hash ["abc"] then stdout.WriteLine "YES" else reportFailure "basic test Q153" +let _ = printString "hash respects equality (4): "; if hash ("abc","def") = hash ("abc","def") then stdout.WriteLine "YES" else reportFailure "basic test Q154" +let _ = printString "hash respects equality (4a): "; if hash (A,"def") = hash (A,"def") then stdout.WriteLine "YES" else reportFailure "basic test Q155" +let _ = printString "hash respects equality (4b): "; if hash ([],"def") = hash ([],"def") then stdout.WriteLine "YES" else reportFailure "basic test Q156" +let _ = printString "hash respects equality (4c): "; if hash ([],[]) = hash ([],[]) then stdout.WriteLine "YES" else reportFailure "basic test Q157" +let _ = printString "hash respects equality (4d): "; if hash (A,B) = hash (A,B) then stdout.WriteLine "YES" else reportFailure "basic test Q158" +let _ = printString "hash respects equality (5): "; if hash ("abc","def","efg") = hash ("abc","def","efg") then stdout.WriteLine "YES" else reportFailure "basic test Q159" +let _ = printString "hash respects equality (6): "; if hash ("abc","def","efg","") = hash ("abc","def","efg","") then stdout.WriteLine "YES" else reportFailure "basic test Q160" +let _ = printString "hash respects equality (7): "; if hash ("abc","def","efg","","q") = hash ("abc","def","efg","","q") then stdout.WriteLine "YES" else reportFailure "basic test Q161" +let _ = printString "hash respects equality (8): "; if hash ("abc","def","efg","","q","r") = hash ("abc","def","efg","","q","r") then stdout.WriteLine "YES" else reportFailure "basic test Q162" +let _ = printString "hash respects equality (9): "; if hash ("abc","def","efg","","q","r","s") = hash ("abc","def","efg","","q","r","s") then stdout.WriteLine "YES" else reportFailure "basic test Q163" +let _ = printString "hash respects equality (int array,10): "; if hash [| 1 |] = hash [| 1 |] then stdout.WriteLine "YES" else reportFailure "basic test Q164" +let _ = printString "hash respects equality (string array,11): "; if hash [| "a" |] = hash [| "a" |] then stdout.WriteLine "YES" else reportFailure "basic test Q165" +let _ = printString "hash respects equality (string array,12): "; if hash [| "a";"b" |] = hash [| "a";"b" |] then stdout.WriteLine "YES" else reportFailure "basic test Q166" +let _ = printString "hash respects equality (byte array,12): "; if hash "abc"B = hash "abc"B then stdout.WriteLine "YES" else reportFailure "basic test Q167" +let _ = printString "hash respects equality (byte array,12): "; if hash ""B = hash ""B then stdout.WriteLine "YES" else reportFailure "basic test Q169" +let _ = printString "hash respects equality (byte array,12): "; if hash [| |] = hash [| |] then stdout.WriteLine "YES" else reportFailure "basic test Q170" + + +let _ = printString "hash is interesting (1): "; if hash "abc" = hash "def" then reportFailure "basic test Q171" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (2): "; if hash 0 = hash 1 then reportFailure "basic test Q172" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (3): "; if hash [0] = hash [1] then reportFailure "basic test Q173" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (4): "; if hash (0,3) = hash (1,3) then reportFailure "basic test Q174" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (5): "; if hash {contents=3} = hash {contents=4} then reportFailure "basic test Q175" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (6): "; if hash [0;1;2] = hash [0;1;3] then reportFailure "basic test Q176" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (7): "; if hash [0;1;2;3;4;5] = hash [0;1;2;3;4;6] then reportFailure "basic test Q177" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (7): "; if hash [0;1;2;3;4] = hash [0;1;2;3;6] then reportFailure "basic test Q178" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (7): "; if hash [0;1;2;3;4;5;6;7] = hash [0;1;2;3;4;5;6;8] then reportFailure "basic test Q179" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (8): "; if hash [0;1;2;3;4;5;6;7;8] = hash [0;1;2;3;4;5;6;7;9] then reportFailure "basic test Q180" else stdout.WriteLine "YES" + +let _ = printString "hash is interesting (9): "; if hash [[0];[1];[2]] = hash [[0];[1];[3]] then reportFailure "basic test Q181" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (10): "; if hash [[0];[1];[2];[3];[4];[5]] = hash [[0];[1];[2];[3];[4];[6]] then reportFailure "basic test Q182" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (11): "; if hash [[0];[1];[2];[3];[4];[5];[6]] = hash [[0];[1];[2];[3];[4];[5];[7]] then reportFailure "basic test Q183" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (bytearray 1): "; if hash "abc"B = hash "abd"B then reportFailure "basic test Q184" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (string array 1): "; if hash [| "abc"; "e" |] = hash [| "abc"; "d" |] then reportFailure "basic test Q185" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (intarray 1): "; if hash [| 3; 4 |] = hash [| 3; 5 |] then reportFailure "basic test Q186" else stdout.WriteLine "YES" + +(* F# compiler does many special tricks to get fast type-specific structural hashing. *) +(* A compiler could only work out that the following hash is type-specific if it inlines *) +(* the whole function, which is very unlikely. *) +let genericHash x = + stdout.WriteLine "genericHash - hopefully not inlined\n"; + let mutable r = 0 in + for i = 1 to 100 do r <- r + 1; done; + for i = 1 to 100 do r <- r + 1; done; + for i = 1 to 100 do r <- r + 1; done; + for i = 1 to 100 do r <- r + 1; done; + (r - 400) + hash x + +#if MONO // See https://github.com/fsharp/fsharp/issues/188 +#else + +type T = T of int * int + + +let hashes = + [hash (T(1, 1)) ; + hash (T(4, -1)) ; + hash (T(2, 0)) ; + hash (T(0, 1)) ; + hash (T(-2, 2)) ] + +let _ = check "df390enj" (hashes |> Set.ofList |> Set.toList |> List.length) hashes.Length + +let _ = printString "type specific hash matches generic hash (1): "; if hash [] = genericHash [] then stdout.WriteLine "YES" else reportFailure "basic test Q187" +let _ = printString "type specific hash matches generic hash (2): "; if hash [1] = genericHash [1] then stdout.WriteLine "YES" else reportFailure "basic test Q188" +let _ = printString "type specific hash matches generic hash (1a): "; if hash A = genericHash A then stdout.WriteLine "YES" else reportFailure "basic test Q189" +let _ = printString "type specific hash matches generic hash (3): "; if hash ["abc"] = genericHash ["abc"] then stdout.WriteLine "YES" else reportFailure "basic test Q190" +let _ = printString "type specific hash matches generic hash (4): "; if hash ("abc","def") = genericHash ("abc","def") then stdout.WriteLine "YES" else reportFailure "basic test Q191" +let _ = printString "type specific hash matches generic hash (4a): "; if hash (A,"def") = genericHash (A,"def") then stdout.WriteLine "YES" else reportFailure "basic test Q192" +let _ = printString "type specific hash matches generic hash (4b): "; if hash ([],"def") = genericHash ([],"def") then stdout.WriteLine "YES" else reportFailure "basic test Q193" +let _ = printString "type specific hash matches generic hash (4c): "; if hash ([],[]) = genericHash ([],[]) then stdout.WriteLine "YES" else reportFailure "basic test Q194" +let _ = printString "type specific hash matches generic hash (4d): "; if hash (A,B) = genericHash (A,B) then stdout.WriteLine "YES" else reportFailure "basic test Q195" +let _ = printString "type specific hash matches generic hash (5): "; if hash ("abc","def","efg") = genericHash ("abc","def","efg") then stdout.WriteLine "YES" else reportFailure "basic test Q196" +let _ = printString "type specific hash matches generic hash (6): "; if hash ("abc","def","efg","") = genericHash ("abc","def","efg","") then stdout.WriteLine "YES" else reportFailure "basic test Q197" +let _ = printString "type specific hash matches generic hash (7): "; if hash ("abc","def","efg","","q") = genericHash ("abc","def","efg","","q") then stdout.WriteLine "YES" else reportFailure "basic test Q198" +let _ = printString "type specific hash matches generic hash (8): "; if hash ("abc","def","efg","","q","r") = genericHash ("abc","def","efg","","q","r") then stdout.WriteLine "YES" else reportFailure "basic test Q199" +let _ = printString "type specific hash matches generic hash (9): "; if hash ("abc","def","efg","","q","r","s") = genericHash ("abc","def","efg","","q","r","s") then stdout.WriteLine "YES" else reportFailure "basic test Q200" +let _ = printString "type specific hash matches generic hash (int array,10): "; if hash [| 1 |] = genericHash [| 1 |] then stdout.WriteLine "YES" else reportFailure "basic test Q201" +let _ = printString "type specific hash matches generic hash (string array,11): "; if hash [| "a" |] = genericHash [| "a" |] then stdout.WriteLine "YES" else reportFailure "basic test Q202" +let _ = printString "type specific hash matches generic hash (string array,12): "; if hash [| "a";"b" |] = genericHash [| "a";"b" |] then stdout.WriteLine "YES" else reportFailure "basic test Q203" +let _ = printString "type specific hash matches generic hash (byte array,12): "; if hash "abc"B = genericHash "abc"B then stdout.WriteLine "YES" else reportFailure "basic test Q204" +let _ = printString "type specific hash matches generic hash (byte array,12): "; if hash ""B = genericHash ""B then stdout.WriteLine "YES" else reportFailure "basic test Q205" +let _ = printString "type specific hash matches generic hash (byte array,12): "; if hash [| |] = genericHash [| |] then stdout.WriteLine "YES" else reportFailure "basic test Q206" +#endif + + +(*--------------------------------------------------------------------------- +!* check the same for GetHashCode + *--------------------------------------------------------------------------- *) + + +let _ = printString "hash 1 = "; printInt (getObjectHashCode 1); printNewLine() +let _ = printString "hash [] = "; printInt (getObjectHashCode []); printNewLine() +let _ = printString "hash [1] = "; printInt (getObjectHashCode [1]); printNewLine() +let _ = printString "hash [2] = "; printInt (getObjectHashCode [2]); printNewLine() +let r3339 = ref 1 +let _ = printString "hash 2 = "; printInt (getObjectHashCode 2); printNewLine() +let _ = printString "hash 6 = "; printInt (getObjectHashCode 6); printNewLine() +let _ = printString "hash \"abc\" = "; printInt (getObjectHashCode "abc"); printNewLine() +let _ = printString "hash \"abd\" = "; printInt (getObjectHashCode "abd"); printNewLine() +let _ = printString "hash \"\" = "; printInt (getObjectHashCode ""); printNewLine() + + +let _ = printString "hash respects equality (1): "; if getObjectHashCode [] = getObjectHashCode [] then stdout.WriteLine "YES" else reportFailure "basic test Q207" +let _ = printString "hash respects equality (2): "; if getObjectHashCode [1] = getObjectHashCode [1] then stdout.WriteLine "YES" else reportFailure "basic test Q208" +let _ = printString "hash respects equality (1a): "; if getObjectHashCode A = getObjectHashCode A then stdout.WriteLine "YES" else reportFailure "basic test Q209" +let _ = printString "hash respects equality (3): "; if getObjectHashCode ["abc"] = getObjectHashCode ["abc"] then stdout.WriteLine "YES" else reportFailure "basic test Q210" +let _ = printString "hash respects equality (4): "; if getObjectHashCode ("abc","def") = getObjectHashCode ("abc","def") then stdout.WriteLine "YES" else reportFailure "basic test Q211" +let _ = printString "hash respects equality (4a): "; if getObjectHashCode (A,"def") = getObjectHashCode (A,"def") then stdout.WriteLine "YES" else reportFailure "basic test Q212" +let _ = printString "hash respects equality (4b): "; if getObjectHashCode ([],"def") = getObjectHashCode ([],"def") then stdout.WriteLine "YES" else reportFailure "basic test Q213" +let _ = printString "hash respects equality (4c): "; if getObjectHashCode ([],[]) = getObjectHashCode ([],[]) then stdout.WriteLine "YES" else reportFailure "basic test Q214" +let _ = printString "hash respects equality (4d): "; if getObjectHashCode (A,B) = getObjectHashCode (A,B) then stdout.WriteLine "YES" else reportFailure "basic test Q215" +let _ = printString "hash respects equality (5): "; if getObjectHashCode ("abc","def","efg") = getObjectHashCode ("abc","def","efg") then stdout.WriteLine "YES" else reportFailure "basic test Q216" +let _ = printString "hash respects equality (6): "; if getObjectHashCode ("abc","def","efg","") = getObjectHashCode ("abc","def","efg","") then stdout.WriteLine "YES" else reportFailure "basic test Q217" +let _ = printString "hash respects equality (7): "; if getObjectHashCode ("abc","def","efg","","q") = getObjectHashCode ("abc","def","efg","","q") then stdout.WriteLine "YES" else reportFailure "basic test Q218" +let _ = printString "hash respects equality (8): "; if getObjectHashCode ("abc","def","efg","","q","r") = getObjectHashCode ("abc","def","efg","","q","r") then stdout.WriteLine "YES" else reportFailure "basic test Q219" +let _ = printString "hash respects equality (9): "; if getObjectHashCode ("abc","def","efg","","q","r","s") = getObjectHashCode ("abc","def","efg","","q","r","s") then stdout.WriteLine "YES" else reportFailure "basic test Q220" + +(* NOTE: GetHashCode guarantees do not apply to mutable data structures + +let _ = printString "hash respects equality (int array,10): "; if getObjectHashCode [| 1 |] = getObjectHashCode [| 1 |] then stdout.WriteLine "YES" else reportFailure "basic test Q221" +let _ = printString "hash respects equality (string array,11): "; if getObjectHashCode [| "a" |] = getObjectHashCode [| "a" |] then stdout.WriteLine "YES" else reportFailure "basic test Q222" +let _ = printString "hash respects equality (string array,12): "; if getObjectHashCode [| "a";"b" |] = getObjectHashCode [| "a";"b" |] then stdout.WriteLine "YES" else reportFailure "basic test Q223" +let _ = printString "hash respects equality (byte array,12): "; if getObjectHashCode "abc"B = getObjectHashCode "abc"B then stdout.WriteLine "YES" else reportFailure "basic test Q224" +let _ = printString "hash respects equality (byte array,12): "; if getObjectHashCode ""B = getObjectHashCode ""B then stdout.WriteLine "YES" else reportFailure "basic test Q225" +*) + + +let _ = printString "hash is interesting (1): "; if getObjectHashCode "abc" = getObjectHashCode "def" then reportFailure "basic test Q226" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (2): "; if getObjectHashCode 0 = getObjectHashCode 1 then reportFailure "basic test Q227" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (3): "; if getObjectHashCode [0] = getObjectHashCode [1] then reportFailure "basic test Q228" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (4): "; if getObjectHashCode (0,3) = getObjectHashCode (1,3) then reportFailure "basic test Q229" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (6): "; if getObjectHashCode [0;1;2] = getObjectHashCode [0;1;3] then reportFailure "basic test Q230" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (7): "; if getObjectHashCode [0;1;2;3;4;5] = getObjectHashCode [0;1;2;3;4;6] then reportFailure "basic test Q231" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (7): "; if getObjectHashCode [0;1;2;3;4] = getObjectHashCode [0;1;2;3;6] then reportFailure "basic test Q232" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (7): "; if getObjectHashCode [0;1;2;3;4;5;6;7] = getObjectHashCode [0;1;2;3;4;5;6;8] then reportFailure "basic test Q233" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (8): "; if getObjectHashCode [0;1;2;3;4;5;6;7;8] = getObjectHashCode [0;1;2;3;4;5;6;7;9] then reportFailure "basic test Q234" else stdout.WriteLine "YES" + +let _ = printString "hash is interesting (9): "; if getObjectHashCode [[0];[1];[2]] = getObjectHashCode [[0];[1];[3]] then reportFailure "basic test Q235" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (10): "; if getObjectHashCode [[0];[1];[2];[3];[4];[5]] = getObjectHashCode [[0];[1];[2];[3];[4];[6]] then reportFailure "basic test Q236" else stdout.WriteLine "YES" +let _ = printString "hash is interesting (11): "; if getObjectHashCode [[0];[1];[2];[3];[4];[5];[6]] = getObjectHashCode [[0];[1];[2];[3];[4];[5];[7]] then reportFailure "basic test Q237" else stdout.WriteLine "YES" + +let _ = printString "type specific hash matches generic hash (1): "; if getObjectHashCode [] = genericHash [] then stdout.WriteLine "YES" else reportFailure "basic test Q238" +let _ = printString "type specific hash matches generic hash (2): "; if getObjectHashCode [1] = genericHash [1] then stdout.WriteLine "YES" else reportFailure "basic test Q239" +let _ = printString "type specific hash matches generic hash (1a): "; if getObjectHashCode A = genericHash A then stdout.WriteLine "YES" else reportFailure "basic test Q240" +let _ = printString "type specific hash matches generic hash (3): "; if getObjectHashCode ["abc"] = genericHash ["abc"] then stdout.WriteLine "YES" else reportFailure "basic test Q241" +let _ = printString "type specific hash matches generic hash (4): "; if getObjectHashCode ("abc","def") = genericHash ("abc","def") then stdout.WriteLine "YES" else reportFailure "basic test Q242" +let _ = printString "type specific hash matches generic hash (4a): "; if getObjectHashCode (A,"def") = genericHash (A,"def") then stdout.WriteLine "YES" else reportFailure "basic test Q243" +let _ = printString "type specific hash matches generic hash (4b): "; if getObjectHashCode ([],"def") = genericHash ([],"def") then stdout.WriteLine "YES" else reportFailure "basic test Q244" +let _ = printString "type specific hash matches generic hash (4c): "; if getObjectHashCode ([],[]) = genericHash ([],[]) then stdout.WriteLine "YES" else reportFailure "basic test Q245" +let _ = printString "type specific hash matches generic hash (4d): "; if getObjectHashCode (A,B) = genericHash (A,B) then stdout.WriteLine "YES" else reportFailure "basic test Q246" +let _ = printString "type specific hash matches generic hash (5): "; if getObjectHashCode ("abc","def","efg") = genericHash ("abc","def","efg") then stdout.WriteLine "YES" else reportFailure "basic test Q247" +let _ = printString "type specific hash matches generic hash (6): "; if getObjectHashCode ("abc","def","efg","") = genericHash ("abc","def","efg","") then stdout.WriteLine "YES" else reportFailure "basic test Q248" +let _ = printString "type specific hash matches generic hash (7): "; if getObjectHashCode ("abc","def","efg","","q") = genericHash ("abc","def","efg","","q") then stdout.WriteLine "YES" else reportFailure "basic test Q249" +let _ = printString "type specific hash matches generic hash (8): "; if getObjectHashCode ("abc","def","efg","","q","r") = genericHash ("abc","def","efg","","q","r") then stdout.WriteLine "YES" else reportFailure "basic test Q250" +let _ = printString "type specific hash matches generic hash (9): "; if getObjectHashCode ("abc","def","efg","","q","r","s") = genericHash ("abc","def","efg","","q","r","s") then stdout.WriteLine "YES" else reportFailure "basic test Q251" + + +(*--------------------------------------------------------------------------- +!* check we can resolve overlapping constructor names using type names + *--------------------------------------------------------------------------- *) + +module OverlappingCOnstructorNames = + + type XY = X | Y + type YZ = Y | Z + + let x0 = X + let x1 = XY.X + let y0 = Y + let y1 = XY.Y + let y2 = YZ.Y + let z0 = Z + let z2 = YZ.Z + + + let f xy = + match xy with + | XY.X -> "X" + | XY.Y -> "Y" + + let g yz = + match yz with + | YZ.Y -> "X" + | YZ.Z -> "Y" + + +(*--------------------------------------------------------------------------- +!* Equality tests over structured values for data likely to contain + * values represented by "null" + *--------------------------------------------------------------------------- *) + +let _ = printString "tuple inequality null test (1): "; if (1,2) = (1,3) then reportFailure "basic test Q252" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (2): "; if ([],2) = ([],1) then reportFailure "basic test Q253" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (3): "; if (1,[]) = (2,[]) then reportFailure "basic test Q254" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (4): "; if (1,2,3) = (1,2,4) then reportFailure "basic test Q255" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (5): "; if ([],2,3) = ([],2,4) then reportFailure "basic test Q256" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (6): "; if (1,[],2) = (1,[],3) then reportFailure "basic test Q257" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (7): "; if (1,2,[]) = (1,3,[]) then reportFailure "basic test Q258" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (8): "; if (1,2,3,4) = (1,2,3,5) then reportFailure "basic test Q259" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (9): "; if ([],2,3,4) = ([],2,4,4) then reportFailure "basic test Q260" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (10): "; if (1,[],3,4) = (1,[],3,5) then reportFailure "basic test Q261" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (11): "; if (1,2,[],4) = (1,2,[],5) then reportFailure "basic test Q262" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (12): "; if (1,2,3,[]) = (1,2,4,[]) then reportFailure "basic test Q263" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (13): "; if (1,2,3,4,5) = (1,2,3,4,6) then reportFailure "basic test Q264" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (14): "; if ([],2,3,4,5) = ([],2,3,5,5) then reportFailure "basic test Q265" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (15): "; if (1,[],3,4,5) = (1,[],3,6,5) then reportFailure "basic test Q266" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (16): "; if (1,2,[],4,5) = (1,2,[],3,5) then reportFailure "basic test Q267" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (17): "; if (1,2,3,[],5) = (1,2,3,[],6) then reportFailure "basic test Q268" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (18): "; if (1,2,3,4,[]) = (1,7,3,4,[]) then reportFailure "basic test Q269" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (19): "; if (1,2,3,4,5,6) = (1,2,3,4,5,7) then reportFailure "basic test Q270" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (20): "; if ([],2,3,4,5,6) = ([],2,3,4,5,7) then reportFailure "basic test Q271" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (21): "; if (1,[],3,4,5,6) = (1,[],3,4,5,7) then reportFailure "basic test Q272" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (22): "; if (1,2,[],4,5,6) = (1,2,[],4,5,7) then reportFailure "basic test Q273" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (23): "; if (1,2,3,[],5,6) = (1,2,3,[],5,7) then reportFailure "basic test Q274" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (24): "; if (1,2,3,4,[],6) = (1,2,3,4,[],7) then reportFailure "basic test Q275" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (25): "; if (1,2,3,4,5,[]) = (1,2,3,4,6,[]) then reportFailure "basic test Q276" else stdout.WriteLine "YES" + +let _ = printString "tuple equality null test (1): "; if (1,2) = (1,2) then stdout.WriteLine "YES" else reportFailure "basic test Q277" +let _ = printString "tuple equality null test (2): "; if ([],2) = ([],2) then stdout.WriteLine "YES" else reportFailure "basic test Q278" +let _ = printString "tuple equality null test (3): "; if (1,[]) = (1,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q279" +let _ = printString "tuple equality null test (4): "; if (1,2,3) = (1,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q280" +let _ = printString "tuple equality null test (5): "; if ([],2,3) = ([],2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q281" +let _ = printString "tuple equality null test (6): "; if (1,[],2) = (1,[],2) then stdout.WriteLine "YES" else reportFailure "basic test Q282" +let _ = printString "tuple equality null test (7): "; if (1,2,[]) = (1,2,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q283" +let _ = printString "tuple equality null test (8): "; if (1,2,3,4) = (1,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q284" +let _ = printString "tuple equality null test (9): "; if ([],2,3,4) = ([],2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q285" +let _ = printString "tuple equality null test (10): "; if (1,[],3,4) = (1,[],3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q286" +let _ = printString "tuple equality null test (11): "; if (1,2,[],4) = (1,2,[],4) then stdout.WriteLine "YES" else reportFailure "basic test Q287" +let _ = printString "tuple equality null test (12): "; if (1,2,3,[]) = (1,2,3,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q288" +let _ = printString "tuple equality null test (13): "; if (1,2,3,4,5) = (1,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q289" +let _ = printString "tuple equality null test (14): "; if ([],2,3,4,5) = ([],2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q290" +let _ = printString "tuple equality null test (15): "; if (1,[],3,4,5) = (1,[],3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q291" +let _ = printString "tuple equality null test (16): "; if (1,2,[],4,5) = (1,2,[],4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q292" +let _ = printString "tuple equality null test (17): "; if (1,2,3,[],5) = (1,2,3,[],5) then stdout.WriteLine "YES" else reportFailure "basic test Q293" +let _ = printString "tuple equality null test (18): "; if (1,2,3,4,[]) = (1,2,3,4,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q294" +let _ = printString "tuple equality null test (19): "; if (1,2,3,4,5,6) = (1,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q295" +let _ = printString "tuple equality null test (20): "; if ([],2,3,4,5,6) = ([],2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q296" +let _ = printString "tuple equality null test (21): "; if (1,[],3,4,5,6) = (1,[],3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q297" +let _ = printString "tuple equality null test (22): "; if (1,2,[],4,5,6) = (1,2,[],4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q298" +let _ = printString "tuple equality null test (23): "; if (1,2,3,[],5,6) = (1,2,3,[],5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q299" +let _ = printString "tuple equality null test (24): "; if (1,2,3,4,[],6) = (1,2,3,4,[],6) then stdout.WriteLine "YES" else reportFailure "basic test Q300" +let _ = printString "tuple equality null test (25): "; if (1,2,3,4,5,[]) = (1,2,3,4,5,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q301" + +let _ = printString "tuple inequality null test (a1): "; if (1,2) = (1,3) then reportFailure "basic test Q302" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a2): "; if (A,2) = (A,1) then reportFailure "basic test Q303" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a3): "; if (1,A) = (2,A) then reportFailure "basic test Q304" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a4): "; if (1,2,3) = (1,2,4) then reportFailure "basic test Q305" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a5): "; if (A,2,3) = (A,2,4) then reportFailure "basic test Q306" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a6): "; if (1,A,2) = (1,A,3) then reportFailure "basic test Q307" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a7): "; if (1,2,A) = (1,3,A) then reportFailure "basic test Q308" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a8): "; if (1,2,3,4) = (1,2,3,5) then reportFailure "basic test Q309" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a9): "; if (A,2,3,4) = (A,2,4,4) then reportFailure "basic test Q310" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a10): "; if (1,A,3,4) = (1,A,3,5) then reportFailure "basic test Q311" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a11): "; if (1,2,A,4) = (1,2,A,5) then reportFailure "basic test Q312" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a12): "; if (1,2,3,A) = (1,2,4,A) then reportFailure "basic test Q313" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a13): "; if (1,2,3,4,5) = (1,2,3,4,6) then reportFailure "basic test Q314" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a14): "; if (A,2,3,4,5) = (A,2,3,5,5) then reportFailure "basic test Q315" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a15): "; if (1,A,3,4,5) = (1,A,3,6,5) then reportFailure "basic test Q316" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a16): "; if (1,2,A,4,5) = (1,2,A,3,5) then reportFailure "basic test Q317" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a17): "; if (1,2,3,A,5) = (1,2,3,A,6) then reportFailure "basic test Q318" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a18): "; if (1,2,3,4,A) = (1,7,3,4,A) then reportFailure "basic test Q319" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a19): "; if (1,2,3,4,5,6) = (1,2,3,4,5,7) then reportFailure "basic test Q320" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a20): "; if (A,2,3,4,5,6) = (A,2,3,4,5,7) then reportFailure "basic test Q321" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a21): "; if (1,A,3,4,5,6) = (1,A,3,4,5,7) then reportFailure "basic test Q322" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a22): "; if (1,2,A,4,5,6) = (1,2,A,4,5,7) then reportFailure "basic test Q323" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a23): "; if (1,2,3,A,5,6) = (1,2,3,A,5,7) then reportFailure "basic test Q324" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a24): "; if (1,2,3,4,A,6) = (1,2,3,4,A,7) then reportFailure "basic test Q325" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (a25): "; if (1,2,3,4,5,A) = (1,2,3,4,6,A) then reportFailure "basic test Q326" else stdout.WriteLine "YES" + +let _ = printString "tuple equality null test (a1): "; if (1,2) = (1,2) then stdout.WriteLine "YES" else reportFailure "basic test Q327" +let _ = printString "tuple equality null test (a2): "; if (A,2) = (A,2) then stdout.WriteLine "YES" else reportFailure "basic test Q328" +let _ = printString "tuple equality null test (a3): "; if (1,A) = (1,A) then stdout.WriteLine "YES" else reportFailure "basic test Q329" +let _ = printString "tuple equality null test (a4): "; if (1,2,3) = (1,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q330" +let _ = printString "tuple equality null test (a5): "; if (A,2,3) = (A,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q331" +let _ = printString "tuple equality null test (a6): "; if (1,A,2) = (1,A,2) then stdout.WriteLine "YES" else reportFailure "basic test Q332" +let _ = printString "tuple equality null test (a7): "; if (1,2,A) = (1,2,A) then stdout.WriteLine "YES" else reportFailure "basic test Q333" +let _ = printString "tuple equality null test (a8): "; if (1,2,3,4) = (1,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q334" +let _ = printString "tuple equality null test (a9): "; if (A,2,3,4) = (A,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q335" +let _ = printString "tuple equality null test (a10): "; if (1,A,3,4) = (1,A,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q336" +let _ = printString "tuple equality null test (a11): "; if (1,2,A,4) = (1,2,A,4) then stdout.WriteLine "YES" else reportFailure "basic test Q337" +let _ = printString "tuple equality null test (a12): "; if (1,2,3,A) = (1,2,3,A) then stdout.WriteLine "YES" else reportFailure "basic test Q338" +let _ = printString "tuple equality null test (a13): "; if (1,2,3,4,5) = (1,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q339" +let _ = printString "tuple equality null test (a14): "; if (A,2,3,4,5) = (A,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q340" +let _ = printString "tuple equality null test (a15): "; if (1,A,3,4,5) = (1,A,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q341" +let _ = printString "tuple equality null test (a16): "; if (1,2,A,4,5) = (1,2,A,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q342" +let _ = printString "tuple equality null test (a17): "; if (1,2,3,A,5) = (1,2,3,A,5) then stdout.WriteLine "YES" else reportFailure "basic test Q343" +let _ = printString "tuple equality null test (a18): "; if (1,2,3,4,A) = (1,2,3,4,A) then stdout.WriteLine "YES" else reportFailure "basic test Q344" +let _ = printString "tuple equality null test (a19): "; if (1,2,3,4,5,6) = (1,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q345" +let _ = printString "tuple equality null test (a20): "; if (A,2,3,4,5,6) = (A,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q346" +let _ = printString "tuple equality null test (a21): "; if (1,A,3,4,5,6) = (1,A,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q347" +let _ = printString "tuple equality null test (a22): "; if (1,2,A,4,5,6) = (1,2,A,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q348" +let _ = printString "tuple equality null test (a23): "; if (1,2,3,A,5,6) = (1,2,3,A,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q349" +let _ = printString "tuple equality null test (a24): "; if (1,2,3,4,A,6) = (1,2,3,4,A,6) then stdout.WriteLine "YES" else reportFailure "basic test Q350" +let _ = printString "tuple equality null test (a25): "; if (1,2,3,4,5,A) = (1,2,3,4,5,A) then stdout.WriteLine "YES" else reportFailure "basic test Q351" + +let _ = printString "tuple inequality null test (b1): "; if (1,2) = (1,3) then reportFailure "basic test Q351" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b2): "; if (B,2) = (B,1) then reportFailure "basic test Q352" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b3): "; if (1,B) = (2,B) then reportFailure "basic test Q353" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b4): "; if (1,2,3) = (1,2,4) then reportFailure "basic test Q354" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b5): "; if (B,2,3) = (B,2,4) then reportFailure "basic test Q355" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b6): "; if (1,B,2) = (1,B,3) then reportFailure "basic test Q356" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b7): "; if (1,2,B) = (1,3,B) then reportFailure "basic test Q357" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b8): "; if (1,2,3,4) = (1,2,3,5) then reportFailure "basic test Q358" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b9): "; if (B,2,3,4) = (B,2,4,4) then reportFailure "basic test Q359" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b10): "; if (1,B,3,4) = (1,B,3,5) then reportFailure "basic test Q360" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b11): "; if (1,2,B,4) = (1,2,B,5) then reportFailure "basic test Q361" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b12): "; if (1,2,3,B) = (1,2,4,B) then reportFailure "basic test Q362" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b13): "; if (1,2,3,4,5) = (1,2,3,4,6) then reportFailure "basic test Q363" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b14): "; if (B,2,3,4,5) = (B,2,3,5,5) then reportFailure "basic test Q364" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b15): "; if (1,B,3,4,5) = (1,B,3,6,5) then reportFailure "basic test Q365" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b16): "; if (1,2,B,4,5) = (1,2,B,3,5) then reportFailure "basic test Q366" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b17): "; if (1,2,3,B,5) = (1,2,3,B,6) then reportFailure "basic test Q367" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b18): "; if (1,2,3,4,B) = (1,7,3,4,B) then reportFailure "basic test Q368" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b19): "; if (1,2,3,4,5,6) = (1,2,3,4,5,7) then reportFailure "basic test Q369" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b20): "; if (B,2,3,4,5,6) = (B,2,3,4,5,7) then reportFailure "basic test Q370" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b21): "; if (1,B,3,4,5,6) = (1,B,3,4,5,7) then reportFailure "basic test Q371" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b22): "; if (1,2,B,4,5,6) = (1,2,B,4,5,7) then reportFailure "basic test Q372" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b23): "; if (1,2,3,B,5,6) = (1,2,3,B,5,7) then reportFailure "basic test Q373" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b24): "; if (1,2,3,4,B,6) = (1,2,3,4,B,7) then reportFailure "basic test Q374" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b25): "; if (1,2,3,4,5,B) = (1,2,3,4,6,B) then reportFailure "basic test Q375" else stdout.WriteLine "YES" + +let _ = printString "tuple equality null test (b1): "; if (1,2) = (1,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b2): "; if (B,2) = (B,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b3): "; if (1,B) = (1,B) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b4): "; if (1,2,3) = (1,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b5): "; if (B,2,3) = (B,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b6): "; if (1,B,2) = (1,B,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b7): "; if (1,2,B) = (1,2,B) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b8): "; if (1,2,3,4) = (1,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b9): "; if (B,2,3,4) = (B,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b10): "; if (1,B,3,4) = (1,B,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b11): "; if (1,2,B,4) = (1,2,B,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b12): "; if (1,2,3,B) = (1,2,3,B) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b13): "; if (1,2,3,4,5) = (1,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b14): "; if (B,2,3,4,5) = (B,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b15): "; if (1,B,3,4,5) = (1,B,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b16): "; if (1,2,B,4,5) = (1,2,B,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b17): "; if (1,2,3,B,5) = (1,2,3,B,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b18): "; if (1,2,3,4,B) = (1,2,3,4,B) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b19): "; if (1,2,3,4,5,6) = (1,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b20): "; if (B,2,3,4,5,6) = (B,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b21): "; if (1,B,3,4,5,6) = (1,B,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b22): "; if (1,2,B,4,5,6) = (1,2,B,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b23): "; if (1,2,3,B,5,6) = (1,2,3,B,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b24): "; if (1,2,3,4,B,6) = (1,2,3,4,B,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b25): "; if (1,2,3,4,5,B) = (1,2,3,4,5,B) then stdout.WriteLine "YES" else reportFailure "basic test Q" + +let _ = printString "tuple inequality null test (b1): "; if (1,2) = (1,3) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b2): "; if (C,2) = (C,1) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b3): "; if (1,C) = (2,C) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b4): "; if (1,2,3) = (1,2,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b5): "; if (C,2,3) = (C,2,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b6): "; if (1,C,2) = (1,C,3) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b7): "; if (1,2,C) = (1,3,C) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b8): "; if (1,2,3,4) = (1,2,3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b9): "; if (C,2,3,4) = (C,2,4,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b10): "; if (1,C,3,4) = (1,C,3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b11): "; if (1,2,C,4) = (1,2,C,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b12): "; if (1,2,3,C) = (1,2,4,C) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b13): "; if (1,2,3,4,5) = (1,2,3,4,6) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b14): "; if (C,2,3,4,5) = (C,2,3,5,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b15): "; if (1,C,3,4,5) = (1,C,3,6,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b16): "; if (1,2,C,4,5) = (1,2,C,3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b17): "; if (1,2,3,C,5) = (1,2,3,C,6) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b18): "; if (1,2,3,4,C) = (1,7,3,4,C) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b19): "; if (1,2,3,4,5,6) = (1,2,3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b20): "; if (C,2,3,4,5,6) = (C,2,3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b21): "; if (1,C,3,4,5,6) = (1,C,3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b22): "; if (1,2,C,4,5,6) = (1,2,C,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b23): "; if (1,2,3,C,5,6) = (1,2,3,C,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b24): "; if (1,2,3,4,C,6) = (1,2,3,4,C,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple inequality null test (b25): "; if (1,2,3,4,5,C) = (1,2,3,4,6,C) then reportFailure "basic test Q" else stdout.WriteLine "YES" + +let _ = printString "tuple equality null test (b1): "; if (1,2) = (1,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b2): "; if (C,2) = (C,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b3): "; if (1,C) = (1,C) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b4): "; if (1,2,3) = (1,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b5): "; if (C,2,3) = (C,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b6): "; if (1,C,2) = (1,C,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b7): "; if (1,2,C) = (1,2,C) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b8): "; if (1,2,3,4) = (1,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b9): "; if (C,2,3,4) = (C,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b10): "; if (1,C,3,4) = (1,C,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b11): "; if (1,2,C,4) = (1,2,C,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b12): "; if (1,2,3,C) = (1,2,3,C) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b13): "; if (1,2,3,4,5) = (1,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b14): "; if (C,2,3,4,5) = (C,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b15): "; if (1,C,3,4,5) = (1,C,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b16): "; if (1,2,C,4,5) = (1,2,C,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b17): "; if (1,2,3,C,5) = (1,2,3,C,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b18): "; if (1,2,3,4,C) = (1,2,3,4,C) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b19): "; if (1,2,3,4,5,6) = (1,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b20): "; if (C,2,3,4,5,6) = (C,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b21): "; if (1,C,3,4,5,6) = (1,C,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b22): "; if (1,2,C,4,5,6) = (1,2,C,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b23): "; if (1,2,3,C,5,6) = (1,2,3,C,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b24): "; if (1,2,3,4,C,6) = (1,2,3,4,C,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple equality null test (b25): "; if (1,2,3,4,5,C) = (1,2,3,4,5,C) then stdout.WriteLine "YES" else reportFailure "basic test Q" + + + +let _ = printString "tuple object inequality null test (1): "; if (1,2) === (1,3) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (2): "; if ([],2) === ([],1) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (3): "; if (1,[]) === (2,[]) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (4): "; if (1,2,3) === (1,2,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (5): "; if ([],2,3) === ([],2,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (6): "; if (1,[],2) === (1,[],3) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (7): "; if (1,2,[]) === (1,3,[]) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (8): "; if (1,2,3,4) === (1,2,3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (9): "; if ([],2,3,4) === ([],2,4,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (10): "; if (1,[],3,4) === (1,[],3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (11): "; if (1,2,[],4) === (1,2,[],5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (12): "; if (1,2,3,[]) === (1,2,4,[]) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (13): "; if (1,2,3,4,5) === (1,2,3,4,6) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (14): "; if ([],2,3,4,5) === ([],2,3,5,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (15): "; if (1,[],3,4,5) === (1,[],3,6,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (16): "; if (1,2,[],4,5) === (1,2,[],3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (17): "; if (1,2,3,[],5) === (1,2,3,[],6) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (18): "; if (1,2,3,4,[]) === (1,7,3,4,[]) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (19): "; if (1,2,3,4,5,6) === (1,2,3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (20): "; if ([],2,3,4,5,6) === ([],2,3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (21): "; if (1,[],3,4,5,6) === (1,[],3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (22): "; if (1,2,[],4,5,6) === (1,2,[],4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (23): "; if (1,2,3,[],5,6) === (1,2,3,[],5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (24): "; if (1,2,3,4,[],6) === (1,2,3,4,[],7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (25): "; if (1,2,3,4,5,[]) === (1,2,3,4,6,[]) then reportFailure "basic test Q" else stdout.WriteLine "YES" + +let _ = printString "tuple object equality null test (1): "; if (1,2) === (1,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (2): "; if ([],2) === ([],2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (3): "; if (1,[]) === (1,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (4): "; if (1,2,3) === (1,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (5): "; if ([],2,3) === ([],2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (6): "; if (1,[],2) === (1,[],2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (7): "; if (1,2,[]) === (1,2,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (8): "; if (1,2,3,4) === (1,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (9): "; if ([],2,3,4) === ([],2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (10): "; if (1,[],3,4) === (1,[],3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (11): "; if (1,2,[],4) === (1,2,[],4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (12): "; if (1,2,3,[]) === (1,2,3,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (13): "; if (1,2,3,4,5) === (1,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (14): "; if ([],2,3,4,5) === ([],2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (15): "; if (1,[],3,4,5) === (1,[],3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (16): "; if (1,2,[],4,5) === (1,2,[],4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (17): "; if (1,2,3,[],5) === (1,2,3,[],5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (18): "; if (1,2,3,4,[]) === (1,2,3,4,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (19): "; if (1,2,3,4,5,6) === (1,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (20): "; if ([],2,3,4,5,6) === ([],2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (21): "; if (1,[],3,4,5,6) === (1,[],3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (22): "; if (1,2,[],4,5,6) === (1,2,[],4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (23): "; if (1,2,3,[],5,6) === (1,2,3,[],5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (24): "; if (1,2,3,4,[],6) === (1,2,3,4,[],6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (25): "; if (1,2,3,4,5,[]) === (1,2,3,4,5,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q" + +let _ = printString "tuple object inequality null test (a1): "; if (1,2) === (1,3) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a2): "; if (A,2) === (A,1) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a3): "; if (1,A) === (2,A) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a4): "; if (1,2,3) === (1,2,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a5): "; if (A,2,3) === (A,2,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a6): "; if (1,A,2) === (1,A,3) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a7): "; if (1,2,A) === (1,3,A) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a8): "; if (1,2,3,4) === (1,2,3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a9): "; if (A,2,3,4) === (A,2,4,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a10): "; if (1,A,3,4) === (1,A,3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a11): "; if (1,2,A,4) === (1,2,A,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a12): "; if (1,2,3,A) === (1,2,4,A) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a13): "; if (1,2,3,4,5) === (1,2,3,4,6) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a14): "; if (A,2,3,4,5) === (A,2,3,5,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a15): "; if (1,A,3,4,5) === (1,A,3,6,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a16): "; if (1,2,A,4,5) === (1,2,A,3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a17): "; if (1,2,3,A,5) === (1,2,3,A,6) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a18): "; if (1,2,3,4,A) === (1,7,3,4,A) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a19): "; if (1,2,3,4,5,6) === (1,2,3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a20): "; if (A,2,3,4,5,6) === (A,2,3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a21): "; if (1,A,3,4,5,6) === (1,A,3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a22): "; if (1,2,A,4,5,6) === (1,2,A,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a23): "; if (1,2,3,A,5,6) === (1,2,3,A,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a24): "; if (1,2,3,4,A,6) === (1,2,3,4,A,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (a25): "; if (1,2,3,4,5,A) === (1,2,3,4,6,A) then reportFailure "basic test Q" else stdout.WriteLine "YES" + +let _ = printString "tuple object equality null test (a1): "; if (1,2) === (1,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a2): "; if (A,2) === (A,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a3): "; if (1,A) === (1,A) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a4): "; if (1,2,3) === (1,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a5): "; if (A,2,3) === (A,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a6): "; if (1,A,2) === (1,A,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a7): "; if (1,2,A) === (1,2,A) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a8): "; if (1,2,3,4) === (1,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a9): "; if (A,2,3,4) === (A,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a10): "; if (1,A,3,4) === (1,A,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a11): "; if (1,2,A,4) === (1,2,A,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a12): "; if (1,2,3,A) === (1,2,3,A) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a13): "; if (1,2,3,4,5) === (1,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a14): "; if (A,2,3,4,5) === (A,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a15): "; if (1,A,3,4,5) === (1,A,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a16): "; if (1,2,A,4,5) === (1,2,A,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a17): "; if (1,2,3,A,5) === (1,2,3,A,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a18): "; if (1,2,3,4,A) === (1,2,3,4,A) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a19): "; if (1,2,3,4,5,6) === (1,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a20): "; if (A,2,3,4,5,6) === (A,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a21): "; if (1,A,3,4,5,6) === (1,A,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a22): "; if (1,2,A,4,5,6) === (1,2,A,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a23): "; if (1,2,3,A,5,6) === (1,2,3,A,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a24): "; if (1,2,3,4,A,6) === (1,2,3,4,A,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (a25): "; if (1,2,3,4,5,A) === (1,2,3,4,5,A) then stdout.WriteLine "YES" else reportFailure "basic test Q" + +let _ = printString "tuple object inequality null test (b1): "; if (1,2) === (1,3) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b2): "; if (B,2) === (B,1) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b3): "; if (1,B) === (2,B) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b4): "; if (1,2,3) === (1,2,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b5): "; if (B,2,3) === (B,2,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b6): "; if (1,B,2) === (1,B,3) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b7): "; if (1,2,B) === (1,3,B) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b8): "; if (1,2,3,4) === (1,2,3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b9): "; if (B,2,3,4) === (B,2,4,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b10): "; if (1,B,3,4) === (1,B,3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b11): "; if (1,2,B,4) === (1,2,B,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b12): "; if (1,2,3,B) === (1,2,4,B) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b13): "; if (1,2,3,4,5) === (1,2,3,4,6) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b14): "; if (B,2,3,4,5) === (B,2,3,5,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b15): "; if (1,B,3,4,5) === (1,B,3,6,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b16): "; if (1,2,B,4,5) === (1,2,B,3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b17): "; if (1,2,3,B,5) === (1,2,3,B,6) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b18): "; if (1,2,3,4,B) === (1,7,3,4,B) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b19): "; if (1,2,3,4,5,6) === (1,2,3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b20): "; if (B,2,3,4,5,6) === (B,2,3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b21): "; if (1,B,3,4,5,6) === (1,B,3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b22): "; if (1,2,B,4,5,6) === (1,2,B,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b23): "; if (1,2,3,B,5,6) === (1,2,3,B,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b24): "; if (1,2,3,4,B,6) === (1,2,3,4,B,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b25): "; if (1,2,3,4,5,B) === (1,2,3,4,6,B) then reportFailure "basic test Q" else stdout.WriteLine "YES" + +let _ = printString "tuple object equality null test (b1): "; if (1,2) === (1,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b2): "; if (B,2) === (B,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b3): "; if (1,B) === (1,B) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b4): "; if (1,2,3) === (1,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b5): "; if (B,2,3) === (B,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b6): "; if (1,B,2) === (1,B,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b7): "; if (1,2,B) === (1,2,B) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b8): "; if (1,2,3,4) === (1,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b9): "; if (B,2,3,4) === (B,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b10): "; if (1,B,3,4) === (1,B,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b11): "; if (1,2,B,4) === (1,2,B,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b12): "; if (1,2,3,B) === (1,2,3,B) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b13): "; if (1,2,3,4,5) === (1,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b14): "; if (B,2,3,4,5) === (B,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b15): "; if (1,B,3,4,5) === (1,B,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b16): "; if (1,2,B,4,5) === (1,2,B,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b17): "; if (1,2,3,B,5) === (1,2,3,B,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b18): "; if (1,2,3,4,B) === (1,2,3,4,B) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b19): "; if (1,2,3,4,5,6) === (1,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b20): "; if (B,2,3,4,5,6) === (B,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b21): "; if (1,B,3,4,5,6) === (1,B,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b22): "; if (1,2,B,4,5,6) === (1,2,B,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b23): "; if (1,2,3,B,5,6) === (1,2,3,B,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b24): "; if (1,2,3,4,B,6) === (1,2,3,4,B,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b25): "; if (1,2,3,4,5,B) === (1,2,3,4,5,B) then stdout.WriteLine "YES" else reportFailure "basic test Q" + +let _ = printString "tuple object inequality null test (b1): "; if (1,2) === (1,3) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b2): "; if (C,2) === (C,1) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b3): "; if (1,C) === (2,C) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b4): "; if (1,2,3) === (1,2,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b5): "; if (C,2,3) === (C,2,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b6): "; if (1,C,2) === (1,C,3) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b7): "; if (1,2,C) === (1,3,C) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b8): "; if (1,2,3,4) === (1,2,3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b9): "; if (C,2,3,4) === (C,2,4,4) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b10): "; if (1,C,3,4) === (1,C,3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b11): "; if (1,2,C,4) === (1,2,C,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b12): "; if (1,2,3,C) === (1,2,4,C) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b13): "; if (1,2,3,4,5) === (1,2,3,4,6) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b14): "; if (C,2,3,4,5) === (C,2,3,5,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b15): "; if (1,C,3,4,5) === (1,C,3,6,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b16): "; if (1,2,C,4,5) === (1,2,C,3,5) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b17): "; if (1,2,3,C,5) === (1,2,3,C,6) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b18): "; if (1,2,3,4,C) === (1,7,3,4,C) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b19): "; if (1,2,3,4,5,6) === (1,2,3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b20): "; if (C,2,3,4,5,6) === (C,2,3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b21): "; if (1,C,3,4,5,6) === (1,C,3,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b22): "; if (1,2,C,4,5,6) === (1,2,C,4,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b23): "; if (1,2,3,C,5,6) === (1,2,3,C,5,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b24): "; if (1,2,3,4,C,6) === (1,2,3,4,C,7) then reportFailure "basic test Q" else stdout.WriteLine "YES" +let _ = printString "tuple object inequality null test (b25): "; if (1,2,3,4,5,C) === (1,2,3,4,6,C) then reportFailure "basic test Q" else stdout.WriteLine "YES" + +let _ = printString "tuple object equality null test (b1): "; if (1,2) === (1,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b2): "; if (C,2) === (C,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b3): "; if (1,C) === (1,C) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b4): "; if (1,2,3) === (1,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b5): "; if (C,2,3) === (C,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b6): "; if (1,C,2) === (1,C,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b7): "; if (1,2,C) === (1,2,C) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b8): "; if (1,2,3,4) === (1,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b9): "; if (C,2,3,4) === (C,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b10): "; if (1,C,3,4) === (1,C,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b11): "; if (1,2,C,4) === (1,2,C,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b12): "; if (1,2,3,C) === (1,2,3,C) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b13): "; if (1,2,3,4,5) === (1,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b14): "; if (C,2,3,4,5) === (C,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b15): "; if (1,C,3,4,5) === (1,C,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b16): "; if (1,2,C,4,5) === (1,2,C,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b17): "; if (1,2,3,C,5) === (1,2,3,C,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b18): "; if (1,2,3,4,C) === (1,2,3,4,C) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b19): "; if (1,2,3,4,5,6) === (1,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b20): "; if (C,2,3,4,5,6) === (C,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b21): "; if (1,C,3,4,5,6) === (1,C,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b22): "; if (1,2,C,4,5,6) === (1,2,C,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b23): "; if (1,2,3,C,5,6) === (1,2,3,C,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b24): "; if (1,2,3,4,C,6) === (1,2,3,4,C,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "tuple object equality null test (b25): "; if (1,2,3,4,5,C) === (1,2,3,4,5,C) then stdout.WriteLine "YES" else reportFailure "basic test Q" + + +let _ = printString "ref equality test (b25): "; if ref 1 = ref 1 then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "ref equality test (b25): "; if ref 1 <> ref 2 then stdout.WriteLine "YES" else reportFailure "basic test Q" + +let _ = printString "compaure nativeint test (b25): "; if compare [0n] [1n] = -(compare [1n] [0n]) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "compaure nativeint test (b25): "; if compare [0un] [1un] = -(compare [1un] [0un]) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "compaure nativeint test (b25): "; if compare [0un] [0un] = 0 then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "compaure nativeint test (b25): "; if compare [0n] [0n] = 0 then stdout.WriteLine "YES" else reportFailure "basic test Q" + + +(*--------------------------------------------------------------------------- +!* Equality tests over structured values for data likely to contain + * values represented by "null" + *--------------------------------------------------------------------------- *) + +type ('a,'b) a2 = A2 of 'a * 'b +type ('a,'b,'c) a3 = A3 of 'a * 'b * 'c +type ('a,'b,'c,'d) a4 = A4 of 'a * 'b * 'c * 'd +type ('a,'b,'c,'d,'e) a5 = A5 of 'a * 'b * 'c * 'd * 'e +type ('a,'b,'c,'d,'e,'f) a6 = A6 of 'a * 'b * 'c * 'd * 'e * 'f +let _ = printString "data equality null test (1): "; if A2 (1,2) = A2 (1,2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (2): "; if A2 ([],2) = A2 ([],2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (3): "; if A2 (1,[]) = A2 (1,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (4): "; if A3(1,2,3) = A3(1,2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (5): "; if A3([],2,3) = A3([],2,3) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (6): "; if A3(1,[],2) = A3(1,[],2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (7): "; if A3(1,2,[]) = A3(1,2,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (8): "; if A4(1,2,3,4) = A4(1,2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (9): "; if A4([],2,3,4) = A4([],2,3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (10): "; if A4(1,[],3,4) = A4(1,[],3,4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (11): "; if A4(1,2,[],4) = A4(1,2,[],4) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (12): "; if A4(1,2,3,[]) = A4(1,2,3,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (13): "; if A5(1,2,3,4,5) = A5(1,2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (14): "; if A5([],2,3,4,5) = A5([],2,3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (15): "; if A5(1,[],3,4,5) = A5(1,[],3,4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (16): "; if A5(1,2,[],4,5) = A5(1,2,[],4,5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (17): "; if A5(1,2,3,[],5) = A5(1,2,3,[],5) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (18): "; if A5(1,2,3,4,[]) = A5(1,2,3,4,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (19): "; if A6(1,2,3,4,5,6) = A6(1,2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (20): "; if A6([],2,3,4,5,6) = A6([],2,3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (21): "; if A6(1,[],3,4,5,6) = A6(1,[],3,4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (22): "; if A6(1,2,[],4,5,6) = A6(1,2,[],4,5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (23): "; if A6(1,2,3,[],5,6) = A6(1,2,3,[],5,6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (24): "; if A6(1,2,3,4,[],6) = A6(1,2,3,4,[],6) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "data equality null test (25): "; if A6(1,2,3,4,5,[]) = A6(1,2,3,4,5,[]) then stdout.WriteLine "YES" else reportFailure "basic test Q" + +let _ = printString "map test (1): "; if List.map (fun x -> x+1) [] = [] then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "map test (2): "; if List.map (fun x -> x+1) [1] = [2] then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "map test (3): "; if List.map (fun x -> x+1) [2;1] = [3;2] then stdout.WriteLine "YES" else reportFailure "basic test Q" + +let _ = printString "append test (1): "; if [2] @ [] = [2] then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "append test (2): "; if [] @ [2] = [2] then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "append test (3): "; if [2] @ [1] = [2;1] then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "append test (4): "; if [3;2] @ [1] = [3;2;1] then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "append test (5): "; if [3;2] @ [1;0] = [3;2;1;0] then stdout.WriteLine "YES" else reportFailure "basic test Q" + +let _ = printString "concat test (1): "; if List.concat [[2]] = [2] then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "concat test (2): "; if List.concat [[]] = [] then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "concat test (3): "; if List.concat [[2];[1]] = [2;1] then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "combine test (1): "; if List.zip [] [] = [] then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "combine test (2): "; if List.zip [1] [2] = [(1,2)] then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "combine test (3): "; if List.zip [1.0;2.0] [2.0;3.0] = [(1.0,2.0);(2.0,3.0)] then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "split test (1): "; if List.unzip [(1.0,2.0);(2.0,3.0)] = ([1.0;2.0],[2.0;3.0]) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "split test (2): "; if List.unzip [] = ([],[]) then stdout.WriteLine "YES" else reportFailure "basic test Q" + +let _ = printfn "reduce test"; if List.reduce (fun x y -> x/y) [5*4*3*2; 4;3;2;1] = 5 then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printfn "reduceBack test"; if List.reduceBack (fun y x -> x/y) [4;3;2;1; 5*4*3*2] = 5 then stdout.WriteLine "YES" else reportFailure "basic test Q" + + +(*--------------------------------------------------------------------------- +!* List library + *--------------------------------------------------------------------------- *) + + +let pri s l = printString s; printString ": "; List.iter printInt l; printNewLine () + +let _ = pri "none" [1;2;3;4;5;6] +let _ = pri "rev" (List.rev [6;5;4;3;2;1]) +let _ = pri "@" ([1;2;3] @ [4;5;6]) +let _ = pri "map" (List.map (fun x -> x + 1) ([1;2;3])) +let _ = pri "concat" (List.concat [[1;2]; [3;4]; [5;6]]) + +let prs s l = printString s; printString ": "; List.iter printString l; printNewLine () +let _ = prs "none" ["1";"2";"3";"4";"5";"6"] +let _ = prs "rev" (List.rev ["6";"5";"4";"3";"2";"1"]) +let _ = prs "map" (List.map (fun x -> x ^ ".0") (["1";"2";"3"])) +let _ = prs "@" (["1";"2";"3"] @ ["4";"5";"6"]) +let _ = prs "concat" (List.concat [["1";"2"]; ["3";"4"]; ["5";"6"]]) + +let _ = test "List.empty" (List.empty |> List.length = 0) +let _ = test "List.empty" (List.empty = []) +let _ = test "List.head" (List.head [1..4] = 1) +let _ = test "List.head" (try List.head []; false with _ -> true) +let _ = test "List.tail" (List.tail [1..10] = [2..10]) +let _ = test "List.tail" (try List.tail []; false with _ -> true) +let _ = test "List.init" (List.init 20 (fun x -> x+1) = [1..20]) +let _ = test "List.fold2" (List.fold2 (fun i j k -> i+j+k) 100 [1;2;3] [1;2;3] = 112) +let _ = test "List.fold2" (List.fold2 (fun i j k -> i-j-k) 100 [1;2;3] [1;2;3] = 100-12) +let _ = test "List.foldBack2" (List.foldBack2 (fun i j k -> i+j+k) [1;2;3] [1;2;3] 100 = 112) +let _ = test "List.foldBack2" (List.foldBack2 (fun i j k -> k-i-j) [1;2;3] [1;2;3] 100 = 100-12) + +let _ = test "List.scan" (List.scan (+) 0 [1..5] = [0; 1; 3; 6; 10; 15]) + +let _ = test "List.scanBack" (List.scanBack (+) [1..5] 0 = [15; 14; 12; 9; 5; 0]) + +let _ = test "List.tryFindIndex" (List.tryFindIndex (fun x -> x = 4) [0..10] = Some 4) + +let _ = test "List.tryfind_index_b" (List.tryFindIndex (fun x -> x = 42) [0..10] = None) + + +let mutable c = -1 +do List.iter (fun x -> c <- (c + 1); test "List.iter" (x = c)) [0..100] +let _ = test "List.iter" (c = 100) + +let _ = test "List.map" ([1..100] |> List.map ((+) 1) = [2..101]) + +let _ = test "List.mapi" ([0..100] |> List.mapi (+) = [0..+2..200]) + +do c <- -1 +do List.iteri (fun i x -> c <- (c+1); test "List.iteri" (x = c && i = c)) [0..100] +let _ = test "List.iteri" (c = 100) + +let _ = test "List.exists" ([1..100] |> List.exists ((=) 50)) + +let _ = test "List.exists b" <| not ([1..100] |> List.exists ((=) 150)) + +let _ = test "List.forall" ([1..100] |> List.forall (fun x -> x < 150)) + +let _ = test "List.forall b" <| not ([1..100] |> List.forall (fun x -> x < 80)) + +let _ = test "List.find" ([1..100] |> List.find (fun x -> x > 50) = 51) + +let _ = test "List.find b" (try [1..100] |> List.find (fun x -> x > 180) |> ignore; false with _ -> true) + +let _ = test "List.tryPick" ([1..100] |> List.tryPick (fun x -> if x > 50 then Some (x*x) else None) = Some (51*51)) + +let _ = test "List.tryPick b" ([1..100] |> List.tryPick (fun x -> None) = None) + +let _ = test "List.tryPick c" ([] |> List.tryPick (fun _ -> Some 42) = None) + +let _ = test "List.tryFind" ([1..100] |> List.tryFind (fun x -> x > 50) = Some 51) + +let _ = test "List.tryFind b" ([1..100] |> List.tryFind (fun x -> x > 180) = None) + +do c <- -1 +do List.iter2 (fun x y -> c <- c + 1; test "List.iter2" (c = x && c = y)) [0..100] [0..100] +let _ = test "List.iter2" (c = 100) + +let _ = test "List.map2" (List.map2 (+) [0..100] [0..100] = [0..+2..200]) + +let _ = test "List.choose" (List.choose (fun x -> if x % 2 = 0 then Some (x/2) else None) [0..100] = [0..50]) + +let _ = test "List.filter" (List.filter (fun x -> x % 2 = 0) [0..100] = [0..+2..100]) + +let _ = test "List.filter b" (List.filter (fun x -> false) [0..100] = []) + +let _ = test "List.filter c" (List.filter (fun x -> true) [0..100] = [0..100]) + +let p1, p2 = List.partition (fun x -> x % 2 = 0) [0..100] +let _ = test "List.partition" (p1 = [0..+2..100] && p2 = [1..+2..100]) + +let _ = test "List.rev" (List.rev [0..100] = [100..-1 ..0]) + +let _ = test "List.rev b" (List.rev [1] = [1]) + +let _ = test "List.rev c" (List.rev [] = []) + +let _ = test "List.rev d" (List.rev [1; 2] = [2; 1]) + + + +module MinMaxAverageSum = + do test "ceijoe9cewz" (Seq.sum [] = 0) + do test "ceijoe9cewx" (Seq.sum [1;2;3] = 6) + do test "ceijoe9cewv" (Seq.sum [0.0;1.0] = 1.0) + do test "ceijoe9cewc" (Seq.average [1.0;2.0;3.0] = 2.0) + do test "ceijoe9cewb" (Seq.averageBy id [1.0;2.0;3.0] = 2.0) + do test "ceijoe9cewn" (Seq.averageBy id [1.0M;2.0M;3.0M] = 2.0M) + do test "ceijoe9cewm" (Seq.sum [System.Int32.MinValue;System.Int32.MaxValue] = -1) + do test "ceijoe9cewaa" (Seq.sum [System.Int32.MaxValue;System.Int32.MinValue] = -1) + do test "ceijoe9cewss" (Seq.sum [System.Int32.MinValue;1;-1] = System.Int32.MinValue) + //printfn "res = %g" (Seq.averageBy id []) + //printfn "res = %g" (Seq.average { 0.0 .. 100000.0 }) + + do test "ceijoe9cew1dd" (Seq.min [1;2;3] = 1) + do test "ceijoe9cew2ff" (Seq.min [3;2;1] = 1) + + do test "ceijoe9cew3gg" (Seq.max [1;2;3] = 3) + do test "ceijoe9cew4hh" (Seq.max [3;2;1] = 3) + + + do test "ceijoe9cew5jj" (Seq.min [1.0;2.0;3.0] = 1.0) + do test "ceijoe9cew6kk" (Seq.min [3.0;2.0;1.0] = 1.0) + + do test "ceijoe9cew7" (Seq.max [1.0;2.0;3.0] = 3.0) + do test "ceijoe9cew8" (Seq.max [3.0;2.0;1.0] = 3.0) + + do test "ceijoe9cew9" (Seq.min [1.0M;2.0M;3.0M] = 1.0M) + do test "ceijoe9cewq" (Seq.min [3.0M;2.0M;1.0M] = 1.0M) + + do test "ceijoe9ceww" (Seq.max [1.0M;2.0M;3.0M] = 3.0M) + do test "ceijoe9cewe" (Seq.max [3.0M;2.0M;1.0M] = 3.0M) + + do test "ceijoe9cewz" (List.sum [] = 0) + do test "ceijoe9cewx" (List.sum [1;2;3] = 6) + do test "ceijoe9cewv" (List.sum [0.0;1.0] = 1.0) + do test "ceijoe9cewc" (List.average [1.0;2.0;3.0] = 2.0) + do test "ceijoe9cewb" (List.averageBy id [1.0;2.0;3.0] = 2.0) + do test "ceijoe9cewn" (List.averageBy id [1.0M;2.0M;3.0M] = 2.0M) + do test "ceijoe9cewm" (List.sum [System.Int32.MinValue;System.Int32.MaxValue] = -1) + do test "ceijoe9cewaa" (List.sum [System.Int32.MaxValue;System.Int32.MinValue] = -1) + do test "ceijoe9cewss" (List.sum [System.Int32.MinValue;1;-1] = System.Int32.MinValue) + //printfn "res = %g" (List.averageBy id []) + //printfn "res = %g" (List.average { 0.0 .. 100000.0 }) + + do test "ceijoe9cew1dd" (List.min [1;2;3] = 1) + do test "ceijoe9cew2ff" (List.min [3;2;1] = 1) + + do test "ceijoe9cew3gg" (List.max [1;2;3] = 3) + do test "ceijoe9cew4hh" (List.max [3;2;1] = 3) + + + do test "ceijoe9cew5jj" (List.min [1.0;2.0;3.0] = 1.0) + do test "ceijoe9cew6kk" (List.min [3.0;2.0;1.0] = 1.0) + + do test "ceijoe9cew7" (List.max [1.0;2.0;3.0] = 3.0) + do test "ceijoe9cew8" (List.max [3.0;2.0;1.0] = 3.0) + + do test "ceijoe9cew9" (List.min [1.0M;2.0M;3.0M] = 1.0M) + do test "ceijoe9cewq" (List.min [3.0M;2.0M;1.0M] = 1.0M) + + do test "ceijoe9ceww" (List.max [1.0M;2.0M;3.0M] = 3.0M) + do test "ceijoe9cewe" (List.max [3.0M;2.0M;1.0M] = 3.0M) + + + +module Pow = + do test "cnod90km1" (pown 2.0 -3 = 0.125) + do test "cnod90km2" (pown 2.0 -2 = 0.25) + do test "cnod90km3" (pown 2.0 -1 = 0.5) + do test "cnod90km4" (pown 2.0 0 = 1.0) + do test "cnod90km5" (pown 2.0 1 = 2.0) + do test "cnod90km6" (pown 2.0 2 = 4.0) + do test "cnod90km7" (pown 2.0 3 = 8.0) + do test "cnod90km8" (pown 2.0 4 = 16.0) + do test "cnod90km9" (pown 2.0 5 = 32.0) + + do for exp in -5 .. 5 do + test "cnod90kma" (pown 0.5 exp = 0.5 ** float exp); + test "cnod90kmb" (pown 1.0 exp = 1.0 ** float exp); + test "cnod90kmc" (pown 2.0 exp = 2.0 ** float exp); +#if MONO +#else + test "cnod90kmd" (pown 3.0 exp = 3.0 ** float exp) +#endif + done + + do for exp in [ 5 .. -1 .. -5 ] @ [System.Int32.MinValue;System.Int32.MaxValue] do + // check powers of 0 + printfn "exp = %d" exp; + test "cnod90kme" (pown 0.0f exp = (if exp = 0 then 1.0f else if exp < 0 then infinityf else 0.0f)); + test "cnod90kmf" (pown 0.0 exp = (if exp = 0 then 1.0 else if exp < 0 then infinity else 0.0)); + if exp >= 0 then ( + test "cnod90kmg" (pown 0 exp = (if exp = 0 then 1 else 0)); + test "cnod90kmh" (pown 0u exp = (if exp = 0 then 1u else 0u)); + test "cnod90kmi" (pown 0us exp = (if exp = 0 then 1us else 0us)); + test "cnod90kmj" (pown 0s exp = (if exp = 0 then 1s else 0s)); + test "cnod90kmk" (pown 0L exp = (if exp = 0 then 1L else 0L)); + test "cnod90kml" (pown 0UL exp = (if exp = 0 then 1UL else 0UL)); + test "cnod90kmm" (pown 0n exp = (if exp = 0 then 1n else 0n)); + test "cnod90kmn" (pown 0un exp = (if exp = 0 then 1un else 0un)); + test "cnod90kmo" (pown 0y exp = (if exp = 0 then 1y else 0y)); + test "cnod90kmp" (pown 0uy exp = (if exp = 0 then 1uy else 0uy)); + test "cnod90kmq" (pown 0M exp = (if exp = 0 then 1M else 0M)); + ) else ( + test "cnod90kmgE" (try pown 0 exp; false with :? System.DivideByZeroException -> true); + test "cnod90kmhE" (try pown 0u exp; false with :? System.DivideByZeroException -> true); + test "cnod90kmiE" (try pown 0us exp; false with :? System.DivideByZeroException -> true); + test "cnod90kmjE" (try pown 0s exp; false with :? System.DivideByZeroException -> true); + test "cnod90kmE" (try pown 0L exp; false with :? System.DivideByZeroException -> true); + test "cnod90kmhE" (try pown 0UL exp; false with :? System.DivideByZeroException -> true); + test "cnod90kmtE" (try pown 0n exp; false with :? System.DivideByZeroException -> true); + test "cnod90kmhrE" (try pown 0un exp; false with :? System.DivideByZeroException -> true); + test "cnod90kmheE" (try pown 0y exp; false with :? System.DivideByZeroException -> true); + test "cnod90kmhfrE" (try pown 0uy exp; false with :? System.DivideByZeroException -> true); + test "cnod90kmhvreE" (try pown 0M exp; false with :? System.DivideByZeroException -> true); + ); + + // check powerrs of -1 + test "cnod90kmr" (pown -1.0f exp = (if exp % 2 = 0 then 1.0f else -1.0f)); + test "cnod90kms" (pown -1.0 exp = (if exp % 2 = 0 then 1.0 else -1.0)); + test "cnod90kmt" (pown -1.0M exp = (if exp % 2 = 0 then 1.0M else -1.0M)); + test "cnod90kmu" (pown -1 exp = (if exp % 2 = 0 then 1 else -1)); + test "cnod90kmv" (pown -1L exp = (if exp % 2 = 0 then 1L else -1L)); + test "cnod90kmw" (pown -1s exp = (if exp % 2 = 0 then 1s else -1s)); + test "cnod90kmx" (pown -1y exp = (if exp % 2 = 0 then 1y else -1y)); + test "cnod90kmy" (pown -1n exp = (if exp % 2 = 0 then 1n else -1n)); + test "cnod90kmz" (pown 1.0f exp = 1.0f); + test "cnod90kmaa" (pown 1.0 exp = 1.0) + done + + do for baseIdx in [-5 .. 5] do + // check x^0 + test "cnod90kmbb2" (pown (float32 baseIdx) 0 = 1.0f); + test "cnod90kmcc2" (pown (float baseIdx) 0 = 1.0); + test "cnod90kmcc3" (pown (decimal baseIdx) 0 = 1M); + test "cnod90kmcc4" (pown (nativeint baseIdx) 0 = 1n); + test "cnod90kmcc5" (pown (unativeint baseIdx) 0 = 1un); + test "cnod90kmcc6" (pown (int64 baseIdx) 0 = 1L); + test "cnod90kmcc7" (pown (uint64 baseIdx) 0 = 1UL); + test "cnod90kmcc8" (pown (int32 baseIdx) 0 = 1); + test "cnod90kmcc9" (pown (uint32 baseIdx) 0 = 1u); + test "cnod90kmcca" (pown (int16 baseIdx) 0 = 1s); + test "cnod90kmccs" (pown (uint16 baseIdx) 0 = 1us); + test "cnod90kmccd" (pown (byte baseIdx) 0 = 1uy); + test "cnod90kmccf" (pown (sbyte baseIdx) 0 = 1y); + + // check x^1 + test "cnod90kmbb21" (pown (float32 baseIdx) 1 = (float32 baseIdx)); + test "cnod90kmbb22" (pown (decimal baseIdx) 1 = (decimal baseIdx)); + test "cnod90kmbb23" (pown (nativeint baseIdx) 1 = (nativeint baseIdx)); + test "cnod90kmbb24" (pown (float baseIdx) 1 = (float baseIdx)); + test "cnod90kmbb25" (pown (unativeint baseIdx) 1 = (unativeint baseIdx)); + test "cnod90kmbb26" (pown (int64 baseIdx) 1 = (int64 baseIdx)); + test "cnod90kmbb27" (pown (uint64 baseIdx) 1 = (uint64 baseIdx)); + test "cnod90kmbb28" (pown (uint16 baseIdx) 1 = (uint16 baseIdx)); + test "cnod90kmbb29" (pown (int16 baseIdx) 1 = (int16 baseIdx)); + test "cnod90kmbb2q" (pown (byte baseIdx) 1 = (byte baseIdx)); + test "cnod90kmbb2w" (pown (sbyte baseIdx) 1 = (sbyte baseIdx)); + + // check x^2 + test "cnod90kmbb11" (pown (float32 baseIdx) 2 = (float32 baseIdx) * (float32 baseIdx)); + test "cnod90kmbb12" (pown (decimal baseIdx) 2 = (decimal baseIdx) * (decimal baseIdx)); + test "cnod90kmbb13" (pown (nativeint baseIdx) 2 = (nativeint baseIdx) * (nativeint baseIdx)); + test "cnod90kmbb14" (pown (float baseIdx) 2 = (float baseIdx) * (float baseIdx)); + test "cnod90kmbb16" (pown (int64 baseIdx) 2 = (int64 baseIdx) * (int64 baseIdx)); + test "cnod90kmbb19" (pown (int16 baseIdx) 2 = (int16 baseIdx) * (int16 baseIdx)); + test "cnod90kmbb1b" (pown (sbyte baseIdx) 2 = (sbyte baseIdx) * (sbyte baseIdx)); + if baseIdx >= 0 then ( + test "cnod90kmbb15" (pown (unativeint baseIdx) 2 = (unativeint baseIdx) * (unativeint baseIdx)); + test "cnod90kmbb17" (pown (uint64 baseIdx) 2 = (uint64 baseIdx) * (uint64 baseIdx)); + test "cnod90kmbb18" (pown (uint16 baseIdx) 2 = (uint16 baseIdx) * (uint16 baseIdx)); + test "cnod90kmbb1a" (pown (byte baseIdx) 2 = (byte baseIdx) * (byte baseIdx)); + ) + done + + +module TakeUntilSkipWhile = + + do test "oewvjrrovvr1" ([ ] |> Seq.takeWhile (fun x -> x <= 5) |> Seq.toList = [ ]) + do test "oewvjrrovvr2" ([ 1 ] |> Seq.takeWhile (fun x -> x <= 5) |> Seq.toList = [ 1 ]) + do test "oewvjrrovvr3" ([ 1;2;3;4;5 ] |> Seq.takeWhile (fun x -> x <= 5) |> Seq.toList = [ 1..5 ]) + do test "oewvjrrovvr4" ([ 1;2;3;4;5;6 ] |> Seq.takeWhile (fun x -> x <= 5) |> Seq.toList = [ 1..5 ]) + do test "oewvjrrovvr5" ([ 1;2;3;4;5;6;7 ] |> Seq.takeWhile (fun x -> x <= 5) |> Seq.toList = [ 1..5 ]) + do test "oewvjrrovvr6" ([ 1;2;3;4;5;6;5;4;3;2;1 ] |> Seq.takeWhile (fun x -> x <= 5) |> Seq.toList = [ 1..5 ]) + + do test "oewvjrrovvr7" ([ 1;2;3;4;5 ] |> Seq.skipWhile (fun x -> x <= 5) |> Seq.toList = [ ]) + do test "oewvjrrovvr8" ([ 1;2;3;4;5;6 ] |> Seq.skipWhile (fun x -> x <= 5) |> Seq.toList = [ 6 ]) + do test "oewvjrrovvr9" ([ 1;2;3;4;5;6;7 ] |> Seq.skipWhile (fun x -> x <= 5) |> Seq.toList = [ 6;7 ]) + do test "oewvjrrovvra" ([ 1;2;3;4;5;6;5;4;3;2;1 ] |> Seq.skipWhile (fun x -> x <= 5) |> Seq.toList = [ 6;5;4;3;2;1 ]) + + + +(*--------------------------------------------------------------------------- +!* Infinite data structure tests + *--------------------------------------------------------------------------- *) + +(* +type ilist = Cons of int * ilist + +let test () = let rec list = Cons (1,list) in list + +let test2 () = let rec list2 = (1 :: list2) in list2 +let pri2 s l = printString s; printString ": "; List.iter printInt l; printNewLine () +let _ = pri2 "infinite list" (test2()) + +let pri3 s l = printString s; printString ": "; List.iter printInt l; printNewLine () +let test3 () = let rec list3 = (1 :: list4) and list4 = 2::list3 in list3 +let _ = pri3 "infinite list" (test3()) +* +type r4 = { cells: r4 list; tag: int } + +let rec pri4a x = printInt x.tag; pri4b x.cells +and pri4b l = iter pri4a l + +let test4 () = + let rec r1 = { cells = list3; tag = 1} + and r2 = { cells = list4; tag = 2} + and list3 = r2 :: list4 + and list4 = r1::list3 in + r1 + +let _ = pri4a(test4()) +*) + + +(*--------------------------------------------------------------------------- +!* Perf tests + *--------------------------------------------------------------------------- *) + + +let listtest1 () = + let pri2 s l = printString s; printString ": "; List.iter printInt l; printNewLine () in + let mutable r = [] in + for i = 1 to 100 do + r <- i :: r; + for j = 1 to 100 do + let _ = List.rev r in () + done; + done; + pri2 "list: " r + +let _ = listtest1() + +(* +let pri s l = printString s; printString ": "; List.iter printInt l; printNewLine () + let irev (l : int list) = + let res = ref [] in + let curr = ref l in + while (match curr.contents with [] -> false | _ -> true) do + match curr.contents with + (h::t) -> res.contents <- h :: !res; curr.contents <- t; + done; + !res +let r = ref [] +let _ = + for i = 1 to 100 do + r := i :: r.contents; + for j = 1 to 100 do + let _ = irev r.contents in () + done; + done +let _ = pri "list: " r.contents +*) + + +(* +let pri s l = printString s; printString ": "; List.iter printInt l; printNewLine () +type iiref= { mutable icontents: int list} +let iiref x = { icontents = x } +let (!!!!) r = r.icontents +let (<--) r x = r.icontents <- x + +let irev l = + let res = iiref [] in + let curr = iiref l in + while (match !!!!curr with [] -> false | _ -> true) do + match !!!!curr with + (h::t) -> res <-- h :: !!!!res; curr <-- t; + done; + !!!!res + +let r = iiref [] +let test() = + for i = 1 to 600 do + r <-- i :: !!!!r; + for j = 1 to 600 do + let _ = irev !!!!r in () + done; + done +let _ = test() +let _ = pri "list: " !!!!r +*) + + +(* +type ilist = Nil | Cons of int * ilist +let rec iiter f = function Nil -> () | Cons (h,t) -> (f h; iiter f t) +let pri s l = printString s; printString ": "; iiter printInt l; printNewLine () +type iref= { mutable icontents: ilist} +let iref x = { icontents = x } +let (!!!!) r = r.icontents +let (<--) r x = r.icontents <- x + +let irev l = + let res = iref Nil in + let curr = iref l in + while (match !!!!curr with Nil -> false | _ -> true) do + match !!!!curr with + Cons(h,t) -> res <-- Cons (h, !!!!res); curr <-- t; + done; + !!!!res + +let r = iref Nil +let test() = + for i = 1 to 600 do + r <-- Cons (i,!!!!r); + for j = 1 to 600 do + let _ = irev !!!!r in () + done; + done +let _ = test() +let _ = pri "list: " !!!!r +*) + +(* +type flist = Nil | Cons of float * flist +let rec fiter f = function Nil -> () | Cons (h,t) -> (f h; fiter f t) +let pri s l = printString s; printString ": "; fiter print_float l; printNewLine () +type fref= { mutable fcontents: flist} +let fref x = { fcontents = x } +let (!!!!) r = r.fcontents +let (<--) r x = r.fcontents <- x + +let frev l = + let res = fref Nil in + let curr = fref l in + while (match !!!!curr with Nil -> false | _ -> true) do + match !!!!curr with + Cons(h,t) -> res <-- Cons (h, !!!!res); curr <-- t; + done; + !!!!res + +let r = fref Nil +let test() = + for i = 1 to 600 do + r <-- Cons (float i,!!!!r); + for j = 1 to 600 do + let _ = frev !!!!r in () + done; + done +let _ = test() +let _ = pri "list: " !!!!r +*) + + +(* let rec not_inlined b = if b then not_inlined false else b *) +let not_inlined x = x +let inlined (x1:int) (x2:int) (x3:int) (x4:int) (x5:int) = + let not_eliminated = not_inlined 1 in + let not_eliminated2 = not_inlined 2 in + not_eliminated +let test2() = + let eliminated_to_value = inlined 1 1 1 1 1 in + let not_eliminated = not_inlined 2 in + eliminated_to_value + +let _ = test2() + +let ldexp22 (x:float) (n:int) = x * (2.0 ** float n) + +(* +let rec fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c +let rec for_all : ('a -> bool) -> 'a list -> bool +let rec exists : ('a -> bool) -> 'a list -> bool +let rec for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool +let rec exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool +let rec mem : 'a -> 'a list -> bool +let rec memq : 'a -> 'a list -> bool +let rec find : ('a -> bool) -> 'a list -> 'a +let rec filter : ('a -> bool) -> 'a list -> 'a list +let rec find_all : ('a -> bool) -> 'a list -> 'a list +let rec partition : ('a -> bool) -> 'a list -> 'a list * 'a list +let rec assoc : 'a -> ('a * 'b) list -> 'b +let rec assq : 'a -> ('a * 'b) list -> 'b +let rec mem_assoc : 'a -> ('a * 'b) list -> bool +let rec mem_assq : 'a -> ('a * 'b) list -> bool +let rec remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list +let rec remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list +let rec split : ('a * 'b) list -> 'a list * 'b list +let rec combine : 'a list -> 'b list -> ('a * 'b) list +let rec sort : ('a -> 'a -> int) -> 'a list -> 'a list +let rec stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list +*) + +let g x = match x with 2.0 -> 3.0 + +let _ = g 2.0 +let _ = g (1.0 + 1.0) + + +type u16 = U16 of int +type i32 = I32 of int32 +type bytes = Bytes of string + +type assembly_name = string (* uses exact comparisons. TODO: ECMA Partition 2 is inconsistent about this. *) +type module_name = string (* uses exact comparisons. TODO: ECMA Partition 2 is inconsistent about this. *) +type locale = (* should use case-insensitive comparison *) + | Locale_bytes of bytes (* unicode *) + | Locale_string of string + +type assembly_ref = + { assemRefName: assembly_name; + assemRefHash: bytes option; + (* Note: only one of the following two are ever present. *) + assemRefPublicKeyToken: bytes option; + assemRefPublicKey: bytes option; + assemRefVersion: (i32 * i32 * i32 * i32) option; + assemRefLocale: locale option } + +type modul_ref = + { modulRefName: module_name; + modulRefNoMetadata: bool; (* only for file references *) + modulRefHash: bytes option; (* only for file references *) + } + +type scope_ref = + | ScopeRef of assembly_ref * modul_ref option + +(* TODO: check the array types that are relevant for binding etc. *) +type array_bounds = ((i32 * i32 option) list) option +type type_ref = + | TypeRef of (scope_ref * string list * string) + | TypeRef_array of array_bounds * bool + +type typ = + | Type_void (* -- Used only in return and pointer types. *) + | Type_value of type_spec (* -- Unboxed types, including built-in types. *) + | Type_boxed of type_spec (* -- Nb. used for both boxed value classes *) + (* and classes. *) + | Type_ptr of typ (* -- Unmanaged pointers. Nb. the type is *) + (* effectively for tools and for binding *) + (* only, not by the verifier. *) + | Type_byref of typ (* -- Managed pointers. *) + | Type_typedref + | Type_fptr of callsig (* -- Code pointers. *) + | Type_modified of (* -- Custom modifiers. *) + bool * (* -- True if modifier is "required" *) + typ * (* -- the class of the custom modifier *) + typ (* -- the type being modified *) + +(* MS-ILX *) | Type_unit (* -- empty value *) +(* MS-ILX *) | Type_forall of genparam * typ (* -- indexed outside-in *) +(* MS-ILX *) | Type_tyvar of u16 (* -- reference a generic arg *) +(* MS-ILX *) | Type_tyrepvar of u16 +(* MS-ILX *) | Type_func of typ list * typ + +and type_spec = TypeSpec of type_ref (* MS-ILX *) * genactuals +and callsig = Callsig of callconv * typ list * typ + +(* MS-ILX *) (* ---------------------------------------------------------- +(* MS-ILX *) * Generic parameters, i.e. parameters reified statically. +(* MS-ILX *) * Currently only two kinds of parameters are supported in +(* MS-ILX *) * the term structure: types and type representations. +(* MS-ILX *) * Type representations are only used internally. +(* MS-ILX *) * --------------------------------------------------------- *) +(* MS-ILX *) +(* MS-ILX *) and genparams = genparam list +(* MS-ILX *) and genactuals = genactual list +(* MS-ILX *) and genactual = +(* MS-ILX *) | GenActual_type of typ +(* MS-ILX *) | GenActual_tyrep of typ +(* MS-ILX *) and genparam = +(* MS-ILX *) | GenFormal_type +(* MS-ILX *) | GenFormal_tyrep of exn +(* MS-ILX *) (* For compiler use only. *) +(* MS-ILX *) (* We use exn as an annotation here. *) +(* MS-ILX *) (* Types are still used as actuals for type-reps *) + + +(* -------------------------------------------------------------------- +!* Calling conventions. These are used in method pointer types. + * -------------------------------------------------------------------- *) + +and bcallconv = + | CC_cdecl + | CC_stdcall + | CC_thiscall + | CC_fastcall + | CC_default + | CC_vararg + +and hasthis = + | CC_instance + | CC_instance_explicit + | CC_static + +and callconv = Callconv of hasthis * bcallconv + +let mk_empty_gactuals = ([]: genactuals) +let mk_mono_tspec tref = TypeSpec (tref, mk_empty_gactuals) +let mscorlib_assembly_name = "mscorlib" +let mscorlib_module_name = "CommonLanguageRuntimeLibrary" +let mk_simple_assref n = + { assemRefName=n; + assemRefHash=None; + assemRefPublicKeyToken=None; + assemRefPublicKey=None; + assemRefVersion=None; + assemRefLocale=None; } +let mscorlib_aref = mk_simple_assref mscorlib_assembly_name +let mscorlib_scoref = ScopeRef(mscorlib_aref,None) +let mk_nested_tref (scope,l,nm) = TypeRef (scope,l,nm) +let mk_tref (scope,nm) = mk_nested_tref (scope,[],nm) + +let tname_Object1 = "System.Object" +let tref_Object1 = mk_tref (mscorlib_scoref,tname_Object1) +let tspec_Object1 = mk_mono_tspec tref_Object1 +let typ_Object1 = Type_boxed tspec_Object1 + +let tname_Object2 = "System.Object" +let tref_Object2 = mk_tref (mscorlib_scoref,tname_Object2) +let tspec_Object2 = mk_mono_tspec tref_Object2 +let typ_Object2 = Type_boxed tspec_Object2 + + + +let _ = printString "advanced equality test (1): "; if tname_Object1 = tname_Object2 then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "advanced equality test (9): "; if (mscorlib_scoref,[],tname_Object1) =(mscorlib_scoref,[],tname_Object2) then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "advanced equality test (10): "; if tref_Object1 = tref_Object2 then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "advanced equality test (11): "; if typ_Object1 = typ_Object2 then stdout.WriteLine "YES" else reportFailure "basic test Q" + + +let _ = printString "array equality test (1): "; if [| 1 |] = [| 1 |] then stdout.WriteLine "YES" else reportFailure "basic test Q" + +let _ = printString "arr equality test (4): "; if [| |] = [| |] then stdout.WriteLine "YES" else reportFailure "basic test Q" +let _ = printString "arr hash-respects-equality test (4): "; if hash [| |] = hash [| |] then stdout.WriteLine "YES" else reportFailure "basic test Q" + +let _ = printString "array equality test (1): "; if [| 1 |] = [| 1 |] then stdout.WriteLine "YES" else reportFailure "basic test Q" + + + +(* +let f x = + let g a b c d = (a=1) && (b = 2) && (c = 3) && (d = 4) && (x = 5) in + let bigcheck h (a:int) (b:int) (c:int) (d:int) = + h a b c d && + h a b c d && + (let f1 = h a in + let f2 = f1 b in + let f3 = f2 c in + f3 d) && + (let f1 = h a b in + let f2 = f1 c in + f2 d) && + (let f1 = h a b c in + f1 d) && + (let f1 = h a in + let f2 = f1 b c in + f2 d) && + (let f1 = h a in + let f2 = f1 b in + f2 c d) && + (let f1 = h a b in + f1 c d) && + (let f1 = h a in + f1 b c d) in + bigcheck g 1 2 3 4 + +let _ = if (f 5) then stdout.WriteLine "YES" else reportFailure "basic test Q" + + +let sort_test cmp ans = + for i0 = 0 to 5 do + for i1 = 0 to 5 do + for i2 = 0 to 5 do + for i3 = 0 to 5 do + for i4 = 0 to 5 do + for i5 = 0 to 5 do + if i0 <> i1 && i0 <> i2 && i0 <> i3 && i0 <> i4 && i0 <> i5 & + i1 <> i2 && i1 <> i3 && i1 <> i4 && i1 <> i5 & + i2 <> i3 && i2 <> i4 && i2 <> i5 & + i3 <> i4 && i3 <> i5 & + i4 <> i5 then + let a = Array.create 6 0 in + a.(i0) <- 0; + a.(i1) <- 1; + a.(i2) <- 2; + a.(i3) <- 3; + a.(i4) <- 4; + a.(i5) <- 5; + (* list sort *) + let l = Array.toList a in + let res = List.sortWith cmp l in + if (res<> ans) then begin + let printInt n = printString (string_of_int n) in + printString "List.sort "; + printInt a.(0); + printInt a.[1]; + printInt a.[2]; + printInt a.(3); + printInt a.(4); + printInt a.(5); + printString " = "; + let resa = Array.ofList res in + printInt resa.(i0); + printInt resa.(i1); + printInt resa.(i2); + printInt resa.(i3); + printInt resa.(i4); + printInt resa.(i5); + reportFailure "unlabelled test" + end; + (* array sort *) + let resa = Array.copy a in + Array.sortInPlaceWith cmp resa; (* mutates resa array *) + let res = Array.toList resa in + if (res<> ans) then begin + let printInt n = printString (string_of_int n) in + printString "Array.sort "; + printInt a.(0); + printInt a.[1]; + printInt a.[2]; + printInt a.(3); + printInt a.(4); + printInt a.(5); + printString " = "; + (* recall Array.list_of resa = res *) + printInt resa.(i0); + printInt resa.(i1); + printInt resa.(i2); + printInt resa.(i3); + printInt resa.(i4); + printInt resa.(i5); + reportFailure "unlabelled test" + end + done; + done; + done; + done; + done; + done + +let _ = sort_test compare [0;1;2;3;4;5] +let _ = sort_test (fun x y -> -(compare x y)) [5;4;3;2;1;0] +*) +module StrangeOperatorTest = + let (&&&) x y = x^y + let (<<<) (x:string) (y:string) = x ^y^x + + let e1 = ("0" &&& ("1" <<< "2")) + let e2= (("0" &&& "1") <<< "2") + let e3= ("0" &&& "1" <<< "2") + + let _ = if (e1 <> e2) then stderr.WriteLine "Control Passed" else stderr.WriteLine "Control Failed" + let _ = if (e1 = e3) then (stderr.WriteLine "Parsed to Right! Wrong!" ; reportFailure "parsing") + let _ = if (e2 = e3) then stderr.WriteLine "Parsed to Left - correct!" + + + +//let _ = if (3 then do ignore(4)) = 3 then stderr.WriteLine "OK!" else (stderr.WriteLine "Wrong!" ; reportFailure "unlabelled test") +//let _ = let x = ref 1 in if (!x then do x := !x + 1) = 1 then stderr.WriteLine "OK!" else (stderr.WriteLine "Wrong!" ; reportFailure "unlabelled test") + + +(* Check codegen for using functions of type (unit -> _) as first class values. *) +let _ = List.map printNewLine [(); (); ()] + +(* Check codegen for tail recursive functions with argument and return types involving "unit" *) +let rec unitElimTailRecursion1() = stdout.WriteLine "loop"; (unitElimTailRecursion1() : string) +let rec unitElimTailRecursion2((),()) = stdout.WriteLine "loop"; (unitElimTailRecursion2((),()) : string) +let rec unitElimTailRecursion3() = stdout.WriteLine "loop"; (unitElimTailRecursion3() : unit) +let rec unitElimTailRecursion4((),()) = stdout.WriteLine "loop"; (unitElimTailRecursion4((),()) : unit) +let rec unitElimTailRecursion5() = stdout.WriteLine "loop"; (unitElimTailRecursion5() : 'a) +let rec unitElimTailRecursion6((),()) = stdout.WriteLine "loop"; (unitElimTailRecursion6((),()) : 'a) + +(* Check codegen for inner tail recursive functions with argument and return types involving "unit". *) +let innerUnitElimTailRecursion1 () = + let rec unitElimTailRecursion1() = stdout.WriteLine "loop"; (unitElimTailRecursion1() : string) in + let rec unitElimTailRecursion2((),()) = stdout.WriteLine "loop"; (unitElimTailRecursion2((),()) : string) in + let rec unitElimTailRecursion3() = stdout.WriteLine "loop"; (unitElimTailRecursion3() : unit) in + let rec unitElimTailRecursion4((),()) = stdout.WriteLine "loop"; (unitElimTailRecursion4((),()) : unit) in + let rec unitElimTailRecursion5() = stdout.WriteLine "loop"; (unitElimTailRecursion5() : 'a) in + let rec unitElimTailRecursion6((),()) = stdout.WriteLine "loop"; (unitElimTailRecursion6((),()) : 'a) in + (unitElimTailRecursion1, unitElimTailRecursion2, unitElimTailRecursion3, unitElimTailRecursion4, unitElimTailRecursion5, unitElimTailRecursion6) + +(* Check codegen for tail recursive functions with argument types involving " int * int" *) +let rec tupleElimTailRecursion1((x:int), (y:int)) = stdout.WriteLine "loop"; (tupleElimTailRecursion1(x,y) : string) +let rec tupleElimTailRecursion2((x1:int), (y1:int)) ((x2:int), (y2:int)) = stdout.WriteLine "loop"; (tupleElimTailRecursion2(x2,y2) (x1,y1) : string) + +let innerTupleElimTailRecursion1 () = + let rec tupleElimTailRecursion1((x:int), (y:int)) = stdout.WriteLine "loop"; (tupleElimTailRecursion1(x,y) : string) in + let rec tupleElimTailRecursion2((x1:int), (y1:int)) ((x2:int), (y2:int)) = stdout.WriteLine "loop"; (tupleElimTailRecursion2(x2,y2) (x1,y1) : string) in + tupleElimTailRecursion1, tupleElimTailRecursion2 + +let test3d9cw90 () = + let set = (Set.add 1 (Set.add 0 (Set.add 1 (Set.add 5 (Set.add 4 (Set.add 3 Set.empty)))))) in + let i = (set :> seq<_>).GetEnumerator() in + check "set iterator" true (i.MoveNext()); + check "set iterator" 0 i.Current; + check "set iterator" true (i.MoveNext()); + check "set iterator" 1 i.Current; + check "set iterator" true (i.MoveNext()); + check "set iterator" 3 i.Current; + check "set iterator" true (i.MoveNext()); + check "set iterator" 4 i.Current; + check "set iterator" true (i.MoveNext()); + check "set iterator" 5 i.Current; + check "set iterator" false (i.MoveNext()) + +do test3d9cw90 () + +do check "set comparison" 0 ((Seq.compareWith Operators.compare) Set.empty Set.empty) +do check "set comparison" 0 ((Seq.compareWith Operators.compare) (Set.add 1 Set.empty) (Set.add 1 Set.empty)) +do check "set comparison" 0 ((Seq.compareWith Operators.compare) (Set.add 1 (Set.add 2 Set.empty)) (Set.add 2 (Set.add 1 Set.empty))) +do check "set comparison" 0 ((Seq.compareWith Operators.compare) (Set.add 1 (Set.add 2 (Set.add 3 Set.empty))) (Set.add 3 (Set.add 2 (Set.add 1 Set.empty)))) + + +do check "set comparison" (-1) ((Seq.compareWith Operators.compare) Set.empty (Set.add 1 Set.empty)) +do check "set comparison" (-1) ((Seq.compareWith Operators.compare) (Set.add 1 Set.empty) (Set.add 2 Set.empty)) +do check "set comparison" (-1) ((Seq.compareWith Operators.compare) (Set.add 1 (Set.add 2 Set.empty)) (Set.add 3 (Set.add 1 Set.empty))) +do check "set comparison" (-1) ((Seq.compareWith Operators.compare) (Set.add 1 (Set.add 2 (Set.add 3 Set.empty))) (Set.add 4 (Set.add 2 (Set.add 1 Set.empty)))) + +let checkReflexive f x y = (f x y = - f y x) + +do check "set comparison" true (checkReflexive (Seq.compareWith Operators.compare) Set.empty (Set.add 1 Set.empty)) +do check "set comparison" true (checkReflexive (Seq.compareWith Operators.compare) (Set.add 1 Set.empty) (Set.add 2 Set.empty)) +do check "set comparison" true (checkReflexive (Seq.compareWith Operators.compare) (Set.add 1 (Set.add 2 Set.empty)) (Set.add 3 (Set.add 1 Set.empty))) +do check "set comparison" true (checkReflexive (Seq.compareWith Operators.compare) (Set.add 1 (Set.add 2 (Set.add 3 Set.empty))) (Set.add 4 (Set.add 2 (Set.add 1 Set.empty)))) + + + + +(*================================================================================*) + +(* Set ordering - tests *) + +let rec nlist i n = + if n=0 then [] else + if n % 2 = 1 then i :: nlist (i+1) (n / 2) + else nlist (i+1) (n / 2) + +let orderTest n m = + //printf "Check sorted-list order against ordered-set order: n=%-10d m=%-10d\n" n m; + let nL = nlist 0 n in + let nS = Set.ofList nL in + let mL = nlist 0 m in + let mS = Set.ofList mL in + test "vwnwer" (compare nL mL = Seq.compareWith Operators.compare nS mS) + +let nMax = 4096 * 4096 +let ran = new System.Random() +let testOrder() = orderTest (ran.Next(nMax)) (ran.Next(nMax)) +do for i = 1 to 1000 do testOrder() done + +(*================================================================================*) + + + + +(* +let test2398985() = + let l = ReadonlyArray.ofList [1;2;3] in + let res = ref 2 in + for i in ReadonlyArray.toSeq l do res.Value <- res.Value + i done; + check "test2398985: ReadonlyArray.toSeq" 8 !res + +do test2398985() +*) + +let test2398986() = + let l = Array.ofList [1;2;3] in + let mutable res = 2 in + for i in Array.toSeq l do res <- res + i done; + check "test2398986: Array.toSeq" 8 res + +do test2398986() + +let test2398987() = + let l = Set.ofList [1;2;3] in + let res = ref 2 in + for i in Set.toSeq l do res.Value <- res.Value + i done; + check "test2398987: Idioms.foreach, Set.toSeq" 8 !res + +do test2398987() + +let test2398987b() = + let l = Set.ofList [1;2;3] in + let res = ref 2 in + for i in l do res.Value <- res.Value + i done; + check "test2398987: Idioms.foreach, Set.toSeq" 8 !res + +do test2398987b() + + +(*--------------------------------------------------------------------------- +!* foreachG/to_seq + *--------------------------------------------------------------------------- *) + + + +let foreach e f = Seq.iter f e +let test2398993() = + let l = [1;2;3] in + let res = ref 2 in + foreach (List.toSeq l) (fun i -> res.Value <- res.Value + i); + check "test2398993: foreach, List.toSeq" 8 !res + +do test2398993() + +(* +let test2398995() = + let l = ReadonlyArray.ofList [1;2;3] in + let res = ref 2 in + foreach (ReadonlyArray.toSeq l) (fun i -> res.Value <- res.Value + i); + check "test2398995: foreach, ReadonlyArray.toSeq" 8 !res + +do test2398995() +*) + +let test2398996() = + let l = Array.ofList [1;2;3] in + let res = ref 2 in + foreach (Array.toSeq l) (fun i -> res.Value <- res.Value + i); + check "test2398996: foreach, Array.toSeq" 8 !res + +do test2398996() + +let test2398997() = + let l = Set.ofList [1;2;3] in + let res = ref 2 in + foreach (Set.toSeq l) (fun i -> res.Value <- res.Value + i); + check "test2398997: foreach, Set.toSeq" 8 !res + +do test2398997() + + +(*--------------------------------------------------------------------------- +!* Generic formatting + *--------------------------------------------------------------------------- *) + + +do check "generic format 1" "[1; 2]" (sprintf "%A" [1;2]) +do check "generic format 2" "Some [1; 2]" (sprintf "%A" (Some [1;2])) +do check "generic format a" "1y" (sprintf "%A" 1y) +do check "generic format b" "1uy" (sprintf "%A" 1uy) +do check "generic format c" "1s" (sprintf "%A" 1s) +do check "generic format d" "1us" (sprintf "%A" 1us) +do check "generic format e" "1" (sprintf "%A" 1) +do check "generic format f" "1u" (sprintf "%A" 1ul) +do check "generic format g" "1L" (sprintf "%A" 1L) +do check "generic format j" "1.0" (sprintf "%A" 1.0) +do check "generic format k" "1.01" (sprintf "%A" 1.01) +do check "generic format l" "1000.0" (sprintf "%A" 1000.0) + +do check "generic format m" "-1y" (sprintf "%A" (-1y)) +do check "generic format n" "-1s" (sprintf "%A" (-1s)) +do check "generic format o" "-1" (sprintf "%A" (-1)) +do check "generic format p" "-1L" (sprintf "%A" (-1L)) +#if !NETCOREAPP +// See FSHARP1.0:4797 +// On NetFx4.0 and above we do not emit the 'I' suffix +let bigintsuffix = if (System.Environment.Version.Major, System.Environment.Version.Minor) > (2,0) then "" else "I" +do check "generic format i" ("1" + bigintsuffix) ( printf "%A" 1I + sprintf "%A" 1I) +do check "generic format r" ("-1" + bigintsuffix) (sprintf "%A" (-1I)) +#endif + + +(*--------------------------------------------------------------------------- +!* For loop variables can escape + *--------------------------------------------------------------------------- *) + +do for i = 1 to 10 do List.iter (fun x -> Printf.printf "x = %d\n" x) (List.map (fun x -> x + i) [1;2;3]) done + + +(*--------------------------------------------------------------------------- +!* Type tests + *--------------------------------------------------------------------------- *) + +do check "type test string" "right" (match box("right") with | :? System.String as s -> s | _ -> "wrong") +do check "type test string (2)" "right" (match box("right") with| :? System.Int32 -> "wrong" | :? System.String as s -> s | _ -> "wrong") +do check "type test int32" "right" (match box(1) with | :? System.String -> "wrong" | :? System.Int32 -> "right" | _ -> "wrong") +do check "type test int32 (2)" "right" (match box(1) with | :? System.Int32 -> "right" | :? System.String -> "wrong" | _ -> "wrong") +do check "type test int32 (3)" 4 (match box(4) with | :? System.Int32 as d -> d | :? System.String -> 3 | _ -> 2) +do check "type test double" 1.0 (match box(1.0) with | :? System.Int32 -> 3.14 | :? System.Double as d -> d | _ -> 2.71) + + + +(*--------------------------------------------------------------------------- +!* type syntax + *--------------------------------------------------------------------------- *) + +module TypeSyntax = + let x1 = [Map.add 1 (Map.add 1 1 Map.empty) Map.empty] + let x2 : Map<'a,'b> list = [Map.empty] + let x3 : Map<'a,'b> list = [] + + +module IEnumerableTests = begin + + // This one gave a stack overflow when we weren't tail-calling on 64-bit + do check "Seq.filter-length" ({ 1 .. 1000000 } |> Seq.filter (fun n -> n <> 1) |> Seq.length) 999999 + do check "Seq.filter-length" ({ 1 .. 1000000 } |> Seq.filter (fun n -> n = 1) |> Seq.length) 1 + do check "Seq.filter-length" ({ 1 .. 1000000 } |> Seq.filter (fun n -> n % 2 = 0) |> Seq.length) 500000 + + do check "IEnumerableTest.empty-length" (Seq.length Seq.empty) 0 + do check "IEnumerableTest.length-of-array" (Seq.length [| 1;2;3 |]) 3 + do check "IEnumerableTest.head-of-array" (Seq.head [| 1;2;3 |]) 1 + do check "IEnumerableTest.take-0-of-array" (Seq.take 0 [| 1;2;3 |] |> Seq.toList) [] + do check "IEnumerableTest.take-1-of-array" (Seq.take 1 [| 1;2;3 |] |> Seq.toList) [1] + do check "IEnumerableTest.take-3-of-array" (Seq.take 3 [| 1;2;3 |] |> Seq.toList) [1;2;3] + do check "IEnumerableTest.nonempty-true" (Seq.isEmpty [| 1;2;3 |]) false + do check "IEnumerableTest.nonempty-false" (Seq.isEmpty [| |]) true + do check "IEnumerableTest.fold" (Seq.fold (+) 0 [| 1;2;3 |] ) 6 + do check "IEnumerableTest.unfold" (Seq.unfold (fun _ -> None) 1 |> Seq.toArray) [| |] + do check "IEnumerableTest.unfold" (Seq.unfold (fun x -> if x = 1 then Some("a",2) else None) 1 |> Seq.toArray) [| "a" |] + do check "IEnumerableTest.exists" (Seq.exists ((=) "a") [| |]) false + do check "IEnumerableTest.exists" (Seq.exists ((=) "a") [| "a" |]) true + do check "IEnumerableTest.exists" (Seq.exists ((=) "a") [| "1"; "a" |]) true + do check "IEnumerableTest.exists" (Seq.forall ((=) "a") [| |]) true + do check "IEnumerableTest.exists" (Seq.forall ((=) "a") [| "a" |]) true + do check "IEnumerableTest.exists" (Seq.forall ((=) "a") [| "1"; "a" |]) false + do check "IEnumerableTest.map on finite" ([| "a" |] |> Seq.map (fun x -> x.Length) |> Seq.toArray) [| 1 |] + do check "IEnumerableTest.filter on finite" ([| "a";"ab";"a" |] |> Seq.filter (fun x -> x.Length = 1) |> Seq.toArray) [| "a";"a" |] + do check "IEnumerableTest.choose on finite" ([| "a";"ab";"a" |] |> Seq.choose (fun x -> if x.Length = 1 then Some(x^"a") else None) |> Seq.toArray) [| "aa";"aa" |] + do check "Seq.tryPick on finite (succeeding)" ([| "a";"ab";"a" |] |> Seq.tryPick (fun x -> if x.Length = 1 then Some(x^"a") else None)) (Some "aa") + do check "Seq.tryPick on finite (failing)" ([| "a";"ab";"a" |] |> Seq.tryPick (fun x -> if x.Length = 6 then Some(x^"a") else None)) None + do check "IEnumerableTest.find on finite (succeeding)" ([| "a";"ab";"a" |] |> Seq.find (fun x -> x.Length = 1)) "a" + do check "IEnumerableTest.find on finite (failing)" (try Some ([| "a";"ab";"a" |] |> Seq.find (fun x -> x.Length = 6)) with :? System.Collections.Generic.KeyNotFoundException -> None) None + do check "IEnumerableTest.map_with_type (string up to obj,finite)" ([| "a" |] |> Seq.cast |> Seq.toArray) [| ("a" :> obj) |] + do check "IEnumerableTest.map_with_type (obj down to string, finite)" ([| ("a" :> obj) |] |> Seq.cast |> Seq.toArray) [| "a" |] + do check "IEnumerableTest.append, finite, finite" (Seq.append [| "a" |] [| "b" |] |> Seq.toArray) [| "a"; "b" |] + do check "IEnumerableTest.concat, finite" (Seq.concat [| [| "a" |]; [| |]; [| "b";"c" |] |] |> Seq.toList) [ "a";"b";"c" ] + do check "IEnumerableTest.init_infinite, then take" (Seq.take 2 (Seq.initInfinite (fun i -> i+1)) |> Seq.toList) [ 1;2 ] + do check "IEnumerableTest.to_array, empty" (Seq.init 0 (fun i -> i+1) |> Seq.toArray) [| |] + do check "IEnumerableTest.to_array, small" (Seq.init 1 (fun i -> i+1) |> Seq.toArray) [| 1 |] + do check "IEnumerableTest.to_array, large" (Seq.init 100000 (fun i -> i+1) |> Seq.toArray |> Array.length) 100000 + do check "IEnumerableTest.to_array, very large" (Seq.init 1000000 (fun i -> i+1) |> Seq.toArray |> Array.length) 1000000 + do check "IEnumerableTest.to_list, empty" (Seq.init 0 (fun i -> i+1) |> Seq.toList) [ ] + do check "IEnumerableTest.to_list, small" (Seq.init 1 (fun i -> i+1) |> Seq.toList) [ 1 ] + do check "IEnumerableTest.to_list, large" (Seq.init 100000 (fun i -> i+1) |> Seq.toList |> List.length) 100000 + do check "IEnumerableTest.to_list, large" (Seq.init 1000000 (fun i -> i+1) |> Seq.toList |> List.length) 1000000 + do check "IEnumerableTest.to_list, large" (Seq.init 1000000 (fun i -> i+1) |> List.ofSeq |> List.length) 1000000 + do check "List.unzip, large" (Seq.init 1000000 (fun i -> (i,i+1)) |> List.ofSeq |> List.unzip |> fst |> List.length) 1000000 + let dup x = x,x + let uncurry f (x,y) = f x y + do check "List.zip, large" (Seq.init 1000000 (fun i -> (i,i+1)) |> List.ofSeq |> dup |> uncurry List.zip |> List.length) 1000000 + +(* + // Currently disabled, since IStructuralEquatable.Equals will cause this to stack overflow around 140000 elements + do check "List.sort, large" ((Seq.init 140000 (fun i -> 139999 - i) |> List.ofSeq |> List.sort) = + (Seq.init 140000 (fun i -> i) |> List.ofSeq |> List.sort)) true +*) + + + do check "Seq.singleton" (Seq.singleton 42 |> Seq.length) 1 + do check "Seq.singleton" (Seq.singleton 42 |> Seq.toList) [42] + + do check "Seq.truncate" (Seq.truncate 20 [1..100] |> Seq.toList) [1..20] + do check "Seq.truncate" (Seq.truncate 1 [1..100] |> Seq.toList) [1] + do check "Seq.truncate" (Seq.truncate 0 [1..100] |> Seq.toList) [] + + do check "Seq.scan" (Seq.scan (+) 0 [|1..5|] |> Seq.toArray) [|0; 1; 3; 6; 10; 15|] + //do check "Seq.scan1" (Seq.scan1 (+) [|1..5|] |> Seq.toArray) [|3; 6; 10; 15|] + + do check "Seq.exists2" (Seq.exists2 (=) [|1; 2; 3; 4; 5; 6|] [|2; 3; 4; 5; 6; 6|]) true + do check "Seq.exists2" (Seq.exists2 (=) [|1; 2; 3; 4; 5; 6|] [|2; 3; 4; 5; 6; 7|]) false + + do check "Seq.forall2" (Seq.forall2 (=) [|1..10|] [|1..10|]) true + do check "Seq.forall2" (Seq.forall2 (=) [|1;2;3;4;5|] [|1;2;3;0;5|]) false + + +// do check "Seq.find_index" (Seq.find_index (fun i -> i >= 4) [|0..10|]) 4 +// do check "Seq.find_index" (try Seq.find_index (fun i -> i >= 20) [|0..10|] |> ignore; false +// with _ -> true) true + +// do check "Seq.find_indexi" (Seq.find_indexi (=) [|1; 2; 3; 3; 2; 1|]) 3 +// do check "Seq.find_indexi" (try Seq.find_indexi (=) [|1..10|] |> ignore; false +// with _ -> true) true + + do check "Seq.tryFind" ([|1..100|] |> Seq.tryFind (fun x -> x > 50)) (Some 51) + do check "Seq.tryFind" ([|1..100|] |> Seq.tryFind (fun x -> x > 180)) None + +// do check "Seq.tryfind_index" (Seq.tryfind_index (fun x -> x = 4) [|0..10|]) (Some 4) +// do check "Seq.tryfind_index" (Seq.tryfind_index (fun x -> x = 42) [|0..10|]) None + +// do check "Seq.tryfind_indexi" (Seq.tryfind_indexi (=) [|1;2;3;4;4;3;2;1|]) (Some 4) +// do check "Seq.tryfind_indexi" (Seq.tryfind_indexi (=) [|1..10|]) None + + do check "Seq.compareWith" (Seq.compareWith compare [1;2] [2;1]) -1 + do check "Seq.compareWith" (Seq.compareWith compare [2;1] [1;2]) 1 + do check "Seq.compareWith" (Seq.compareWith compare [1;2] [1;2]) 0 + do check "Seq.compareWith" (Seq.compareWith compare [] [1;2]) -1 + + do check "Seq.ofList" (Seq.toList (Seq.ofList [1..20])) [1..20] + + do check "Seq.cast" (Seq.cast [1..10] |> Seq.toList) [1..10] + do check "Seq.collect" (Seq.collect (fun i -> [i*10 .. i*10+9]) [0..9] |> Seq.toList) [0..99] + + let c = ref -1 + do Seq.iter2 (fun x y -> incr c; test "Seq.iter2" (c.Value = x && c.Value = y)) [0..10] [0..10] + do check "Seq.iter2" c.Value 10 + + do check "Seq.zip" + (Seq.zip [1..10] [2..11] |> Seq.toList) [for i in 1..10 -> i, i+1] + + + do check "Seq.zip3" + (Seq.zip3 [1..10] [2..11] [3..12] |> Seq.toList) [for i in 1..10 -> i, i+1, i+2] + + do c.Value <- -1 + do Seq.iteri (fun n x -> incr c; test "Seq.iter2" (c.Value = n && c.Value+1 = x)) [1..11] + do check "Seq.iter2" c.Value 10 + + do check "Seq.pairwise" (Seq.pairwise [1..20] |> Seq.toList) [for i in 1 .. 19 -> i, i+1] + + do check "Seq.windowed 1" (Seq.windowed 1 [1..20] |> Seq.toList) [for i in 1 .. 20 -> [|i|]] + do check "Seq.windowed 2" (Seq.windowed 2 [1..20] |> Seq.toList) [for i in 1 .. 19 -> [|i; i+1|]] + do check "Seq.windowed 3" (Seq.windowed 3 [1..20] |> Seq.toList) [for i in 1 .. 18 -> [|i; i+1; i+2|]] + do check "Seq.windowed 4" (Seq.windowed 4 [1..20] |> Seq.toList) [for i in 1 .. 17 -> [|i; i+1; i+2; i+3|]] + + let group = Seq.groupBy (fun x -> x % 5) [1..100] + do for n, s in group do + check "Seq.groupBy" (Seq.forall (fun x -> x % 5 = n) s) true + done + do check "Seq.groupBy" ([for n,_ in group -> n] |> List.sort) [0..4] + + let sorted = Seq.sortBy abs [2; 4; 3; -5; 2; -4; -8; 0; 5; 2] + do check "Seq.sortBy" (Seq.pairwise sorted |> Seq.forall (fun (x, y) -> abs x <= abs y)) true + + let counts = Seq.countBy id [for i in 1..10 do yield! [10..-1..i] done] + do check "Seq.countBy" (counts |> Seq.toList) [for i in 10..-1..1 -> i, i] + + do check "Seq.sum" (Seq.sum [1..100]) (100*101/2) + do check "Seq.sumBy" (Seq.sumBy float [1..100]) (100.*101./2.) + + do check "Seq.average" (Seq.average [1.; 2.; 3.]) 2. + do check "Seq.averageBy" (Seq.averageBy float [0..100]) 50. + do check "Seq.min" (Seq.min [1; 4; 2; 5; 8; 4; 0; 3]) 0 + do check "Seq.max" (Seq.max [1; 4; 2; 5; 8; 4; 0; 3]) 8 + do check "Seq.minBy" (Seq.minBy int "this is a test") ' ' + do check "Seq.maxBy" (Seq.maxBy int "this is a test") 't' + + // Test where the key includes null values + do check "dict - option key" (dict [ (None,10); (Some 3, 220) ]).[None] 10 + do check "dict - option key" (dict [ (None,10); (Some 3, 220) ]).[Some 3] 220 + do check "dict - option key" (([ (None,10); (Some 3, 220) ] |> Seq.groupBy fst) |> Seq.length) 2 + do check "dict - option key" (([ (None,10); (Some 3, 220); (None,10); (Some 3, 220) ] |> Seq.distinct ) |> Seq.length) 2 + do check "dict - option key" (([ (None,10); (Some 3, 220); (None,10); (Some 4, 220) ] |> Seq.distinctBy fst) |> Seq.length) 3 + do check "dict - option key" (([ (None,10); (Some 3, 220); (None,10); (Some 4, 220) ] |> Seq.countBy fst) |> Seq.length) 3 + + // Test where the key includes null values + do check "dict - option key" (dict [ ([| |],10); ([| 3 |], 220) ]).[[| |]] 10 + do check "dict - option key" (dict [ ([| |],10); ([| 3 |], 220) ]).[[| 3 |]] 220 + do check "dict - option key" (([ ([| |],10); ([| 3 |], 220) ] |> Seq.groupBy fst) |> Seq.length) 2 + do check "dict - option key" (([ ([| |],10); ([| 3 |], 220); ([| |],10); ([| 3 |], 220) ] |> Seq.distinct ) |> Seq.length) 2 + do check "dict - option key" (([ ([| |],10); ([| 3 |], 220); ([| |],10); ([| 4 |], 220) ] |> Seq.distinctBy fst) |> Seq.length) 3 + do check "dict - option key" (([ ([| |],10); ([| 3 |], 220); ([| |],10); ([| 4 |], 220) ] |> Seq.countBy fst) |> Seq.length) 3 + +end + +module SeqTestsOnEnumerableEnforcingDisposalAtEnd = begin + + let mutable numActiveEnumerators = 0 + + let countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd (seq: seq<'a>) = + let enumerator() = + numActiveEnumerators <- numActiveEnumerators + 1; + let disposed = ref false in + let endReached = ref false in + let ie = seq.GetEnumerator() in + { new System.Collections.Generic.IEnumerator<'a> with + member x.Current = + test "rvlrve0" (not !endReached); + test "rvlrve1" (not !disposed); + ie.Current + member x.Dispose() = + test "rvlrve2" !endReached; + test "rvlrve4" (not !disposed); + numActiveEnumerators <- numActiveEnumerators - 1; + disposed.Value <- true; + ie.Dispose() + interface System.Collections.IEnumerator with + member x.MoveNext() = + test "rvlrve0" (not !endReached); + test "rvlrve3" (not !disposed); + endReached.Value <- not (ie.MoveNext()); + not !endReached + member x.Current = + test "qrvlrve0" (not !endReached); + test "qrvlrve1" (not !disposed); + box ie.Current + member x.Reset() = + ie.Reset() + } in + + { new seq<'a> with + member x.GetEnumerator() = enumerator() + interface System.Collections.IEnumerable with + member x.GetEnumerator() = (enumerator() :> _) } + + let countEnumeratorsAndCheckedDisposedAtMostOnce (seq: seq<'a>) = + let enumerator() = + let disposed = ref false in + let endReached = ref false in + let ie = seq.GetEnumerator() in + numActiveEnumerators <- numActiveEnumerators + 1; + { new System.Collections.Generic.IEnumerator<'a> with + member x.Current = + test "qrvlrve0" (not !endReached); + test "qrvlrve1" (not !disposed); + ie.Current + member x.Dispose() = + test "qrvlrve4" (not !disposed); + numActiveEnumerators <- numActiveEnumerators - 1; + disposed.Value <- true; + ie.Dispose() + interface System.Collections.IEnumerator with + member x.MoveNext() = + test "qrvlrve0" (not !endReached); + test "qrvlrve3" (not !disposed); + endReached.Value <- not (ie.MoveNext()); + not !endReached + member x.Current = + test "qrvlrve0" (not !endReached); + test "qrvlrve1" (not !disposed); + box ie.Current + member x.Reset() = + ie.Reset() + } in + + { new seq<'a> with + member x.GetEnumerator() = enumerator() + interface System.Collections.IEnumerable with + member x.GetEnumerator() = (enumerator() :> _) } + + // This one gave a stack overflow when we weren't tail-calling on 64-bit + do check "Seq.filter-length" ({ 1 .. 1000000 } |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.filter (fun n -> n <> 1) |> Seq.length) 999999 + do check "" numActiveEnumerators 0 + do check "Seq.filter-length" ({ 1 .. 1000000 } |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.filter (fun n -> n = 1) |> Seq.length) 1 + do check "" numActiveEnumerators 0 + do check "Seq.filter-length" ({ 1 .. 1000000 } |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.filter (fun n -> n % 2 = 0) |> Seq.length) 500000 + do check "" numActiveEnumerators 0 + + do check "IEnumerableTest.empty-length" (Seq.length (countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd Seq.empty)) 0 + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.length-of-array" (Seq.length (countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd [| 1;2;3 |])) 3 + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.head-of-array" (Seq.head (countEnumeratorsAndCheckedDisposedAtMostOnce [| 1;2;3 |])) 1 + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.take-0-of-array" (Seq.take 0 (countEnumeratorsAndCheckedDisposedAtMostOnce [| 1;2;3 |]) |> Seq.toList) [] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.take-1-of-array" (Seq.take 1 (countEnumeratorsAndCheckedDisposedAtMostOnce [| 1;2;3 |]) |> Seq.toList) [1] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.take-3-of-array" (Seq.take 3 (countEnumeratorsAndCheckedDisposedAtMostOnce [| 1;2;3 |]) |> Seq.toList) [1;2;3] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.nonempty-true" (Seq.isEmpty (countEnumeratorsAndCheckedDisposedAtMostOnce [| 1;2;3 |])) false + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.nonempty-false" (Seq.isEmpty (countEnumeratorsAndCheckedDisposedAtMostOnce [| |])) true + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.fold" (Seq.fold (+) 0 (countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd [| 1;2;3 |]) ) 6 + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.unfold" (Seq.unfold (fun _ -> None) 1 |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toArray) [| |] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.unfold" (Seq.unfold (fun x -> if x = 1 then Some("a",2) else None) 1 |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toArray) [| "a" |] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.exists" (Seq.exists ((=) "a") (countEnumeratorsAndCheckedDisposedAtMostOnce [| |])) false + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.exists" (Seq.exists ((=) "a") (countEnumeratorsAndCheckedDisposedAtMostOnce [| "a" |])) true + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.exists" (Seq.exists ((=) "a") (countEnumeratorsAndCheckedDisposedAtMostOnce [| "1"; "a" |])) true + do check "" numActiveEnumerators 0 + + + do check "IEnumerableTest.exists" (Seq.forall ((=) "a") (countEnumeratorsAndCheckedDisposedAtMostOnce [| |])) true + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.exists" (Seq.forall ((=) "a") (countEnumeratorsAndCheckedDisposedAtMostOnce [| "a" |])) true + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.exists" (Seq.forall ((=) "a") (countEnumeratorsAndCheckedDisposedAtMostOnce [| "1"; "a" |])) false + do check "" numActiveEnumerators 0 + + do check "IEnumerableTest.map on finite" ([| "a" |] |> Seq.map (fun x -> x.Length) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toArray) [| 1 |] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.filter on finite" ([| "a";"ab";"a" |] |> Seq.filter (fun x -> x.Length = 1) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toArray) [| "a";"a" |] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.choose on finite" ([| "a";"ab";"a" |] |> Seq.choose (fun x -> if x.Length = 1 then Some(x^"a") else None) |> Seq.toArray) [| "aa";"aa" |] + do check "" numActiveEnumerators 0 + do check "Seq.pick on finite (succeeding)" ([| "a";"ab";"a" |] |> countEnumeratorsAndCheckedDisposedAtMostOnce |> Seq.pick (fun x -> if x.Length = 1 then Some(x^"a") else None)) "aa" + do check "" numActiveEnumerators 0 + do check "Seq.tryPick on finite (succeeding)" ([| "a";"ab";"a" |] |> countEnumeratorsAndCheckedDisposedAtMostOnce |> Seq.tryPick (fun x -> if x.Length = 1 then Some(x^"a") else None)) (Some "aa") + do check "" numActiveEnumerators 0 + do check "Seq.tryPick on finite (failing)" ([| "a";"ab";"a" |] |> countEnumeratorsAndCheckedDisposedAtMostOnce |> Seq.tryPick (fun x -> if x.Length = 6 then Some(x^"a") else None)) None + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.find on finite (succeeding)" ([| "a";"ab";"a" |] |> countEnumeratorsAndCheckedDisposedAtMostOnce |> Seq.find (fun x -> x.Length = 1)) "a" + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.find on finite (failing)" (try Some ([| "a";"ab";"a" |] |> countEnumeratorsAndCheckedDisposedAtMostOnce |> Seq.find (fun x -> x.Length = 6)) with :? System.Collections.Generic.KeyNotFoundException -> None) None + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.map_with_type (string up to obj,finite)" ([| "a" |] |> Seq.cast |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toArray) [| ("a" :> obj) |] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.map_with_type (obj down to string, finite)" ([| ("a" :> obj) |] |> Seq.cast |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toArray) [| "a" |] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.append, finite, finite" (Seq.append [| "a" |] [| "b" |] |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toArray) [| "a"; "b" |] + do check "" numActiveEnumerators 0 + + + + do check "IEnumerableTest.concat, finite" (Seq.concat [| [| "a" |]; [| |]; [| "b";"c" |] |] |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toList) [ "a";"b";"c" ] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.init_infinite, then take" (Seq.take 2 (countEnumeratorsAndCheckedDisposedAtMostOnce (Seq.initInfinite (fun i -> i+1))) |> Seq.toList) [ 1;2 ] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.to_array, empty" (Seq.init 0 (fun i -> i+1) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toArray) [| |] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.to_array, small" (Seq.init 1 (fun i -> i+1) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toArray) [| 1 |] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.to_array, large" (Seq.init 100000 (fun i -> i+1) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toArray |> Array.length) 100000 + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.to_array, very large" (Seq.init 1000000 (fun i -> i+1) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toArray |> Array.length) 1000000 + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.to_list, empty" (Seq.init 0 (fun i -> i+1) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toList) [ ] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.to_list, small" (Seq.init 1 (fun i -> i+1) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toList) [ 1 ] + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.to_list, large" (Seq.init 100000 (fun i -> i+1) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toList |> List.length) 100000 + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.to_list, large" (Seq.init 1000000 (fun i -> i+1) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toList |> List.length) 1000000 + do check "" numActiveEnumerators 0 + do check "IEnumerableTest.to_list, large" (Seq.init 1000000 (fun i -> i+1) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> List.ofSeq |> List.length) 1000000 + do check "" numActiveEnumerators 0 + do check "List.unzip, large" (Seq.init 1000000 (fun i -> (i,i+1)) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> List.ofSeq |> List.unzip |> fst |> List.length) 1000000 + do check "" numActiveEnumerators 0 + let dup x = x,x + let uncurry f (x,y) = f x y + + do check "List.zip, large" (Seq.init 1000000 (fun i -> (i,i+1)) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> List.ofSeq |> dup |> uncurry List.zip |> List.length) 1000000 + do check "" numActiveEnumerators 0 + +(* + // Currently disabled, since IStructuralEquatable.Equals will cause this to stack overflow around 140000 elements + do check "List.sort, large" ((Seq.init 140000 (fun i -> 139999 - i) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> List.ofSeq |> List.sort) = + (Seq.init 140000 (fun i -> i) |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> List.ofSeq |> List.sort)) true + do check "" numActiveEnumerators 0 +*) + + do check "Seq.singleton" (Seq.singleton 42 |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.length) 1 + do check "" numActiveEnumerators 0 + do check "Seq.singleton" (Seq.singleton 42 |> countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd |> Seq.toList) [42] + do check "" numActiveEnumerators 0 + + do check "Seq.truncate" (Seq.truncate 20 (countEnumeratorsAndCheckedDisposedAtMostOnce [1..100]) |> Seq.toList) [1..20] + do check "" numActiveEnumerators 0 + do check "Seq.truncate" (Seq.truncate 1 (countEnumeratorsAndCheckedDisposedAtMostOnce [1..100]) |> Seq.toList) [1] + do check "" numActiveEnumerators 0 + do check "Seq.truncate" (Seq.truncate 0 (countEnumeratorsAndCheckedDisposedAtMostOnce [1..100]) |> Seq.toList) [] + do check "" numActiveEnumerators 0 + + do check "Seq.scan" (Seq.scan (+) 0 (countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd [|1..5|]) |> Seq.toArray) [|0; 1; 3; 6; 10; 15|] + do check "" numActiveEnumerators 0 + //do check "Seq.scan1" (Seq.scan1 (+) (countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd [|1..5|]) |> Seq.toArray) [|3; 6; 10; 15|] + //do check "" numActiveEnumerators 0 + + do check "Seq.exists2" (Seq.exists2 (=) (countEnumeratorsAndCheckedDisposedAtMostOnce [|1; 2; 3; 4; 5; 6|]) (countEnumeratorsAndCheckedDisposedAtMostOnce [|2; 3; 4; 5; 6; 6|])) true + do check "" numActiveEnumerators 0 + do check "Seq.exists2" (Seq.exists2 (=) (countEnumeratorsAndCheckedDisposedAtMostOnce [|1; 2; 3; 4; 5; 6|]) (countEnumeratorsAndCheckedDisposedAtMostOnce [|2; 3; 4; 5; 6; 7|])) false + do check "" numActiveEnumerators 0 + + do check "Seq.forall2" (Seq.forall2 (=) (countEnumeratorsAndCheckedDisposedAtMostOnce [|1..10|]) (countEnumeratorsAndCheckedDisposedAtMostOnce [|1..10|])) true + do check "" numActiveEnumerators 0 + do check "Seq.forall2" (Seq.forall2 (=) (countEnumeratorsAndCheckedDisposedAtMostOnce [|1;2;3;4;5|]) (countEnumeratorsAndCheckedDisposedAtMostOnce [|1;2;3;0;5|])) false + do check "" numActiveEnumerators 0 + + + + do check "Seq.tryFind" ([|1..100|] |> countEnumeratorsAndCheckedDisposedAtMostOnce |> Seq.tryFind (fun x -> x > 50)) (Some 51) + do check "" numActiveEnumerators 0 + do check "Seq.tryFind" ([|1..100|] |> countEnumeratorsAndCheckedDisposedAtMostOnce |> Seq.tryFind (fun x -> x > 180)) None + do check "" numActiveEnumerators 0 + + + do check "Seq.compareWith" (Seq.compareWith compare (countEnumeratorsAndCheckedDisposedAtMostOnce [1;2]) (countEnumeratorsAndCheckedDisposedAtMostOnce [2;1])) -1 + do check "" numActiveEnumerators 0 + do check "Seq.compareWith" (Seq.compareWith compare (countEnumeratorsAndCheckedDisposedAtMostOnce [2;1]) (countEnumeratorsAndCheckedDisposedAtMostOnce [1;2])) 1 + do check "" numActiveEnumerators 0 + do check "Seq.compareWith" (Seq.compareWith compare (countEnumeratorsAndCheckedDisposedAtMostOnce [1;2]) (countEnumeratorsAndCheckedDisposedAtMostOnce [1;2])) 0 + do check "" numActiveEnumerators 0 + do check "Seq.compareWith" (Seq.compareWith compare (countEnumeratorsAndCheckedDisposedAtMostOnce []) (countEnumeratorsAndCheckedDisposedAtMostOnce [1;2])) -1 + do check "" numActiveEnumerators 0 + + do check "Seq.collect" (Seq.collect (fun i -> [i*10 .. i*10+9]) (countEnumeratorsAndCheckedDisposedAtMostOnce [0..9]) |> Seq.toList) [0..99] + do check "" numActiveEnumerators 0 + + let c = ref -1 + do Seq.iter2 (fun x y -> incr c; test "Seq.iter2" (c.Value = x && c.Value = y)) (countEnumeratorsAndCheckedDisposedAtMostOnce [0..10]) (countEnumeratorsAndCheckedDisposedAtMostOnce [0..10]) + do check "Seq.iter2" c.Value 10 + do check "" numActiveEnumerators 0 + + do check "Seq.zip" + (Seq.zip [1..10] (countEnumeratorsAndCheckedDisposedAtMostOnce [2..11]) |> Seq.toList) [for i in 1..10 -> i, i+1] + do check "" numActiveEnumerators 0 + + + do check "Seq.zip3" + (Seq.zip3 (countEnumeratorsAndCheckedDisposedAtMostOnce [1..10]) (countEnumeratorsAndCheckedDisposedAtMostOnce [2..11]) (countEnumeratorsAndCheckedDisposedAtMostOnce [3..12]) |> Seq.toList) [for i in 1..10 -> i, i+1, i+2] + do check "" numActiveEnumerators 0 + + do c.Value <- -1 + do Seq.iteri (fun n x -> incr c; test "Seq.iter2" (c.Value = n && c.Value+1 = x)) (countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd [1..11]) + do check "" numActiveEnumerators 0 + do check "Seq.iter2" c.Value 10 + + do check "Seq.pairwise" (Seq.pairwise (countEnumeratorsAndCheckedDisposedAtMostOnce [1..20]) |> Seq.toList) [for i in 1 .. 19 -> i, i+1] + do check "" numActiveEnumerators 0 + + do check "Seq.windowed 1" (Seq.windowed 1 (countEnumeratorsAndCheckedDisposedAtMostOnce [1..20]) |> Seq.toList) [for i in 1 .. 20 -> [|i|]] + do check "" numActiveEnumerators 0 + do check "Seq.windowed 2" (Seq.windowed 2 (countEnumeratorsAndCheckedDisposedAtMostOnce [1..20]) |> Seq.toList) [for i in 1 .. 19 -> [|i; i+1|]] + do check "" numActiveEnumerators 0 + do check "Seq.windowed 3" (Seq.windowed 3 (countEnumeratorsAndCheckedDisposedAtMostOnce [1..20]) |> Seq.toList) [for i in 1 .. 18 -> [|i; i+1; i+2|]] + do check "" numActiveEnumerators 0 + do check "Seq.windowed 4" (Seq.windowed 4 (countEnumeratorsAndCheckedDisposedAtMostOnce [1..20]) |> Seq.toList) [for i in 1 .. 17 -> [|i; i+1; i+2; i+3|]] + do check "" numActiveEnumerators 0 + + let group = Seq.groupBy (fun x -> x % 5) (countEnumeratorsAndCheckedDisposedAtMostOnce [1..100]) + do for n, s in group do + check "Seq.groupBy" (Seq.forall (fun x -> x % 5 = n) s) true; + check "" numActiveEnumerators 0 + done + + let sorted = Seq.sortBy abs (countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd [2; 4; 3; -5; 2; -4; -8; 0; 5; 2]) + do check "Seq.sortBy" (Seq.pairwise sorted |> Seq.forall (fun (x, y) -> abs x <= abs y)) true + do check "" numActiveEnumerators 0 + let counts = Seq.countBy id (countEnumeratorsAndCheckedDisposedAtMostOnce [for i in 1..10 do yield! [10..-1..i] done ]) + do check "Seq.countBy" (counts |> Seq.toList) [for i in 10..-1..1 -> i, i] + do check "" numActiveEnumerators 0 + + do check "Seq.sum" (Seq.sum (countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd [1..100])) (100*101/2) + do check "" numActiveEnumerators 0 + do check "Seq.sumBy" (Seq.sumBy float [1..100]) (100.*101./2.) + do check "" numActiveEnumerators 0 + + do check "Seq.average" (Seq.average (countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd [1.; 2.; 3.])) 2. + do check "" numActiveEnumerators 0 + do check "Seq.averageBy" (Seq.averageBy float (countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd [0..100])) 50. + do check "" numActiveEnumerators 0 + do check "Seq.min" (Seq.min (countEnumeratorsAndCheckedDisposedAtMostOnceAtEnd [1; 4; 2; 5; 8; 4; 0; 3])) 0 + do check "" numActiveEnumerators 0 + do check "Seq.max" (Seq.max (countEnumeratorsAndCheckedDisposedAtMostOnce [1; 4; 2; 5; 8; 4; 0; 3])) 8 + do check "" numActiveEnumerators 0 +#if !NETCOREAPP +// strings don't have enumerators in portable + do check "Seq.minBy" (Seq.minBy int (countEnumeratorsAndCheckedDisposedAtMostOnce "this is a test")) ' ' + do check "" numActiveEnumerators 0 + do check "Seq.maxBy" (Seq.maxBy int (countEnumeratorsAndCheckedDisposedAtMostOnce "this is a test")) 't' + do check "" numActiveEnumerators 0 +#endif + +end + +let (lsr) (a:int) (b:int) = int32 (uint32 a >>> b) +let (lsl) (a:int) (b:int) = a <<< b +let (lor) (a:int) (b:int) = a ||| b +let (lxor) (a:int) (b:int) = a ^^^ b +let (land) (a:int) (b:int) = a &&& b +// check precedence of lsl, lsr etc. +let _ = fun (x:int) -> x > x lsr 1 +let _ = fun (x:int) -> x > (x lsr 1) +let _ = fun (x:int) -> x > x lsl 1 +let _ = fun (x:int) -> x > (x lsl 1) +let _ = fun (x:int) -> x > x lor 1 +let _ = fun (x:int) -> x > (x lor 1) +let _ = fun (x:int) -> x > x lxor 1 +let _ = fun (x:int) -> x > (x lxor 1) +let _ = fun (x:int) -> x > x land 1 +let _ = fun (x:int) -> x > (x land 1) + + +// check ordering of NaN +(* +The predefined floating-point comparison operators are: +bool operator ==(float x, float y); +bool operator ==(double x, double y); +bool operator !=(float x, float y); +bool operator !=(double x, double y); +bool operator <(float x, float y); +bool operator <(double x, double y); +bool operator >(float x, float y); +bool operator >(double x, double y); +bool operator <=(float x, float y); +bool operator <=(double x, double y); +bool operator >=(float x, float y); +bool operator >=(double x, double y); +The operators compare the operands according to the rules of the IEC 60559 standard: +If either operand is NaN, the result is false for all operators except !=, for which the result is true. For +any two operands, x != y always produces the same result as !(x == y). However, when one or both +operands are NaN, the <, >, <=, and >= operators do not produce the same results as the logical negation of +the opposite operator. [Example: If either of x and y is NaN, then x < y is false, but !(x >= y) is true. +end example] +? When neither operand is NaN, the operators compare the values of the two floating-point operands with +respect to the ordering +-inf < ?max < ? < ?min < ?0.0 == +0.0 < +min < ? < +max < +inf +where min and max are the smallest and largest positive finite values that can be represented in the given +floating-point format. Notable effects of this ordering are: +o Negative and positive zeros are considered equal. +o A negative infinity is considered less than all other values, but equal to another negative infinity. +o A positive infinity is considered greater than all other values, but equal to another positive infinity. +*) +open System + +(* ----- NaN tests for DOUBLE ----- *) + +module DoubleNaN = + let nan1 = (let r = ref Double.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0)) + let nan2 = (let r = ref Double.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0)) + + do printf "checking floating point relational operators\n" + let _ = check "d3wiojd30a" ((Double.NaN > Double.NaN)) false + check "d3wiojd30a" (if (Double.NaN > Double.NaN) then "a" else "b") "b" + check "d3wiojd30b" ((Double.NaN >= Double.NaN)) false + check "d3wiojd30b" (if (Double.NaN >= Double.NaN) then "a" else "b") "b" + check "d3wiojd30c" ((Double.NaN < Double.NaN)) false + check "d3wiojd30c" (if (Double.NaN < Double.NaN) then "a" else "b") "b" + check "d3wiojd30d" ((Double.NaN <= Double.NaN)) false + check "d3wiojd30d" (if (Double.NaN <= Double.NaN) then "a" else "b") "b" + check "d3wiojd30e" ((Double.NaN = Double.NaN)) false + check "d3wiojd30e" (if (Double.NaN = Double.NaN) then "a" else "b") "b" + check "d3wiojd30q" ((Double.NaN <> Double.NaN)) true + check "d3wiojd30w" ((Double.NaN > 1.0)) false + check "d3wiojd30e" ((Double.NaN >= 1.0)) false + check "d3wiojd30r" ((Double.NaN < 1.0)) false + check "d3wiojd30t" ((Double.NaN <= 1.0)) false + check "d3wiojd30y" ((Double.NaN = 1.0)) false + check "d3wiojd30u" ((Double.NaN <> 1.0)) true + check "d3wiojd30i" ((1.0 > Double.NaN)) false + check "d3wiojd30o" ((1.0 >= Double.NaN)) false + check "d3wiojd30p" ((1.0 < Double.NaN)) false + check "d3wiojd30a" ((1.0 <= Double.NaN)) false + check "d3wiojd30s" ((1.0 = Double.NaN)) false + check "d3wiojd30d" ((1.0 <> Double.NaN)) true + check "d3wiojd30a" ((nan1 > Double.NaN)) false + check "d3wiojd30b" ((nan1 >= nan2)) false + check "d3wiojd30c" ((nan1 < nan2)) false + check "d3wiojd30d" ((nan1 <= nan2)) false + check "d3wiojd30e" ((nan1 = nan2)) false + check "d3wiojd30q" ((nan1 <> nan2)) true + check "d3wiojd30w" ((nan1 > 1.0)) false + check "d3wiojd30e" ((nan1 >= 1.0)) false + check "d3wiojd30r" ((nan1 < 1.0)) false + check "d3wiojd30t" ((nan1 <= 1.0)) false + check "d3wiojd30y" ((nan1 = 1.0)) false + check "d3wiojd30u" ((nan1 <> 1.0)) true + check "d3wiojd30i" ((1.0 > nan2)) false + check "d3wiojd30o" ((1.0 >= nan2)) false + check "d3wiojd30p" ((1.0 < nan2)) false + check "d3wiojd30a" ((1.0 <= nan2)) false + check "d3wiojd30s" ((1.0 = nan2)) false + check "d3wiojd30d" ((1.0 <> nan2)) true + check "d3wiojd30f" ((Double.NegativeInfinity = Double.NegativeInfinity)) true + check "d3wiojd30g" ((Double.NegativeInfinity < Double.PositiveInfinity)) true + check "d3wiojd30h" ((Double.NegativeInfinity > Double.PositiveInfinity)) false + check "d3wiojd30j" ((Double.NegativeInfinity <= Double.NegativeInfinity)) true + + check "D1nancompare01" (0 = (compare Double.NaN Double.NaN)) true + check "D1nancompare02" (0 = (compare Double.NaN nan1)) true + check "D1nancompare03" (0 = (compare nan1 Double.NaN)) true + check "D1nancompare04" (0 = (compare nan1 nan1)) true + check "D1nancompare05" (1 = (compare 1. Double.NaN)) true + check "D1nancompare06" (1 = (compare 0. Double.NaN)) true + check "D1nancompare07" (1 = (compare -1. Double.NaN)) true + check "D1nancompare08" (1 = (compare Double.NegativeInfinity Double.NaN)) true + check "D1nancompare09" (1 = (compare Double.PositiveInfinity Double.NaN)) true + check "D1nancompare10" (1 = (compare Double.MaxValue Double.NaN)) true + check "D1nancompare11" (1 = (compare Double.MinValue Double.NaN)) true + check "D1nancompare12" (-1 = (compare Double.NaN 1.)) true + check "D1nancompare13" (-1 = (compare Double.NaN 0.)) true + check "D1nancompare14" (-1 = (compare Double.NaN -1.)) true + check "D1nancompare15" (-1 = (compare Double.NaN Double.NegativeInfinity)) true + check "D1nancompare16" (-1 = (compare Double.NaN Double.PositiveInfinity)) true + check "D1nancompare17" (-1 = (compare Double.NaN Double.MaxValue)) true + check "D1nancompare18" (-1 = (compare Double.NaN Double.MinValue)) true + +module DoubleNaNNonStructuralComparison1 = + open NonStructuralComparison + let nan1 = (let r = ref Double.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0)) + let nan2 = (let r = ref Double.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0)) + + check "d3wiojd30a" (if (Double.NaN > Double.NaN) then "a" else "b") "b" + check "d3wiojd30b" ((Double.NaN >= Double.NaN)) false + check "d3wiojd30b" (if (Double.NaN >= Double.NaN) then "a" else "b") "b" + check "d3wiojd30c" ((Double.NaN < Double.NaN)) false + check "d3wiojd30c" (if (Double.NaN < Double.NaN) then "a" else "b") "b" + check "d3wiojd30d" ((Double.NaN <= Double.NaN)) false + check "d3wiojd30d" (if (Double.NaN <= Double.NaN) then "a" else "b") "b" + check "d3wiojd30e" ((Double.NaN = Double.NaN)) false + check "d3wiojd30e" (if (Double.NaN = Double.NaN) then "a" else "b") "b" + check "d3wiojd30q" ((Double.NaN <> Double.NaN)) true + check "d3wiojd30w" ((Double.NaN > 1.0)) false + check "d3wiojd30e" ((Double.NaN >= 1.0)) false + check "d3wiojd30r" ((Double.NaN < 1.0)) false + check "d3wiojd30t" ((Double.NaN <= 1.0)) false + check "d3wiojd30y" ((Double.NaN = 1.0)) false + check "d3wiojd30u" ((Double.NaN <> 1.0)) true + check "d3wiojd30i" ((1.0 > Double.NaN)) false + check "d3wiojd30o" ((1.0 >= Double.NaN)) false + check "d3wiojd30p" ((1.0 < Double.NaN)) false + check "d3wiojd30a" ((1.0 <= Double.NaN)) false + check "d3wiojd30s" ((1.0 = Double.NaN)) false + check "d3wiojd30d" ((1.0 <> Double.NaN)) true + check "d3wiojd30a" ((nan1 > Double.NaN)) false + check "d3wiojd30b" ((nan1 >= nan2)) false + check "d3wiojd30c" ((nan1 < nan2)) false + check "d3wiojd30d" ((nan1 <= nan2)) false + check "d3wiojd30e" ((nan1 = nan2)) false + check "d3wiojd30q" ((nan1 <> nan2)) true + check "d3wiojd30w" ((nan1 > 1.0)) false + check "d3wiojd30e" ((nan1 >= 1.0)) false + check "d3wiojd30r" ((nan1 < 1.0)) false + check "d3wiojd30t" ((nan1 <= 1.0)) false + check "d3wiojd30y" ((nan1 = 1.0)) false + check "d3wiojd30u" ((nan1 <> 1.0)) true + check "d3wiojd30i" ((1.0 > nan2)) false + check "d3wiojd30o" ((1.0 >= nan2)) false + check "d3wiojd30p" ((1.0 < nan2)) false + check "d3wiojd30a" ((1.0 <= nan2)) false + check "d3wiojd30s" ((1.0 = nan2)) false + check "d3wiojd30d" ((1.0 <> nan2)) true + check "d3wiojd30f" ((Double.NegativeInfinity = Double.NegativeInfinity)) true + check "d3wiojd30g" ((Double.NegativeInfinity < Double.PositiveInfinity)) true + check "d3wiojd30h" ((Double.NegativeInfinity > Double.PositiveInfinity)) false + check "d3wiojd30j" ((Double.NegativeInfinity <= Double.NegativeInfinity)) true + + check "D2nancompare01" (0 = (compare Double.NaN Double.NaN)) true + check "D2nancompare02" (0 = (compare Double.NaN nan1)) true + check "D2nancompare03" (0 = (compare nan1 Double.NaN)) true + check "D2nancompare04" (0 = (compare nan1 nan1)) true + check "D2nancompare05" (1 = (compare 1. Double.NaN)) true + check "D2nancompare06" (1 = (compare 0. Double.NaN)) true + check "D2nancompare07" (1 = (compare -1. Double.NaN)) true + check "D2nancompare08" (1 = (compare Double.NegativeInfinity Double.NaN)) true + check "D2nancompare09" (1 = (compare Double.PositiveInfinity Double.NaN)) true + check "D2nancompare10" (1 = (compare Double.MaxValue Double.NaN)) true + check "D2nancompare11" (1 = (compare Double.MinValue Double.NaN)) true + check "D2nancompare12" (-1 = (compare Double.NaN 1.)) true + check "D2nancompare13" (-1 = (compare Double.NaN 0.)) true + check "D2nancompare14" (-1 = (compare Double.NaN -1.)) true + check "D2nancompare15" (-1 = (compare Double.NaN Double.NegativeInfinity)) true + check "D2nancompare16" (-1 = (compare Double.NaN Double.PositiveInfinity)) true + check "D2nancompare17" (-1 = (compare Double.NaN Double.MaxValue)) true + check "D2nancompare18" (-1 = (compare Double.NaN Double.MinValue)) true + +module DoubleNaNStructured = + type www = W of float + let nan1 = (let r = ref Double.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0)) + let nan2 = (let r = ref Double.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0)) + + do printf "checking floating point relational operators on structured data\n" + // NOTE: SPECIFICATION: The relational operators work differently when applied to + // floats embedded in structured data than when applied to raw floats. + + let _ = check "d3wiojd31q" ((W Double.NaN > W Double.NaN)) false + let _ = check "d3wiojd31w" ((W Double.NaN >= W Double.NaN)) false + let _ = check "d3wiojd31e" ((W Double.NaN < W Double.NaN)) false + let _ = check "d3wiojd31r" ((W Double.NaN <= W Double.NaN)) false + let _ = check "d3wiojd31ty" ((W Double.NaN = W Double.NaN)) false + let _ = check "d3wiojd31y" ((W Double.NaN <> W Double.NaN)) true + let _ = check "d3wiojd31dy" (0 = compare (W Double.NaN) (W Double.NaN)) true + let _ = check "d3wiojd31u" ((W Double.NaN > W 1.0)) false + let _ = check "d3wiojd31i" ((W Double.NaN >= W 1.0)) false + let _ = check "d3wiojd31o" ((W Double.NaN < W 1.0)) false + let _ = check "d3wiojd31p" ((W Double.NaN <= W 1.0)) false + let _ = check "d3wiojd31a" ((W Double.NaN = W 1.0)) false + let _ = check "d3wiojd31s" ((W Double.NaN <> W 1.0)) true + let _ = check "d3wiojd31d" ((W 1.0 > W Double.NaN)) false + let _ = check "d3wiojd31f" ((W 1.0 >= W Double.NaN)) false + let _ = check "d3wiojd31g" ((W 1.0 < W Double.NaN)) false + let _ = check "d3wiojd31h" ((W 1.0 <= W Double.NaN)) false + let _ = check "d3wiojd31j" ((W 1.0 = W Double.NaN)) false + let _ = check "d3wiojd31k" ((W 1.0 <> W Double.NaN)) true + let _ = check "d3wiojd31l" ((W Double.NegativeInfinity = W Double.NegativeInfinity)) true + let _ = check "d3wiojd31c" ((W Double.NegativeInfinity < W Double.PositiveInfinity)) true + let _ = check "d3wiojd3xx" ((W Double.NegativeInfinity > W Double.PositiveInfinity)) false + let _ = check "d3wiojd31z" ((W Double.NegativeInfinity <= W Double.NegativeInfinity)) true + + let _ = check "D3nancompare01" (0 = (compare (W Double.NaN) (W Double.NaN))) true + let _ = check "D3nancompare02" (0 = (compare (W Double.NaN) (W nan1))) true + let _ = check "D3nancompare03" (0 = (compare (W nan1) (W Double.NaN))) true + let _ = check "D3nancompare04" (0 = (compare (W nan1) (W nan1))) true + let _ = check "D3nancompare05" (1 = (compare (W 1.) (W Double.NaN))) true + let _ = check "D3nancompare06" (1 = (compare (W 0.) (W Double.NaN))) true + let _ = check "D3nancompare07" (1 = (compare (W -1.) (W Double.NaN))) true + let _ = check "D3nancompare08" (1 = (compare (W Double.NegativeInfinity) (W Double.NaN))) true + let _ = check "D3nancompare09" (1 = (compare (W Double.PositiveInfinity) (W Double.NaN))) true + let _ = check "D3nancompare10" (1 = (compare (W Double.MaxValue) (W Double.NaN))) true + let _ = check "D3nancompare11" (1 = (compare (W Double.MinValue) (W Double.NaN))) true + let _ = check "D3nancompare12" (-1 = (compare (W Double.NaN) (W 1.))) true + let _ = check "D3nancompare13" (-1 = (compare (W Double.NaN) (W 0.))) true + let _ = check "D3nancompare14" (-1 = (compare (W Double.NaN) (W -1.))) true + let _ = check "D3nancompare15" (-1 = (compare (W Double.NaN) (W Double.NegativeInfinity))) true + let _ = check "D3nancompare16" (-1 = (compare (W Double.NaN) (W Double.PositiveInfinity))) true + let _ = check "D3nancompare17" (-1 = (compare (W Double.NaN) (W Double.MaxValue))) true + let _ = check "D3nancompare18" (-1 = (compare (W Double.NaN) (W Double.MinValue))) true + +module DoubleNaNStructuredPoly = + type 'a www = W of 'a + let nan1 = (let r = ref Double.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0)) + let nan2 = (let r = ref Double.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0)) + do printf "checking floating point relational operators on polymorphic structured data\n" + + let _ = check "d3wiojd32q" ((W Double.NaN > W Double.NaN)) false + let _ = check "d3wiojd32w" ((W Double.NaN >= W Double.NaN)) false + let _ = check "d3wiojd32e" ((W Double.NaN < W Double.NaN)) false + let _ = check "d3wiojd32r" ((W Double.NaN <= W Double.NaN)) false + let _ = check "d3wiojd32t" ((W Double.NaN = W Double.NaN)) false + let _ = check "d3wiojd32dt" ((W Double.NaN).Equals(W Double.NaN)) true + let _ = check "d3wiojd32y" ((W Double.NaN <> W Double.NaN)) true + let _ = check "d3wiojd32u" ((W Double.NaN > W 1.0)) false + let _ = check "d3wiojd32i" ((W Double.NaN >= W 1.0)) false + let _ = check "d3wiojd32o" ((W Double.NaN < W 1.0)) false + let _ = check "d3wiojd32p" ((W Double.NaN <= W 1.0)) false + let _ = check "d3wiojd32a" ((W Double.NaN = W 1.0)) false + let _ = check "d3wiojd32s" ((W Double.NaN <> W 1.0)) true + let _ = check "d3wiojd32d" ((W 1.0 > W Double.NaN)) false + let _ = check "d3wiojd32f" ((W 1.0 >= W Double.NaN)) false + let _ = check "d3wiojd32g" ((W 1.0 < W Double.NaN)) false + let _ = check "d3wiojd32h" ((W 1.0 <= W Double.NaN)) false + let _ = check "d3wiojd32j" ((W 1.0 = W Double.NaN)) false + let _ = check "d3wiojd32k" ((W 1.0 <> W Double.NaN)) true + let _ = check "d3wiojd32l" ((W Double.NegativeInfinity = W Double.NegativeInfinity)) true + let _ = check "d3wiojd32z" ((W Double.NegativeInfinity < W Double.PositiveInfinity)) true + let _ = check "d3wiojd32x" ((W Double.NegativeInfinity > W Double.PositiveInfinity)) false + let _ = check "d3wiojd32c" ((W Double.NegativeInfinity <= W Double.NegativeInfinity)) true + + let _ = check "D4nancompare01" (0 = (compare (W Double.NaN) (W Double.NaN))) true + let _ = check "D4nancompare02" (0 = (compare (W Double.NaN) (W nan1))) true + let _ = check "D4nancompare03" (0 = (compare (W nan1) (W Double.NaN))) true + let _ = check "D4nancompare04" (0 = (compare (W nan1) (W nan1))) true + let _ = check "D4nancompare05" (1 = (compare (W 1.) (W Double.NaN))) true + let _ = check "D4nancompare06" (1 = (compare (W 0.) (W Double.NaN))) true + let _ = check "D4nancompare07" (1 = (compare (W -1.) (W Double.NaN))) true + let _ = check "D4nancompare08" (1 = (compare (W Double.NegativeInfinity) (W Double.NaN))) true + let _ = check "D4nancompare09" (1 = (compare (W Double.PositiveInfinity) (W Double.NaN))) true + let _ = check "D4nancompare10" (1 = (compare (W Double.MaxValue) (W Double.NaN))) true + let _ = check "D4nancompare11" (1 = (compare (W Double.MinValue) (W Double.NaN))) true + let _ = check "D4nancompare12" (-1 = (compare (W Double.NaN) (W 1.))) true + let _ = check "D4nancompare13" (-1 = (compare (W Double.NaN) (W 0.))) true + let _ = check "D4nancompare14" (-1 = (compare (W Double.NaN) (W -1.))) true + let _ = check "D4nancompare15" (-1 = (compare (W Double.NaN) (W Double.NegativeInfinity))) true + let _ = check "D4nancompare16" (-1 = (compare (W Double.NaN) (W Double.PositiveInfinity))) true + let _ = check "D4nancompare17" (-1 = (compare (W Double.NaN) (W Double.MaxValue))) true + let _ = check "D4nancompare18" (-1 = (compare (W Double.NaN) (W Double.MinValue))) true + +(* ----- NaN tests for SINGLE ----- *) + +module SingleNaN = + let nan1 = (let r = ref Single.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0f)) + let nan2 = (let r = ref Single.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0f)) + + do printf "checking floating point relational operators\n" + let _ = check "d3wiojd30a" ((Single.NaN > Single.NaN)) false + check "d3wiojd30a" (if (Single.NaN > Single.NaN) then "a" else "b") "b" + check "d3wiojd30b" ((Single.NaN >= Single.NaN)) false + check "d3wiojd30b" (if (Single.NaN >= Single.NaN) then "a" else "b") "b" + check "d3wiojd30c" ((Single.NaN < Single.NaN)) false + check "d3wiojd30c" (if (Single.NaN < Single.NaN) then "a" else "b") "b" + check "d3wiojd30d" ((Single.NaN <= Single.NaN)) false + check "d3wiojd30d" (if (Single.NaN <= Single.NaN) then "a" else "b") "b" + check "d3wiojd30e" ((Single.NaN = Single.NaN)) false + check "d3wiojd30e" (if (Single.NaN = Single.NaN) then "a" else "b") "b" + check "d3wiojd30q" ((Single.NaN <> Single.NaN)) true + check "d3wiojd30w" ((Single.NaN > 1.0f)) false + check "d3wiojd30e" ((Single.NaN >= 1.0f)) false + check "d3wiojd30r" ((Single.NaN < 1.0f)) false + check "d3wiojd30t" ((Single.NaN <= 1.0f)) false + check "d3wiojd30y" ((Single.NaN = 1.0f)) false + check "d3wiojd30u" ((Single.NaN <> 1.0f)) true + check "d3wiojd30i" ((1.0f > Single.NaN)) false + check "d3wiojd30o" ((1.0f >= Single.NaN)) false + check "d3wiojd30p" ((1.0f < Single.NaN)) false + check "d3wiojd30a" ((1.0f <= Single.NaN)) false + check "d3wiojd30s" ((1.0f = Single.NaN)) false + check "d3wiojd30d" ((1.0f <> Single.NaN)) true + check "d3wiojd30a" ((nan1 > Single.NaN)) false + check "d3wiojd30b" ((nan1 >= nan2)) false + check "d3wiojd30c" ((nan1 < nan2)) false + check "d3wiojd30d" ((nan1 <= nan2)) false + check "d3wiojd30e" ((nan1 = nan2)) false + check "d3wiojd30q" ((nan1 <> nan2)) true + check "d3wiojd30w" ((nan1 > 1.0f)) false + check "d3wiojd30e" ((nan1 >= 1.0f)) false + check "d3wiojd30r" ((nan1 < 1.0f)) false + check "d3wiojd30t" ((nan1 <= 1.0f)) false + check "d3wiojd30y" ((nan1 = 1.0f)) false + check "d3wiojd30u" ((nan1 <> 1.0f)) true + check "d3wiojd30i" ((1.0f > nan2)) false + check "d3wiojd30o" ((1.0f >= nan2)) false + check "d3wiojd30p" ((1.0f < nan2)) false + check "d3wiojd30a" ((1.0f <= nan2)) false + check "d3wiojd30s" ((1.0f = nan2)) false + check "d3wiojd30d" ((1.0f <> nan2)) true + check "d3wiojd30f" ((Single.NegativeInfinity = Single.NegativeInfinity)) true + check "d3wiojd30g" ((Single.NegativeInfinity < Single.PositiveInfinity)) true + check "d3wiojd30h" ((Single.NegativeInfinity > Single.PositiveInfinity)) false + check "d3wiojd30j" ((Single.NegativeInfinity <= Single.NegativeInfinity)) true + + check "S1nancompare01" (0 = (compare Single.NaN Single.NaN)) true + check "S1nancompare02" (0 = (compare Single.NaN nan1)) true + check "S1nancompare03" (0 = (compare nan1 Single.NaN)) true + check "S1nancompare04" (0 = (compare nan1 nan1)) true + check "S1nancompare05" (1 = (compare 1.f Single.NaN)) true + check "S1nancompare06" (1 = (compare 0.f Single.NaN)) true + check "S1nancompare07" (1 = (compare -1.f Single.NaN)) true + check "S1nancompare08" (1 = (compare Single.NegativeInfinity Single.NaN)) true + check "S1nancompare09" (1 = (compare Single.PositiveInfinity Single.NaN)) true + check "S1nancompare10" (1 = (compare Single.MaxValue Single.NaN)) true + check "S1nancompare11" (1 = (compare Single.MinValue Single.NaN)) true + check "S1nancompare12" (-1 = (compare Single.NaN 1.f)) true + check "S1nancompare13" (-1 = (compare Single.NaN 0.f)) true + check "S1nancompare14" (-1 = (compare Single.NaN -1.f)) true + check "S1nancompare15" (-1 = (compare Single.NaN Single.NegativeInfinity)) true + check "S1nancompare16" (-1 = (compare Single.NaN Single.PositiveInfinity)) true + check "S1nancompare17" (-1 = (compare Single.NaN Single.MaxValue)) true + check "S1nancompare18" (-1 = (compare Single.NaN Single.MinValue)) true + +module SingleNaNNonStructuralComparison1 = + open NonStructuralComparison + + let nan1 = (let r = ref Single.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0f)) + let nan2 = (let r = ref Single.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0f)) + + check "d3wiojd30a" (if (Single.NaN > Single.NaN) then "a" else "b") "b" + check "d3wiojd30b" ((Single.NaN >= Single.NaN)) false + check "d3wiojd30b" (if (Single.NaN >= Single.NaN) then "a" else "b") "b" + check "d3wiojd30c" ((Single.NaN < Single.NaN)) false + check "d3wiojd30c" (if (Single.NaN < Single.NaN) then "a" else "b") "b" + check "d3wiojd30d" ((Single.NaN <= Single.NaN)) false + check "d3wiojd30d" (if (Single.NaN <= Single.NaN) then "a" else "b") "b" + check "d3wiojd30e" ((Single.NaN = Single.NaN)) false + check "d3wiojd30e" (if (Single.NaN = Single.NaN) then "a" else "b") "b" + check "d3wiojd30q" ((Single.NaN <> Single.NaN)) true + check "d3wiojd30w" ((Single.NaN > 1.0f)) false + check "d3wiojd30e" ((Single.NaN >= 1.0f)) false + check "d3wiojd30r" ((Single.NaN < 1.0f)) false + check "d3wiojd30t" ((Single.NaN <= 1.0f)) false + check "d3wiojd30y" ((Single.NaN = 1.0f)) false + check "d3wiojd30u" ((Single.NaN <> 1.0f)) true + check "d3wiojd30i" ((1.0f > Single.NaN)) false + check "d3wiojd30o" ((1.0f >= Single.NaN)) false + check "d3wiojd30p" ((1.0f < Single.NaN)) false + check "d3wiojd30a" ((1.0f <= Single.NaN)) false + check "d3wiojd30s" ((1.0f = Single.NaN)) false + check "d3wiojd30d" ((1.0f <> Single.NaN)) true + check "d3wiojd30a" ((nan1 > Single.NaN)) false + check "d3wiojd30b" ((nan1 >= nan2)) false + check "d3wiojd30c" ((nan1 < nan2)) false + check "d3wiojd30d" ((nan1 <= nan2)) false + check "d3wiojd30e" ((nan1 = nan2)) false + check "d3wiojd30q" ((nan1 <> nan2)) true + check "d3wiojd30w" ((nan1 > 1.0f)) false + check "d3wiojd30e" ((nan1 >= 1.0f)) false + check "d3wiojd30r" ((nan1 < 1.0f)) false + check "d3wiojd30t" ((nan1 <= 1.0f)) false + check "d3wiojd30y" ((nan1 = 1.0f)) false + check "d3wiojd30u" ((nan1 <> 1.0f)) true + check "d3wiojd30i" ((1.0f > nan2)) false + check "d3wiojd30o" ((1.0f >= nan2)) false + check "d3wiojd30p" ((1.0f < nan2)) false + check "d3wiojd30a" ((1.0f <= nan2)) false + check "d3wiojd30s" ((1.0f = nan2)) false + check "d3wiojd30d" ((1.0f <> nan2)) true + check "d3wiojd30f" ((Single.NegativeInfinity = Single.NegativeInfinity)) true + check "d3wiojd30g" ((Single.NegativeInfinity < Single.PositiveInfinity)) true + check "d3wiojd30h" ((Single.NegativeInfinity > Single.PositiveInfinity)) false + check "d3wiojd30j" ((Single.NegativeInfinity <= Single.NegativeInfinity)) true + + check "S2nancompare01" (0 = (compare Single.NaN Single.NaN)) true + check "S2nancompare02" (0 = (compare Single.NaN nan1)) true + check "S2nancompare03" (0 = (compare nan1 Single.NaN)) true + check "S2nancompare04" (0 = (compare nan1 nan1)) true + check "S2nancompare05" (1 = (compare 1.f Single.NaN)) true + check "S2nancompare06" (1 = (compare 0.f Single.NaN)) true + check "S2nancompare07" (1 = (compare -1.f Single.NaN)) true + check "S2nancompare08" (1 = (compare Single.NegativeInfinity Single.NaN)) true + check "S2nancompare09" (1 = (compare Single.PositiveInfinity Single.NaN)) true + check "S2nancompare10" (1 = (compare Single.MaxValue Single.NaN)) true + check "S2nancompare11" (1 = (compare Single.MinValue Single.NaN)) true + check "S2nancompare12" (-1 = (compare Single.NaN 1.f)) true + check "S2nancompare13" (-1 = (compare Single.NaN 0.f)) true + check "S2nancompare14" (-1 = (compare Single.NaN -1.f)) true + check "S2nancompare15" (-1 = (compare Single.NaN Single.NegativeInfinity)) true + check "S2nancompare16" (-1 = (compare Single.NaN Single.PositiveInfinity)) true + check "S2nancompare17" (-1 = (compare Single.NaN Single.MaxValue)) true + check "S2nancompare18" (-1 = (compare Single.NaN Single.MinValue)) true + +module SingleNaNStructured = + type www = W of single + + let nan1 = (let r = ref Single.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0f)) + let nan2 = (let r = ref Single.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0f)) + + do printf "checking floating point relational operators on structured data\n" + // NOTE: SPECIFICATION: The relational operators work differently when applied to + // floats embedded in structured data than when applied to raw floats. + + let _ = check "d3wiojd31q" ((W Single.NaN > W Single.NaN)) false + let _ = check "d3wiojd31w" ((W Single.NaN >= W Single.NaN)) false + let _ = check "d3wiojd31e" ((W Single.NaN < W Single.NaN)) false + let _ = check "d3wiojd31r" ((W Single.NaN <= W Single.NaN)) false + let _ = check "d3wiojd31ty" ((W Single.NaN = W Single.NaN)) false + let _ = check "d3wiojd31y" ((W Single.NaN <> W Single.NaN)) true + let _ = check "d3wiojd31dy" (0 = compare (W Single.NaN) (W Single.NaN)) true + let _ = check "d3wiojd31u" ((W Single.NaN > W 1.0f)) false + let _ = check "d3wiojd31i" ((W Single.NaN >= W 1.0f)) false + let _ = check "d3wiojd31o" ((W Single.NaN < W 1.0f)) false + let _ = check "d3wiojd31p" ((W Single.NaN <= W 1.0f)) false + let _ = check "d3wiojd31a" ((W Single.NaN = W 1.0f)) false + let _ = check "d3wiojd31s" ((W Single.NaN <> W 1.0f)) true + let _ = check "d3wiojd31d" ((W 1.0f > W Single.NaN)) false + let _ = check "d3wiojd31f" ((W 1.0f >= W Single.NaN)) false + let _ = check "d3wiojd31g" ((W 1.0f < W Single.NaN)) false + let _ = check "d3wiojd31h" ((W 1.0f <= W Single.NaN)) false + let _ = check "d3wiojd31j" ((W 1.0f = W Single.NaN)) false + let _ = check "d3wiojd31k" ((W 1.0f <> W Single.NaN)) true + let _ = check "d3wiojd31l" ((W Single.NegativeInfinity = W Single.NegativeInfinity)) true + let _ = check "d3wiojd31c" ((W Single.NegativeInfinity < W Single.PositiveInfinity)) true + let _ = check "d3wiojd3xx" ((W Single.NegativeInfinity > W Single.PositiveInfinity)) false + let _ = check "d3wiojd31z" ((W Single.NegativeInfinity <= W Single.NegativeInfinity)) true + + let _ = check "S3nancompare01" (0 = (compare (W Single.NaN) (W Single.NaN))) true + let _ = check "S3nancompare02" (0 = (compare (W Single.NaN) (W nan1))) true + let _ = check "S3nancompare03" (0 = (compare (W nan1) (W Single.NaN))) true + let _ = check "S3nancompare04" (0 = (compare (W nan1) (W nan1))) true + let _ = check "S3nancompare05" (1 = (compare (W 1.f) (W Single.NaN))) true + let _ = check "S3nancompare06" (1 = (compare (W 0.f) (W Single.NaN))) true + let _ = check "S3nancompare07" (1 = (compare (W -1.f) (W Single.NaN))) true + let _ = check "S3nancompare08" (1 = (compare (W Single.NegativeInfinity) (W Single.NaN))) true + let _ = check "S3nancompare09" (1 = (compare (W Single.PositiveInfinity) (W Single.NaN))) true + let _ = check "S3nancompare10" (1 = (compare (W Single.MaxValue) (W Single.NaN))) true + let _ = check "S3nancompare11" (1 = (compare (W Single.MinValue) (W Single.NaN))) true + let _ = check "S3nancompare12" (-1 = (compare (W Single.NaN) (W 1.f))) true + let _ = check "S3nancompare13" (-1 = (compare (W Single.NaN) (W 0.f))) true + let _ = check "S3nancompare14" (-1 = (compare (W Single.NaN) (W -1.f))) true + let _ = check "S3nancompare15" (-1 = (compare (W Single.NaN) (W Single.NegativeInfinity))) true + let _ = check "S3nancompare16" (-1 = (compare (W Single.NaN) (W Single.PositiveInfinity))) true + let _ = check "S3nancompare17" (-1 = (compare (W Single.NaN) (W Single.MaxValue))) true + let _ = check "S3nancompare18" (-1 = (compare (W Single.NaN) (W Single.MinValue))) true + +module SingleNaNStructuredPoly = + type 'a www = W of 'a + + let nan1 = (let r = ref Single.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0f)) + let nan2 = (let r = ref Single.NaN in (if sprintf "Hello" = "Hello" then !r else 0.0f)) + + do printf "checking floating point relational operators on polymorphic structured data\n" + + let _ = check "d3wiojd32q" ((W Single.NaN > W Single.NaN)) false + let _ = check "d3wiojd32w" ((W Single.NaN >= W Single.NaN)) false + let _ = check "d3wiojd32e" ((W Single.NaN < W Single.NaN)) false + let _ = check "d3wiojd32r" ((W Single.NaN <= W Single.NaN)) false + let _ = check "d3wiojd32t" ((W Single.NaN = W Single.NaN)) false + let _ = check "d3wiojd32dt" ((W Single.NaN).Equals(W Single.NaN)) true + let _ = check "d3wiojd32y" ((W Single.NaN <> W Single.NaN)) true + let _ = check "d3wiojd32u" ((W Single.NaN > W 1.0f)) false + let _ = check "d3wiojd32i" ((W Single.NaN >= W 1.0f)) false + let _ = check "d3wiojd32o" ((W Single.NaN < W 1.0f)) false + let _ = check "d3wiojd32p" ((W Single.NaN <= W 1.0f)) false + let _ = check "d3wiojd32a" ((W Single.NaN = W 1.0f)) false + let _ = check "d3wiojd32s" ((W Single.NaN <> W 1.0f)) true + let _ = check "d3wiojd32d" ((W 1.0f > W Single.NaN)) false + let _ = check "d3wiojd32f" ((W 1.0f >= W Single.NaN)) false + let _ = check "d3wiojd32g" ((W 1.0f < W Single.NaN)) false + let _ = check "d3wiojd32h" ((W 1.0f <= W Single.NaN)) false + let _ = check "d3wiojd32j" ((W 1.0f = W Single.NaN)) false + let _ = check "d3wiojd32k" ((W 1.0f <> W Single.NaN)) true + let _ = check "d3wiojd32l" ((W Single.NegativeInfinity = W Single.NegativeInfinity)) true + let _ = check "d3wiojd32z" ((W Single.NegativeInfinity < W Single.PositiveInfinity)) true + let _ = check "d3wiojd32x" ((W Single.NegativeInfinity > W Single.PositiveInfinity)) false + let _ = check "d3wiojd32c" ((W Single.NegativeInfinity <= W Single.NegativeInfinity)) true + + let _ = check "S4nancompare01" (0 = (compare (W Single.NaN) (W Single.NaN))) true + let _ = check "S4nancompare02" (0 = (compare (W Single.NaN) (W nan1))) true + let _ = check "S4nancompare03" (0 = (compare (W nan1) (W Single.NaN))) true + let _ = check "S4nancompare04" (0 = (compare (W nan1) (W nan1))) true + let _ = check "S4nancompare05" (1 = (compare (W 1.f) (W Single.NaN))) true + let _ = check "S4nancompare06" (1 = (compare (W 0.f) (W Single.NaN))) true + let _ = check "S4nancompare07" (1 = (compare (W -1.f) (W Single.NaN))) true + let _ = check "S4nancompare08" (1 = (compare (W Single.NegativeInfinity) (W Single.NaN))) true + let _ = check "S4nancompare09" (1 = (compare (W Single.PositiveInfinity) (W Single.NaN))) true + let _ = check "S4nancompare10" (1 = (compare (W Single.MaxValue) (W Single.NaN))) true + let _ = check "S4nancompare11" (1 = (compare (W Single.MinValue) (W Single.NaN))) true + let _ = check "S4nancompare12" (-1 = (compare (W Single.NaN) (W 1.f))) true + let _ = check "S4nancompare13" (-1 = (compare (W Single.NaN) (W 0.f))) true + let _ = check "S4nancompare14" (-1 = (compare (W Single.NaN) (W -1.f))) true + let _ = check "S4nancompare15" (-1 = (compare (W Single.NaN) (W Single.NegativeInfinity))) true + let _ = check "S4nancompare16" (-1 = (compare (W Single.NaN) (W Single.PositiveInfinity))) true + let _ = check "S4nancompare17" (-1 = (compare (W Single.NaN) (W Single.MaxValue))) true + let _ = check "S4nancompare18" (-1 = (compare (W Single.NaN) (W Single.MinValue))) true + +module MoreStructuralEqHashCompareNaNChecks = + let test398275413() = + let floats = [1.0; 0.0; System.Double.NaN; System.Double.NegativeInfinity; System.Double.PositiveInfinity; nan] in + for x in floats do + for y in floats do + let xnan = System.Double.IsNaN(x) in + let ynan = System.Double.IsNaN(y) in + let test1 x y op b = if not b then (printfn "\n****failure on %A %s %A\n" x op y; reportFailure "unlabelled test") in + if (xnan && not(ynan)) || (ynan && not(xnan)) then ( + + let testEq x y = + test1 x y "=" ((x = y) = false); + test1 x y "<>" ((x <> y) = true) in + let testRel x y = + test1 x y "<" ((x < y) = false ); + test1 x y ">" ((x > y) = false ); + test1 x y ">=" ((x >= y) = false); + test1 x y "<=" ((x <= y) = false) in + testEq x y; + testEq [x] [y]; + testEq [| x |] [| y |]; + testEq (x,x) (y,y); + testEq (x,1) (y,1); + testEq (1,x) (1,y); + + testRel x y; + + testRel [x] [y]; + testRel [| x |] [| y |]; + testRel (x,x) (y,y); + testRel (x,1) (y,1); + testRel (1,x) (1,y); + ); + if xnan && ynan then + test1 x y "compare" ((compare x y) = 0) + done + done + + let _ = test398275413() + + let test398275414() = + let floats = [1.0f; 0.0f; System.Single.NaN; System.Single.NegativeInfinity; System.Single.PositiveInfinity; nanf] in + for x in floats do + for y in floats do + let xnan = System.Single.IsNaN(x) in + let ynan = System.Single.IsNaN(y) in + let test1 x y op b = if not b then (printfn "\n****failure on %A %s %A\n" x op y; reportFailure "unlabelled test") in + if (xnan && not(ynan)) || (ynan && not(xnan)) then ( + + let testEq x y = + test1 x y "=" ((x = y) = false); + test1 x y "<>" ((x <> y) = true) in + let testRel x y = + test1 x y "<" ((x < y) = false ); + test1 x y ">" ((x > y) = false ); + test1 x y ">=" ((x >= y) = false); + test1 x y "<=" ((x <= y) = false) in + testEq x y; + testEq [x] [y]; + testEq [| x |] [| y |]; + testEq (x,x) (y,y); + testEq (x,1) (y,1); + testEq (1,x) (1,y); + + testRel x y; + + testRel [x] [y]; + testRel [| x |] [| y |]; + testRel (x,x) (y,y); + testRel (x,1) (y,1); + testRel (1,x) (1,y); + ); + if xnan && ynan then + test1 x y "compare" ((compare x y) = 0) + done + done + + let _ = test398275414() + + type A<'a,'b> = {h : 'a ; w : 'b} + type C<'T> = {n : string ; s : 'T} + type D = {x : float ; y : float} + type D2 = {x2 : float32 ; y2 : float32} + exception E of float + exception E2 of float32 + type F = | F of float + type F2 = | F2 of float32 + + // Test ER semantics for obj.Equals and PER semantics for (=) + let test398275415() = + + let l1 = [nan; 1.0] in + let l2 = [nan; 1.0] in + + let a1 = [|nan; 1.0|] in + let a2 = [|nan; 1.0|] in + + let t1 = (nan, 1.0) in + let t2 = (nan, 1.0) in + + let d1 = {x=1.0;y=nan} in + let d2 = {x=1.0;y=nan} in + + let e1 = E nan in + let e2 = E nan in + + let f1 = F nan in + let f2 = F nan in + + + let j1 : C> = {n="Foo" ; s={h=5.9 ; w=nan}} in + let j2 : C> = {n="Foo" ; s={h=5.9 ; w=nan}} in + + let jT1 = ("Foo", {h=5.9 ; w=nan}) in + let jT2 = ("Foo", {h=5.9 ; w=nan}) in + let id x = x in + + let testER x y f = if f(not(x.Equals(y))) then (printfn "\n****failure on %A %A\n" x y ; reportFailure "unlabelled test") in + let testPER x y f = if f((x = y)) then (printfn "\n****failure on %A %A\n" x y ; reportFailure "unlabelled test") in + + testER l1 l2 id ; + testER l2 l1 id ; + testPER l1 l2 id ; + testPER l2 l1 id ; + + testER a1 a2 not ; + testER a2 a1 not ; + testPER a1 a2 id ; + testPER a2 a1 id ; + + testER t1 t2 id ; + testER t2 t1 id ; + testPER t1 t2 id ; + testPER t2 t1 id ; + + testER j1 j2 id ; + testER j2 j1 id ; + testPER j1 j2 id ; + testPER j2 j1 id ; + + testER jT1 jT2 id ; + testER jT2 jT1 id ; + testPER jT1 jT2 id ; + testPER jT2 jT1 id ; + + testER d1 d2 id ; + testER d2 d1 id ; + testPER d1 d2 id ; + testPER d2 d1 id ; + + testER e1 e2 id ; + testER e2 e1 id ; + testPER e1 e2 id ; + testPER e2 e1 id ; + + testER f1 f2 id ; + testER f2 f1 id ; + testPER f1 f2 id ; + testPER f2 f1 id + + + let _ = test398275415() + + // Test ER semantics for obj.Equals and PER semantics for (=) + let test398275416() = + + let l1 = [nanf; 1.0f] in + let l2 = [nanf; 1.0f] in + + let a1 = [|nanf; 1.0f|] in + let a2 = [|nanf; 1.0f|] in + + let t1 = (nanf, 1.0f) in + let t2 = (nanf, 1.0f) in + + let d1 = {x2=1.0f;y2=nanf} in + let d2 = {x2=1.0f;y2=nanf} in + + let e1 = E2 nanf in + let e2 = E2 nanf in + + let f1 = F2 nanf in + let f2 = F2 nanf in + + let j1 : C> = {n="Foo" ; s={h=5.9f ; w=nanf}} in + let j2 : C> = {n="Foo" ; s={h=5.9f ; w=nanf}} in + + let jT1 = ("Foo", {h=5.9f ; w=nanf}) in + let jT2 = ("Foo", {h=5.9f ; w=nanf}) in + let id x = x in + + let testER x y f = if f(not(x.Equals(y))) then (printfn "\n****failure on %A %A\n" x y ; reportFailure "unlabelled test") in + let testPER x y f = if f((x = y)) then (printfn "\n****failure on %A %A\n" x y ; reportFailure "unlabelled test") in + + testER l1 l2 id ; + testER l2 l1 id ; + testPER l1 l2 id ; + testPER l2 l1 id ; + + testER a1 a2 not ; + testER a2 a1 not ; + testPER a1 a2 id ; + testPER a2 a1 id ; + + testER t1 t2 id ; + testER t2 t1 id ; + testPER t1 t2 id ; + testPER t2 t1 id ; + + testER j1 j2 id ; + testER j2 j1 id ; + testPER j1 j2 id ; + testPER j2 j1 id ; + + testER jT1 jT2 id ; + testER jT2 jT1 id ; + testPER jT1 jT2 id ; + testPER jT2 jT1 id ; + + testER d1 d2 id ; + testER d2 d1 id ; + testPER d1 d2 id ; + testPER d2 d1 id ; + + testER e1 e2 id ; + testER e2 e1 id ; + testPER e1 e2 id ; + testPER e2 e1 id ; + + testER f1 f2 id ; + testER f2 f1 id ; + testPER f1 f2 id ; + testPER f2 f1 id + + + let _ = test398275416() + + + +// This test tests basic behavior of IEquatable and IComparable augmentations +module GenericComparisonAndEquality = begin + open System.Collections.Generic + open System + + // over records and unions + [] + type UnionTypeA = + | Foo of float + | Int of int + | Recursive of UnionTypeA + + [] + type RecordTypeA<'T> = {f1 : string ; f2 : 'T} + + // IComparable + let _ = + + let sl = SortedList,string>() in + sl.Add({f1="joj";f2=69.0},"prg") ; + sl.Add({f1="bri";f2=68.0},"prg") ; + sl.Add({f1="jom";f2=70.0},"prg") ; + sl.Add({f1="tmi";f2=75.0},"lde") ; + + // add items to sl2 in a different order than sl1 + let sl2 = SortedList,string>() in + sl2.Add({f1="jom";f2=70.0},"prg") ; + sl2.Add({f1="bri";f2=68.0},"prg") ; + sl2.Add({f1="joj";f2=69.0},"prg") ; + sl2.Add({f1="tmi";f2=75.0},"lde") ; + + let sl3 = SortedList() in + sl3.Add(Foo(2.0), 0.0) ; + sl3.Add(Int(1), 1.0) ; + sl3.Add(Recursive(Foo(3.0)),2.0) ; + + let sl4 = SortedList() in + sl4.Add(Foo(2.0), 0.0) ; + sl4.Add(Int(1), 1.0) ; + sl4.Add(Recursive(Foo(3.0)),2.0) ; + + + let l1 = List.ofSeq sl.Keys in + let l2 = List.ofSeq sl2.Keys in + + let l3 = List.ofSeq sl3.Keys in + let l4 = List.ofSeq sl4.Keys in + + check "d3wiojd32icr" (l1 = l2) true ; + check "d3wiojd32icu" (l3 = l4) true + + // IEquatable + let _ = + + let l = List>() in + l.Add({f1="joj";f2=69.0}) ; + l.Add({f1="bri";f2=68.0}) ; + l.Add({f1="jom";f2=70.0}) ; + l.Add({f1="tmi";f2=75.0}) ; + + let l2 = List() in + l2.Add(Foo(2.0)) ; + l2.Add(Int(1)) ; + l2.Add(Recursive(Foo(3.0))) ; + + check "d3wiojd32ier" (l.Contains({f1="joj";f2=69.0})) true ; + check "d3wiojd32ieu" (l2.Contains(Recursive(Foo(3.0)))) true + +end + + +(*--------------------------------------------------------------------------- +!* check optimizations + *--------------------------------------------------------------------------- *) + +module Optimiations = begin + + let _ = check "opt.oi20c77u" (1 + 1) (2) + let _ = check "opt.oi20c77i" (-1 + 1) (0) + let _ = check "opt.oi20c77o" (1 + 2) (3) + let _ = check "opt.oi20c77p" (2 + 1) (3) + let _ = check "opt.oi20c77a" (1 * 0) (0) + let _ = check "opt.oi20c77s" (0 * 1) (0) + let _ = check "opt.oi20c77d" (2 * 2) (4) + let _ = check "opt.oi20c77f" (2 * 3) (6) + let _ = check "opt.oi20c77g" (-2 * 3) (-6) + let _ = check "opt.oi20c77h" (1 - 2) (-1) + let _ = check "opt.oi20c77j" (2 - 1) (1) + + let _ = check "opt.oi20c77uL" (1L + 1L) (2L) + let _ = check "opt.oi20c77iL" (-1L + 1L) (0L) + let _ = check "opt.oi20c77oL" (1L + 2L) (3L) + let _ = check "opt.oi20c77pL" (2L + 1L) (3L) + let _ = check "opt.oi20c77aL" (1L * 0L) (0L) + let _ = check "opt.oi20c77sL" (0L * 1L) (0L) + let _ = check "opt.oi20c77dL" (2L * 2L) (4L) + let _ = check "opt.oi20c77fL" (2L * 3L) (6L) + let _ = check "opt.oi20c77gL" (-2L * 3L) (-6L) + let _ = check "opt.oi20c77hL" (1L - 2L) (-1L) + let _ = check "opt.oi20c77jL" (2L - 1L) (1L) + + let _ = check "opt.oi20cnq" (1 <<< 0) (1) + let _ = check "opt.oi20cnw" (1 <<< 1) (2) + let _ = check "opt.oi20cne" (1 <<< 2) (4) + let _ = check "opt.oi20cnr" (1 <<< 31) (0x80000000) + let _ = check "opt.oi20cnt" (1 <<< 32) (1) + let _ = check "opt.oi20cny" (1 <<< 33) (2) + let _ = check "opt.oi20cnu" (1 <<< 63) (0x80000000) + + let _ = check "or.oi20cnq" (1 ||| 0) (1) + let _ = check "or.oi20cnw" (1 ||| 1) (1) + let _ = check "or.oi20cne" (1 ||| 2) (3) + let _ = check "or.oi20cnr" (0x80808080 ||| 0x08080808) (0x88888888) + let _ = check "or.oi20cnr" (0x8080808080808080L ||| 0x0808080808080808L) (0x8888888888888888L) + + let _ = check "and.oi20cnq" (1 &&& 0) (0) + let _ = check "and.oi20cnw" (1 &&& 1) (1) + let _ = check "and.oi20cne" (1 &&& 2) (0) + let _ = check "and.oi20cnr" (0x80808080 &&& 0x08080808) (0) + let _ = check "and.oi20cnr" (0x8080808080808080L &&& 0x0808080808080808L) (0L) + + let _ = check "opt.oi20cna" (1L <<< 0) (1L) + let _ = check "opt.oi20cns" (1L <<< 1) (2L) + let _ = check "opt.oi20cnd" (1L <<< 2) (4L) + let _ = check "opt.oi20cnf" (1L <<< 31) (0x80000000L) + let _ = check "opt.oi20cng" (1L <<< 32) (0x100000000L) + let _ = check "opt.oi20cnh" (1L <<< 63) (0x8000000000000000L) + let _ = check "opt.oi20cnj" (1L <<< 64) (1L) + let _ = check "opt.oi20cnk" (1L <<< 127) (0x8000000000000000L) + + let _ = check "opt.oi20cnza" (0x80000000l >>> 0) (0x80000000) + let _ = check "opt.oi20cnxa" (0x80000000l >>> 1) (0xC0000000) + let _ = check "opt.oi20cnca" (0x80000000l >>> 31) (0xFFFFFFFF) + let _ = check "opt.oi20cnva" (0x80000000l >>> 32) (0x80000000) + + let _ = check "opt.oi20cnzb" (0x80000000ul >>> 0) (0x80000000ul) + let _ = check "opt.oi20cnxb" (0x80000000ul >>> 1) (0x40000000ul) + let _ = check "opt.oi20cncb" (0x80000000ul >>> 31) (1ul) + let _ = check "opt.oi20cnvb" (0x80000000ul >>> 32) (0x80000000ul) + + let _ = check "opt.oi20c77qa" (0x80000000UL >>> 0) (0x80000000UL) + let _ = check "opt.oi20c77wa" (0x80000000UL >>> 1) (0x40000000UL) + let _ = check "opt.oi20c77ea" (0x80000000UL >>> 31) (1UL) + let _ = check "opt.oi20c77ra" (0x80000000UL >>> 32) (0UL) + let _ = check "opt.oi20c77ta" (0x8000000000000000UL >>> 63) (1UL) + let _ = check "opt.oi20c77ya" (0x8000000000000000UL >>> 64) (0x8000000000000000UL) + + let _ = check "opt.oi20c77qb" (0x80000000L >>> 0) (0x80000000L) + let _ = check "opt.oi20c77wb" (0x80000000L >>> 1) (0x40000000L) + let _ = check "opt.oi20c77ebb" (0x80000000L >>> 31) (1L) + let _ = check "opt.oi20c77rb" (0x80000000L >>> 32) (0L) + let _ = check "opt.oi20c77tb" (0x8000000000000000L >>> 63) (0xFFFFFFFFFFFFFFFFL) + let _ = check "opt.oi20c77yb" (0x8000000000000000L >>> 64) (0x8000000000000000L) + + let _ = check "opt.oi20c77qc" ('a' + '\025') ('z') + let _ = check "opt.oi20c77wc" ('z' - '\025') ('a') + let _ = check "opt.oi20c77ec" (nativeint -3m) (-3n) + let _ = check "opt.oi20c77rc" (nativeint 3m) (3n) + let _ = check "opt.oi20c77tc" (unativeint 3m) (3un) + let _ = check "opt.oi20c77yc" (char 65535m) ('\uFFFF') + let _ = check "opt.oi20c77uc" (decimal '\uFFFF') (65535m) + let _ = check "opt.oi20c77ic" (nativeint "3") (3n) + let _ = check "opt.oi20c77oc" (nativeint "-3") (-3n) + let _ = check "opt.oi20c77pc" (unativeint "3") (3un) + let _ = check "opt.oi20c77ac" (Checked.(+) 'a' '\025') ('z') + let _ = check "opt.oi20c77sc" (Checked.(-) 'z' '\025') ('a') + let _ = check "opt.oi20c77dc" (Checked.nativeint -3m) (-3n) + let _ = check "opt.oi20c77fc" (Checked.nativeint 3m) (3n) + let _ = check "opt.oi20c77gc" (Checked.unativeint 3m) (3un) + let _ = check "opt.oi20c77hc" (Checked.char 65535m) ('\uFFFF') + let _ = check "opt.oi20c77jc" (Checked.nativeint "3") (3n) + let _ = check "opt.oi20c77kc" (Checked.nativeint "-3") (-3n) + let _ = check "opt.oi20c77lc" (Checked.unativeint "3") (3un) + let _ = check "opt.oi20c77zc" (int8 3.9m) (3y) + let _ = check "opt.oi20c77xc" (uint8 3.9m) (3uy) + let _ = check "opt.oi20c77cc" (int16 3.9m) (3s) + let _ = check "opt.oi20c77vc" (uint16 3.9m) (3us) + let _ = check "opt.oi20c77bc" (int32 3.9m) (3l) + let _ = check "opt.oi20c77nc" (uint32 3.9m) (3ul) + let _ = check "opt.oi20c77mc" (int64 3.9m) (3L) + let _ = check "opt.oi20c77,c" (uint64 3.9m) (3uL) + let _ = check "opt.oi20c77.c" (nativeint 3.9m) (3n) + let _ = check "opt.oi20c77/c" (unativeint 3.9m) (3un) + let _ = check "opt.oi20c77zc'" (Checked.int8 3.9m) (3y) + let _ = check "opt.oi20c77xc'" (Checked.uint8 3.9m) (3uy) + let _ = check "opt.oi20c77cc'" (Checked.int16 3.9m) (3s) + let _ = check "opt.oi20c77vc'" (Checked.uint16 3.9m) (3us) + let _ = check "opt.oi20c77bc'" (Checked.int32 3.9m) (3l) + let _ = check "opt.oi20c77nc'" (Checked.uint32 3.9m) (3ul) + let _ = check "opt.oi20c77mc'" (Checked.int64 3.9m) (3L) + let _ = check "opt.oi20c77,c'" (Checked.uint64 3.9m) (3uL) + let _ = check "opt.oi20c77.c'" (Checked.nativeint 3.9m) (3n) + let _ = check "opt.oi20c77/c'" (Checked.unativeint 3.9m) (3un) + +end + + +(*--------------------------------------------------------------------------- +!* BUG 868: repro - mod_float + *--------------------------------------------------------------------------- *) + +let mod_float (x:float) (y:float) = x % y + +do check "mod_floatvrve" (mod_float 3.0 2.0) 1.0 +do check "mod_float3121" (mod_float 3.0 -2.0) 1.0 +do check "mod_float2e12" (mod_float -3.0 2.0) -1.0 +do check "mod_floatve23" (mod_float -3.0 -2.0) -1.0 +do check "mod_floatvr24" (mod_float 3.0 1.0) 0.0 +do check "mod_floatcw34" (mod_float 3.0 -1.0) 0.0 + + +(*--------------------------------------------------------------------------- +!* misc tests of IEnumerable functions + *--------------------------------------------------------------------------- *) + +module Seq = + + let generate openf compute closef = + seq { let r = openf() + try + let mutable x = None + while (x <- compute r; x.IsSome) do + yield x.Value + finally + closef r } + +module MiscIEnumerableTests = begin + + open System.Net + open System.IO + +#if !NETCOREAPP + /// generate the sequence of lines read off an internet connection + let httpSeq (nm:string) = + Seq.generate + (fun () -> new StreamReader(((WebRequest.Create(nm)).GetResponse()).GetResponseStream()) ) + (fun os -> try Some(os.ReadLine()) with _ -> None) + (fun os -> os.Close()) +#endif + + /// generate an infinite sequence using an functional cursor + let dataSeq1 = Seq.unfold (fun s -> Some(s,s+1)) 0 + + /// generate an infinite sequence using an imperative cursor + let dataSeq2 = Seq.generate + (fun () -> ref 0) + (fun r -> r.Value <- r.Value + 1; Some(!r)) + (fun r -> ()) +end + + +(*--------------------------------------------------------------------------- +!* systematic tests of IEnumerable functions + *--------------------------------------------------------------------------- *) + +(* Assertive IEnumerators should: + a) fail if .Current is called before .MoveNext(). + b) return the items in order. + c) allow for calling .Current multiple times without "effects". + d) fail if .Current is called after .MoveNext() returned false. + e) fail if .MoveNext is called after it returned false. +*) + + +let expectFailure desc thunk = try thunk(); printf "expectFailure: no exn from %s " desc; reportFailure "unlabelled test" with e -> () + +open System.Collections.Generic + +let checkIEnumerable (ie:'a System.Collections.Generic.IEnumerable) = + let e = ie.GetEnumerator() in e.Dispose() + let e = ie.GetEnumerator() in + expectFailure "checkIEnumerable: current before next" (fun () -> e.Current |> ignore); + expectFailure "checkIEnumerable: current before next" (fun () -> e.Current |> ignore); + let mutable ritems = [] in + while e.MoveNext() do + let xA = e.Current in + let xB = e.Current in + test "vwnwer" (xA = xB); + ritems <- xA :: ritems + done; + expectFailure "checkIEnumerable: .Current should fail after .MoveNext() return false" (fun () -> e.Current |> ignore); + test "vwnwer" (e.MoveNext() = false); + //expectFailure "checkIEnumerable: .MoveNext should fail after .MoveNext() return false" (fun () -> e.MoveNext()); + (* again! *) + expectFailure "checkIEnumerable: .Current should fail after .MoveNext() return false" (fun () -> e.Current |> ignore); + test "vwnwer" (e.MoveNext() = false); + //expectFailure "checkIEnumerable: .MoveNext should fail after .MoveNext() return false" (fun () -> e.MoveNext()); + List.rev ritems + +let xxs = [ 0;1;2;3;4;5;6;7;8;9 ] +let xxa = [| 0;1;2;3;4;5;6;7;8;9 |] +let xie = Seq.ofArray xxa +let verify = test "" + +do verify(xxs = checkIEnumerable xie) +do printf "Test c2eh2\n"; stdout.Flush(); let pred x = x<4 in verify(List.choose (fun x -> if pred x then Some x else None) xxs = checkIEnumerable (Seq.choose (fun x -> if pred x then Some x else None) xie)) +do printf "Test c2e23ch2\n"; stdout.Flush(); let pred x = x<4 in verify(List.filter pred xxs = checkIEnumerable (Seq.filter pred xie)) +do printf "Test cc42eh2\n"; stdout.Flush(); let pred x = x%3=0 in verify(List.filter pred xxs = checkIEnumerable (Seq.filter pred xie)) +do printf "Test c2f3eh2\n"; stdout.Flush(); let pred x = x%3=0 in verify(List.choose (fun x -> if pred x then Some x else None) xxs = checkIEnumerable (Seq.choose (fun x -> if pred x then Some x else None) xie)) +do printf "Test c2eh2\n"; stdout.Flush(); let pred x = x>100 in verify(List.filter pred xxs = checkIEnumerable (Seq.filter pred xie)) +do printf "Test c2egr3h2\n"; stdout.Flush(); let pred x = x>100 in verify(List.choose (fun x -> if pred x then Some x else None) xxs = checkIEnumerable (Seq.choose (fun x -> if pred x then Some x else None) xie)) +do printf "Test c2eh2\n"; stdout.Flush(); let f x = x*2 in verify(List.map f xxs = checkIEnumerable (Seq.map f xie)) +// disabling this guy for now, as it's failing +// do printf "Test cvaw2eh2\n"; stdout.Flush(); verify ([ 2;3 ] = checkIEnumerable (Seq.generate (fun () -> ref 1) (fun r -> incr r; if !r > 3 then None else Some(!r)) (fun r -> ()))) +do printf "Test c2r5eh2\n"; stdout.Flush(); let f i x = x*20+i in verify(List.mapi f xxs = checkIEnumerable (Seq.mapi f xie)) +do printf "Test c2vreeh2\n"; stdout.Flush(); let f _ x = x*x in verify(List.map2 f xxs xxs = checkIEnumerable (Seq.map2 f xie xie)) +do printf "Test c2vreeh2\n"; stdout.Flush(); let f _ x = x*x in verify(List.map2 f xxs xxs = checkIEnumerable (Seq.map2 f xie xie)) +do let f _ x = x*x in verify(List.concat [] = checkIEnumerable (Seq.concat [| |])) +do let f _ x = x*x in verify(List.concat [xxs] = checkIEnumerable (Seq.concat [| xie |])) +do let f _ x = x*x in verify(List.concat [xxs;xxs] = checkIEnumerable (Seq.concat [| xie; xie |])) +do let f _ x = x*x in verify(List.concat [xxs;xxs;xxs] = checkIEnumerable (Seq.concat [| xie; xie;xie |])) +do printf "Test c25reh2\n"; stdout.Flush(); let f _ x = x*x in verify(List.append xxs xxs = checkIEnumerable (Seq.append xie xie)) +do printf "Test c27mog7keh2\n"; stdout.Flush(); let f x = if x%2 =0 then Some x + else None in verify(List.choose f xxs = checkIEnumerable (Seq.choose f xie)) +do printf "Test c2e8,h2\n"; stdout.Flush(); let f z x = (z+1) * x % 1397 in verify(List.fold f 2 xxs = Seq.fold f 2 xie) +do printfn "seq reduce"; if Seq.reduce (fun x y -> x/y) [5*4*3*2; 4;3;2;1] = 5 then stdout.WriteLine "YES" else reportFailure "basic test Q" + +do printf "Test c2grgeh2\n"; stdout.Flush(); verify(List.item 3 xxs = Seq.item 3 xie) + + +(*--------------------------------------------------------------------------- +!* record effect order + *--------------------------------------------------------------------------- *) + +let last = ref (-1) +let increasing n = if !last < n then ( last.Value <- n; n ) else (printf "increasing failed for %d\n" n; reportFailure "unlabelled test"; n) + +do increasing 0 |> ignore +do increasing 1 |> ignore + +type recordAB = { a : int; b : int } + +let ab1 = {a = increasing 2; + b = increasing 3;} + +let ab2 = {b = increasing 4; + a = increasing 5; + } + +type recordABC = { mutable a : int; b : int; c : int } + +do printf "abc1a\n" +let abc1a = {a = increasing 6; + b = increasing 7; + c = increasing 8;} + +do printf "abc1b\n" +let abc1b = {b = increasing 9; + c = increasing 10; + a = increasing 11;} + +do printf "abc1c\n" +let abc1c = {c = increasing 12; + a = increasing 13; + b = increasing 14; + } + +do printf "abc2a\n" +let abc2a = {abc1a with + b = increasing 15; + c = increasing 16;} + +do printf "abc2b\n" +let abc2b = {abc1a with + c = increasing 17; + a = increasing 18;} + +do printf "abc2c\n" +let abc2c = {abc1a with + a = increasing 19; + b = increasing 20;} + +module FloatParseTests = begin + let to_bits (x:float) = System.BitConverter.DoubleToInt64Bits(x) + let of_bits (x:int64) = System.BitConverter.Int64BitsToDouble(x) + + let to_string (x:float) = (box x).ToString() + let of_string (s:string) = + (* Note System.Double.Parse doesn't handle -0.0 correctly (it returns +0.0) *) + let s = s.Trim() + let l = s.Length + let p = 0 + let p,sign = if (l >= p + 1 && s.[p] = '-') then 1,false else 0,true + let n = + try + if p >= l then raise (new System.FormatException()) + System.Double.Parse(s.[p..],System.Globalization.CultureInfo.InvariantCulture) + with :? System.FormatException -> failwith "Float.of_string" + if sign then n else -n + + do check "FloatParse.1" (to_bits (of_string "0.0")) 0L + do check "FloatParse.0" (to_bits (of_string "-0.0")) 0x8000000000000000L // (-9223372036854775808L) + do check "FloatParse.2" (to_bits (of_string "-1E-127")) 0xa591544581b7dec2L // (-6516334528322609470L) + do check "FloatParse.3" (to_bits (of_string "-1E-323")) 0x8000000000000002L // (-9223372036854775806L) + do check "FloatParse.4" (to_bits (of_string "-1E-324")) 0x8000000000000000L // (-9223372036854775808L) + do check "FloatParse.5" (to_bits (of_string "-1E-325")) 0x8000000000000000L // (-9223372036854775808L) + do check "FloatParse.6" (to_bits (of_string "1E-325")) 0L + do check "FloatParse.7" (to_bits (of_string "1E-322")) 20L + do check "FloatParse.8" (to_bits (of_string "1E-323")) 2L + do check "FloatParse.9" (to_bits (of_string "1E-324")) 0L + do check "FloatParse.A" (to_bits (of_string "Infinity")) 0x7ff0000000000000L // 9218868437227405312L + do check "FloatParse.B" (to_bits (of_string "-Infinity")) 0xfff0000000000000L // (-4503599627370496L) + do check "FloatParse.C" (to_bits (of_string "NaN")) 0xfff8000000000000L // (-2251799813685248L) +#if !NETCOREAPP + do check "FloatParse.D" (to_bits (of_string "-NaN")) ( // http://en.wikipedia.org/wiki/NaN + let bit64 = System.IntPtr.Size = 8 in + if bit64 && System.Environment.Version.Major < 4 then + // 64-bit (on NetFx2.0) seems to have same repr for -nan and nan + 0xfff8000000000000L // (-2251799813685248L) + else + // 64-bit (on NetFx4.0) and 32-bit (any NetFx) seems to flip the sign bit on negation. + // However: + // it seems nan has the negative-bit set from the start, + // and -nan then has the negative-bit cleared! + 0x7ff8000000000000L // 9221120237041090560L + ) +#endif +end + + +(*--------------------------------------------------------------------------- +!* BUG 709: repro + *--------------------------------------------------------------------------- *) +(* +// Currently disabled, because IStructuralEquatable.GetHashCode does not support limited hashing +module CyclicHash = begin + type cons = {x : int; mutable xs : cons option} + let cycle n = + let start = {x = 0; xs = None} in + let rec loop cell i = + if i >= n then + cell.xs <- Some start + else ( + let next = {x = i; xs = None} in + cell.xs <- Some next; + loop next (i+1) + ) + in + loop start 1; + start + + type 'a nest = Leaf of 'a | Nest of 'a nest + let rec nest n x = if n>0 then Nest(nest (n-1) x) else Leaf x + + let xs = Array.init 100 (fun n -> cycle n) + let n = 1 + + do + for n = 1 to 200 do // <--- should exceed max number of nodes used to hash + printf "Hashing array of cyclic structures in %d nest = %d\n" n (hash (nest n xs)) + done + +end +*) + + +(*--------------------------------------------------------------------------- +!* BUG 701: possible repro + *--------------------------------------------------------------------------- *) + +(* +#r "dnAnalytics.dll" +open dnAnalytics.LinearAlgebra + +// Matrix.op_multiply : Matrix * Vector -> Vector +// Matrix.op_multiply : Matrix * Matrix -> Matrix +// Matrix.op_multiply : float * Matrix -> Matrix +// Matrix.op_multiply : Matrix * float -> Matrix +// etc... + +let gpPredict (kinv:Matrix) (cx:Vector) = + let tmpA = Matrix.op_Multiply(kinv,cx) in + let tmpB = kinv * cx in + 12 +29/09/2006 06:43 Resolved as Fixed by dsyme +fixed by reverting change in 1.1.12.3 +*) + +(* + +BUG: +type Vector = VECTOR +type Matrix = class + val i : int + new i = {i=i} + static member ( * )((x:Matrix),(y:Vector)) = (y:Vector) + static member ( * )((x:Matrix),(y:Matrix)) = (y:Matrix) + static member ( * )((x:float),(y:Matrix)) = (y:Matrix) + static member ( * )((x:Matrix),(y:float)) = (x:Matrix) +end + +let gpPredict (kinv:Matrix) (cx:Vector) = + let tmpA = Matrix.op_Multiply(kinv,cx) in + let tmpB = kinv * cx in + 12 +*) + + +(*--------------------------------------------------------------------------- +!* BUG 737: repro - do not expand sharing in large constants... + *--------------------------------------------------------------------------- *) + +module BigMamaConstants = begin + type constant = Leaf of string | List of constant list + let leaf s = Leaf s + let list xs = List xs + let constant_test () = + let a,b,c = leaf "a",leaf "b",leaf "c" in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + let a,b,c = list [a;b],list [b;c],list [c;a] in + a,b,c + +end + +module StringForAll = begin + let _ = "123" |> String.forall (fun c -> System.Char.IsDigit(c)) |> check "4287fejlk2" true + let _ = "123a" |> String.forall (fun c -> System.Char.IsDigit(c)) |> check "4287f62k2" false + let _ = "123a1" |> String.forall (fun c -> System.Char.IsDigit(c)) |> check "4287wfg2ejlk2" false + let _ = "" |> String.forall (fun c -> System.Char.IsDigit(c)) |> check "4287fbt42" true + let _ = "123" |> String.exists (fun c -> System.Char.IsDigit(c)) |> check "428btwt4ejlk2" true + let _ = "123a" |> String.exists (fun c -> System.Char.IsDigit(c)) |> check "42bwejlk2" true + let _ = "123a1" |> String.exists (fun c -> System.Char.IsDigit(c)) |> check "42b4wt4btwejlk2" true + let _ = "" |> String.exists (fun c -> System.Char.IsDigit(c)) |> check "428bt4w2" false + let _ = "a" |> String.exists (fun c -> System.Char.IsDigit(c)) |> check "428b4wtw4jlk2" false + +end + +module RecordLabelTest1 = begin + type r = { a: int; b : int } + let f x = { x with a = 3 } +end + +module RecordLabelTest2 = begin + module SomeOtherPath = begin + type r = { a: int; b : int } + end + let f1 x = { x with SomeOtherPath.a = 3 } + let f2 x = { x with SomeOtherPath.r.a = 3 } + let f3 (x:SomeOtherPath.r) = { x with a = 3 } + open SomeOtherPath + let f4 (x:r) = { x with a = 3 } + let f5 x = { x with a = 3 } +end + + +(*--------------------------------------------------------------------------- +!* set union - timings w.r.t. "union by fold" + *--------------------------------------------------------------------------- *) + +module SetTests = begin + let union0 xs ys = Set.fold (fun ys x -> Set.add x ys) ys xs + let union1 xs ys = Set.union xs ys + + let randomInts n = + let r = new System.Random() in + let rec collect s n = if n>0 then collect (Set.add (r.Next()) s) (n-1) else s in + collect Set.empty n + let rec rapp2 n f x y = if n=1 then f x y else (let z = f x y in rapp2 (n-1) f x y) + + let time f = + let sw = new System.Diagnostics.Stopwatch() in + sw.Reset(); sw.Start(); + let res = f() in + float sw.ElapsedMilliseconds / 1000.0 + + let unionTest n (nx,ny) = + let check (xs:'a Set) = + xs in + let xs = randomInts nx |> check in + let ys = randomInts ny |> check in + (* time union ops *) + let t0 = time (fun () -> rapp2 n union0 xs ys) + let t1 = time (fun () -> rapp2 n union1 xs ys) + + let lst0 = Set.toList (union0 xs ys |> check) + let lst1 = Set.toList (union1 xs ys |> check) + let listsNotEqual = not( List.exists2(fun a b -> a <> b) lst0 lst1) + + test "vwnwer-e" (listsNotEqual) + printf "-- Union times: (fold = %.6f) (divquonq = %.6f) with t0 = %f on sizes %8d,%-8d and x %d\n" (t0/t0) (t1/t0) t0 nx ny n; + + let test_fold() = + let m = Set.ofList [for i in 1..20 -> i] in + test "fold 1" (Set.fold (fun acc _ -> acc + 1) 0 m = 20); + test "fold 2" (Set.foldBack (fun _ acc -> acc + 1) m 0 = 20); + test "fold 3" (Set.fold (fun acc n -> acc + " " + string n) "0" m = String.concat " " [for i in 0..20 -> string i]); + test "fold 4" (Set.foldBack (fun n acc -> acc + " " + string n) m "21" = String.concat " " [for i in 21..-1..1 -> string i]); + let mmax x y = if x > y then x else y in + test "fold 5" (Set.foldBack mmax m 0 = 20); + test "fold 6" (m |> Set.fold mmax 0 = 20); + in test_fold () + + + (* A sample of set sizes for timings *) + do unionTest 500 (100 ,100) + do unionTest 500 (100 ,10000) + do unionTest 500 (100 ,100) + do unionTest 50 (1000 ,1000) + #if PERF + do unionTest 5 (10000,10000) + #endif + do unionTest 2000 (10 ,10) + do unionTest 20000 (5 ,5) + do unionTest 20000 (5 ,10) + do unionTest 20000 (5 ,20) + do unionTest 20000 (5 ,30) + #if PERF + do unionTest 900000 (4 ,8) + do unionTest 900000 (2 ,10) + #endif + do unionTest 5000 (100 ,10000) +end + +let checkEqualInt x y = if x<>y then (printf "%d <> %d" x y; reportFailure "unlabelled test") +do checkEqualInt 1 (int32 1u) +do checkEqualInt 12 (int32 12u) +do checkEqualInt 1 (int 1uy) +do checkEqualInt 12 (int 12uy) + +(*--------------------------------------------------------------------------- +!* set/map filter: was bug + *--------------------------------------------------------------------------- *) +do printf "FilterTests: next:\n"; stdout.Flush() +module FilterTests = begin + do printf "FilterTests: start:\n" + let check s e r = + if r = e then stdout.WriteLine (s^": YES") + else (stdout.WriteLine ("\n***** "^s^": FAIL\n"); reportFailure "basic test Q") + + let degen() = + let map = + Map.add 1 () + (Map.add 2 () + (Map.add 3 () + (Map.add 4 () + (Map.add 5 () Map.empty)))) in + let map2 = Map.filter (fun i () -> i < 3) map in + Map.toList map2 |> List.map fst + do check "Map.filter (degen)" (degen()) [1;2] + + + let checkFilters pred xs = + let xz = Set.ofList xs in + let xz = Set.filter pred xz in + let xz = Set.toList xz in + let xm = Map.ofList (List.map (fun x -> (x,x)) xs) in + let xm = Map.filter (fun x y -> pred x) xm in + let xm = Map.toList xm |> List.map fst in + let xs = List.filter pred xs in + check "Set.filter" (List.sort xs) (List.sort xz); + check "Set.filter" (List.sortWith Operators.compare xs) (List.sortWith Operators.compare xz); + check "Map.filter" (List.sort xs) (List.sort xm); + check "Map.filter" (List.sortWith Operators.compare xs) (List.sortWith Operators.compare xm) + + + do for i = 0 to 100 do + printf "Checking %d " i; checkFilters (fun x -> x<20) [0..i] + done + + do printf "FilterTests: end:\n" +end + + + +let _ = assert(1=1) + + +(*--------------------------------------------------------------------------- +!* Bug 1028: conversion functions like int32 do not accept strings, suggested by Mort. + *--------------------------------------------------------------------------- *) + +do printf "Check bug 1028: conversion functions like int32 do not accept strings, suggested by Mort.\n" +do check "1028: byte" (byte "123") 123uy +do check "1028: sbyte" (sbyte "123") 123y +do check "1028: int16" (int16 "123") 123s +do check "1028: uint16" (uint16 "123") 123us +do check "1028: int32" (int32 "123") 123 +do check "1028: uint32" (uint32 "123") 123u +do check "1028: int64" (int64 "123") 123L +do check "1028: uint64" (uint64 "123") 123uL + +do check "coiewj01" (char 32) ' ' +do check "coiewj02" (char 32.0) ' ' +do check "coiewj03" (char 32.0f) ' ' +do check "coiewj04" (char 32uy) ' ' +do check "coiewj05" (char 32y) ' ' +do check "coiewj06" (char 32s) ' ' +do check "coiewj07" (char 32us) ' ' +do check "coiewj08" (char 32L) ' ' +do check "coiewj09" (char 32UL) ' ' +do check "coiewj0q" (char 32u) ' ' +do check "coiewj0w" (char 32n) ' ' +do check "coiewj0e" (char 32un) ' ' + + +do check "coiewj0r" (Checked.char 32) ' ' +do check "coiewj0t" (Checked.char 32.0) ' ' +do check "coiewj0y" (Checked.char 32.0f) ' ' +do check "coiewj0u" (Checked.char 32uy) ' ' +do check "coiewj0i" (Checked.char 32y) ' ' +do check "coiewj0o" (Checked.char 32s) ' ' +do check "coiewj0p" (Checked.char 32us) ' ' +do check "coiewj0a" (Checked.char 32L) ' ' +do check "coiewj0s" (Checked.char 32UL) ' ' +do check "coiewj0d" (Checked.char 32u) ' ' +do check "coiewj0f" (Checked.char 32n) ' ' +do check "coiewj0g" (Checked.char 32un) ' ' + +do check "coiewj0z" (try Checked.char (-1) with _ -> ' ') ' ' +do check "coiewj0x" (try Checked.char (-1.0) with _ -> ' ') ' ' +do check "coiewj0c" (try Checked.char (-1.0f) with _ -> ' ') ' ' +do check "coiewj0v" (try Checked.char (-1y) with _ -> ' ') ' ' +do check "coiewj0b" (try Checked.char (-1s) with _ -> ' ') ' ' +do check "coiewj0n" (try Checked.char (-1L) with _ -> ' ') ' ' +do check "coiewj0m" (try Checked.char (-1n) with _ -> ' ') ' ' + + +do check "coiewj0aa" (try Checked.char (0x10000) with _ -> ' ') ' ' +do check "coiewj0ss" (try Checked.char (65537.0) with _ -> ' ') ' ' +do check "coiewj0dd" (try Checked.char (65537.0f) with _ -> ' ') ' ' +do check "coiewj0ff" (try Checked.char (0x10000L) with _ -> ' ') ' ' +do check "coiewj0gg" (try Checked.char (0x10000n) with _ -> ' ') ' ' + +do check "coiewj0z" (try Checked.uint16 (-1) with _ -> 17us) 17us +do check "coiewj0x" (try Checked.uint16 (-1.0) with _ -> 17us) 17us +do check "coiewj0c" (try Checked.uint16 (-1.0f) with _ -> 17us) 17us +do check "coiewj0v" (try Checked.uint16 (-1y) with _ -> 17us) 17us +do check "coiewj0b" (try Checked.uint16 (-1s) with _ -> 17us) 17us +do check "coiewj0n" (try Checked.uint16 (-1L) with _ -> 17us) 17us +do check "coiewj0m" (try Checked.uint16 (-1n) with _ -> 17us) 17us + +do check "coiewj0aa" (try Checked.uint16 (0x10000) with _ -> 17us) 17us +do check "coiewj0ss" (try Checked.uint16 (65537.0) with _ -> 17us) 17us +do check "coiewj0dd" (try Checked.uint16 (65537.0f) with _ -> 17us) 17us +do check "coiewj0ff" (try Checked.uint16 (0x10000L) with _ -> 17us) 17us +do check "coiewj0gg" (try Checked.uint16 (0x10000n) with _ -> 17us) 17us + + +do check "clwnwe9831" (sprintf "%A" 1) "1" +do check "clwnwe9832" (sprintf "%A" 10.0) "10.0" +do check "clwnwe9833" (sprintf "%A" 10.0f) "10.0f" +do check "clwnwe9834" (sprintf "%A" 1s) "1s" +do check "clwnwe9835" (sprintf "%A" 1us) "1us" +do check "clwnwe9836" (sprintf "%A" 'c') "'c'" +do check "clwnwe9837" (sprintf "%A" "c") "\"c\"" +do check "clwnwe9838" (sprintf "%A" 1y) "1y" +do check "clwnwe9839" (sprintf "%A" 1uy) "1uy" +do check "clwnwe983q" (sprintf "%A" 1L) "1L" +do check "clwnwe983w" (sprintf "%A" 1UL) "1UL" +do check "clwnwe983e" (sprintf "%A" 1u) "1u" +do check "clwnwe983r" (sprintf "%A" [1]) "[1]" +do check "clwnwe983t" (sprintf "%A" [1;2]) "[1; 2]" +do check "clwnwe983y" (sprintf "%A" [1,2]) "[(1, 2)]" +do check "clwnwe983u" (sprintf "%A" (1,2)) "(1, 2)" +do check "clwnwe983i" (sprintf "%A" (1,2,3)) "(1, 2, 3)" +do check "clwnwe983o" (sprintf "%A" (Some(1))) "Some 1" +do check "clwnwe983p" (sprintf "%A" (Some(Some(1)))) "Some (Some 1)" + +do check "clwnwe91" 10m 10m +do check "clwnwe92" 10m 10.000m +do check "clwnwe93" 1000000000m 1000000000m +do check "clwnwe94" (4294967296000000000m.ToString()) "4294967296000000000" +#if !NETCOREAPP +do check "clwnwe95" (10.000m.ToString(System.Globalization.CultureInfo.GetCultureInfo(1033).NumberFormat)) "10.000" // The actual output of a vanilla .ToString() depends on current culture UI. For this reason I am specifying the en-us culture. +#endif +do check "clwnwe96" (10m.ToString()) "10" +do check "clwnwe97" (sprintf "%A" 10m) "10M" +do check "clwnwe98" (sprintf "%A" 10M) "10M" +do check "clwnwe99" (sprintf "%A" 10.00M) "10.00M" +do check "clwnwe9q" (sprintf "%A" -10.00M) "-10.00M" +do check "clwnwe9w" (sprintf "%A" -0.00M) "0.00M" +do check "clwnwe9w" (sprintf "%A" 0.00M) "0.00M" +do check "clwnwe9e" (sprintf "%A" -0M) "0M" +do check "clwnwe9r" (sprintf "%A" 0M) "0M" +do check "clwnwe9t" (sprintf "%A" (+0M)) "0M" +do check "clwnwe9t1" (sprintf "%A" 18446744073709551616000000000m) "18446744073709551616000000000M" +do check "clwnwe9t2" (sprintf "%A" -79228162514264337593543950335m) "-79228162514264337593543950335M" +do check "clwnwe9t3" (sprintf "%A" -0.0000000000000000002147483647m) "-0.0000000000000000002147483647M" +do check "clwnwe9t4" (sprintf "%A" (10.00M + 10M)) "20.00M" +do check "clwnwe9t5" (sprintf "%A" (10.00M + 10M)) "20.00M" + +do check "clwnwe9t6" 13.00M (10.00M + decimal 3.0) +do check "clwnwe9t8" 13.00M (10.00M + decimal 3) +do check "clwnwe9t9" 13.00M (10.00M + decimal 3y) +do check "clwnwe9tq" 13.00M (10.00M + decimal 3uy) +do check "clwnwe9tw" 13.00M (10.00M + decimal 3us) +do check "clwnwe9te" 13.00M (10.00M + decimal 3s) +do check "clwnwe9tr" 13.00M (10.00M + decimal 3l) +do check "clwnwe9tt" 13.00M (10.00M + decimal 3ul) +do check "clwnwe9ty" 13.00M (10.00M + decimal 3L) +do check "clwnwe9tu" 13.00M (10.00M + decimal 3UL) +do check "clwnwe9ti" 13.00M (10.00M + decimal 3n) +do check "clwnwe9to" 13.00M (10.00M + decimal 3un) +do check "clwnwe9tp" 13.00M (10.00M + decimal 3.0f) + +do check "clwnwe9ta" 13.00 (float 13.00M) +do check "clwnwe9ts" 13 (int32 13.00M) +do check "clwnwe9td" 13s (int16 13.00M) +do check "clwnwe9tf" 13y (sbyte 13.00M) +do check "clwnwe9tg" 13L (int64 13.00M) +do check "clwnwe9th" 13u (uint32 13.00M) +do check "clwnwe9tj" 13us (uint16 13.00M) +do check "clwnwe9tk" 13uy (byte 13.00M) +do check "clwnwe9tl" 13UL (uint64 13.00M) + +do check "lkvcnwd09a" 10.0M (20.0M - 10.00M) +do check "lkvcnwd09s" 200.000M (20.0M * 10.00M) +do check "lkvcnwd09d" 2.0M (20.0M / 10.00M) +do check "lkvcnwd09f" 0.0M (20.0M % 10.00M) +do check "lkvcnwd09g" 2.0M (20.0M % 6.00M) +do check "lkvcnwd09h" 20.0M (floor 20.300M) +do check "lkvcnwd09j" 20.0 (floor 20.300) +do check "lkvcnwd09k" 20.0f (floor 20.300f) +#if !NETCOREAPP +do check "lkvcnwd09l" 20.0M (round 20.300M) +do check "lkvcnwd09z" 20.0M (round 20.500M) +do check "lkvcnwd09x" 22.0M (round 21.500M) +#endif +do check "lkvcnwd09c" 20.0 (round 20.300) +do check "lkvcnwd09v" 20.0 (round 20.500) +do check "lkvcnwd09b" 22.0 (round 21.500) +do check "lkvcnwd09n" 1 (sign 20.300) +do check "lkvcnwd09m" (-1) (sign (-20.300)) +do check "lkvcnwd091" (-1) (sign (-20)) +do check "lkvcnwd092" 1 (sign 20) +do check "lkvcnwd093" 0 (sign 0) +do check "lkvcnwd094" 0 (sign (-0)) +do check "lkvcnwd095" 0 (sign (-0)) +do check "lkvcnwd096" 0 (sign 0y) +do check "lkvcnwd097" 0 (sign 0s) +do check "lkvcnwd098" 0 (sign 0L) + +do check "lkvcnwd099" 1 (sign 1y) +do check "lkvcnwd09q" 1 (sign 1s) +do check "lkvcnwd09w" 1 (sign 1L) + +do check "lkvcnwd09e" (-1) (sign (-1y)) +do check "lkvcnwd09r" (-1) (sign (-1s)) +do check "lkvcnwd09t" (-1) (sign (-1L)) + +// Check potential optimization bugs + +do check "cenonoiwe1" (3 > 1) true +do check "cenonoiwe2" (3y > 1y) true +do check "cenonoiwe3" (3uy > 1uy) true +do check "cenonoiwe4" (3s > 1s) true +do check "cenonoiwe5" (3us > 1us) true +do check "cenonoiwe6" (3 > 1) true +do check "cenonoiwe7" (3u > 1u) true +do check "cenonoiwe8" (3L > 1L) true +do check "cenonoiwe9" (3UL > 1UL) true + +do check "cenonoiweq" (3 >= 1) true +do check "cenonoiwew" (3y >= 1y) true +do check "cenonoiwee" (3uy >= 1uy) true +do check "cenonoiwer" (3s >= 1s) true +do check "cenonoiwet" (3us >= 1us) true +do check "cenonoiwey" (3 >= 1) true +do check "cenonoiweu" (3u >= 1u) true +do check "cenonoiwei" (3L >= 1L) true +do check "cenonoiweo" (3UL >= 1UL) true + +do check "cenonoiwea" (3 >= 3) true +do check "cenonoiwes" (3y >= 3y) true +do check "cenonoiwed" (3uy >= 3uy) true +do check "cenonoiwef" (3s >= 3s) true +do check "cenonoiweg" (3us >= 3us) true +do check "cenonoiweh" (3 >= 3) true +do check "cenonoiwej" (3u >= 3u) true +do check "cenonoiwek" (3L >= 3L) true +do check "cenonoiwel" (3UL >= 3UL) true + + +do check "cenonoiwd1" (3 < 1) false +do check "cenonoiwd2" (3y < 1y) false +do check "cenonoiwd3" (3uy < 1uy) false +do check "cenonoiwd4" (3s < 1s) false +do check "cenonoiwd5" (3us < 1us) false +do check "cenonoiwd6" (3 < 1) false +do check "cenonoiwd7" (3u < 1u) false +do check "cenonoiwd8" (3L < 1L) false +do check "cenonoiwd9" (3UL < 1UL) false + +do check "cenonoiwdq" (3 <= 1) false +do check "cenonoiwdw" (3y <= 1y) false +do check "cenonoiwde" (3uy <= 1uy) false +do check "cenonoiwdr" (3s <= 1s) false +do check "cenonoiwdt" (3us <= 1us) false +do check "cenonoiwdy" (3 <= 1) false +do check "cenonoiwdu" (3u <= 1u) false +do check "cenonoiwdi" (3L <= 1L) false +do check "cenonoiwdo" (3UL <= 1UL) false + +do check "cenonoiwda" (3 <= 3) true +do check "cenonoiwds" (3y <= 3y) true +do check "cenonoiwdd" (3uy <= 3uy) true +do check "cenonoiwdf" (3s <= 3s) true +do check "cenonoiwdg" (3us <= 3us) true +do check "cenonoiwdh" (3 <= 3) true +do check "cenonoiwdj" (3u <= 3u) true +do check "cenonoiwdk" (3L <= 3L) true +do check "cenonoiwdl" (3UL <= 3UL) true + +do check "cenonoiwdz" (4 + 2) 6 +do check "cenonoiwdx" (4y + 2y) 6y +do check "cenonoiwdc" (4uy + 2uy) 6uy +do check "cenonoiwdv" (4s + 2s) 6s +do check "cenonoiwdb" (4us + 2us) 6us +do check "cenonoiwdn" (4 + 2) 6 +do check "cenonoiwdm" (4u + 2u) 6u +do check "cenonoiwdl" (4L + 2L) 6L +do check "cenonoiwdp" (4UL + 2UL) 6UL + +do check "cenonoiwc1" (4 - 2) 2 +do check "cenonoiwc2" (4y - 2y) 2y +do check "cenonoiwc3" (4uy - 2uy) 2uy +do check "cenonoiwc4" (4s - 2s) 2s +do check "cenonoiwc5" (4us - 2us) 2us +do check "cenonoiwc6" (4 - 2) 2 +do check "cenonoiwc7" (4u - 2u) 2u +do check "cenonoiwc8" (4L - 2L) 2L +do check "cenonoiwc9" (4UL - 2UL) 2UL + +do check "cenonoiwcq" (4 * 2) 8 +do check "cenonoiwcw" (4y * 2y) 8y +do check "cenonoiwce" (4uy * 2uy) 8uy +do check "cenonoiwcr" (4s * 2s) 8s +do check "cenonoiwct" (4us * 2us) 8us +do check "cenonoiwcy" (4 * 2) 8 +do check "cenonoiwcu" (4u * 2u) 8u +do check "cenonoiwci" (4L * 2L) 8L +do check "cenonoiwco" (4UL * 2UL) 8UL + +do check "cenonoiwc" (4 / 2) 2 +do check "cenonoiwc" (4y / 2y) 2y +do check "cenonoiwc" (4uy / 2uy) 2uy +do check "cenonoiwc" (4s / 2s) 2s +do check "cenonoiwc" (4us / 2us) 2us +do check "cenonoiwc" (4 / 2) 2 +do check "cenonoiwc" (4u / 2u) 2u +do check "cenonoiwc" (4L / 2L) 2L +do check "cenonoiwc" (4UL / 2UL) 2UL + +do check "cenonoiwc" (-(4)) (-4) +do check "cenonoiwc" (-(4y)) (-4y) +do check "cenonoiwc" (-(4s)) (-4s) +do check "cenonoiwc" (-(4L)) (-4L) + + +do check "cenonoiwc" (4 % 3) 1 +do check "cenonoiwc" (4y % 3y) 1y +do check "cenonoiwc" (4uy % 3uy) 1uy +do check "cenonoiwc" (4s % 3s) 1s +do check "cenonoiwc" (4us % 3us) 1us +do check "cenonoiwc" (4 % 3) 1 +do check "cenonoiwc" (4u % 3u) 1u +do check "cenonoiwc" (4L % 3L) 1L +do check "cenonoiwc" (4UL % 3UL) 1UL + +do check "cenonoiwc" (0b010 <<< 3) 0b010000 +do check "cenonoiwc" (0b010y <<< 3) 0b010000y +do check "cenonoiwc" (0b010uy <<< 3) 0b010000uy +do check "cenonoiwc" (0b010s <<< 3) 0b010000s +do check "cenonoiwc" (0b010us <<< 3) 0b010000us +do check "cenonoiwc" (0b010u <<< 3) 0b010000u +do check "cenonoiwc" (0b010L <<< 3) 0b010000L +do check "cenonoiwc" (0b010UL <<< 3) 0b010000UL + +do check "cenonoiwc" (0b010000 >>> 3) 0b010 +do check "cenonoiwc" (0b010000y >>> 3) 0b010y +do check "cenonoiwc" (0b010000uy >>> 3) 0b010uy +do check "cenonoiwc" (0b010000s >>> 3) 0b010s +do check "cenonoiwc" (0b010000us >>> 3) 0b010us +do check "cenonoiwc" (0b010000u >>> 3) 0b010u +do check "cenonoiwc" (0b010000L >>> 3) 0b010L +do check "cenonoiwc" (0b010000UL >>> 3) 0b010UL + +do check "cenonoiwc" (sbyte 4) 4y +do check "cenonoiwc" (byte 4) 4uy +do check "cenonoiwc" (int16 4) 4s +do check "cenonoiwc" (uint16 4) 4us +do check "cenonoiwc" (int32 4) 4 +do check "cenonoiwc" (uint32 4) 4u +do check "cenonoiwc" (int64 4) 4L +do check "cenonoiwc" (uint64 4) 4UL + +do check "cenonoiwc" (sbyte 4y) 4y +do check "cenonoiwc" (byte 4y) 4uy +do check "cenonoiwc" (int16 4y) 4s +do check "cenonoiwc" (uint16 4y) 4us +do check "cenonoiwc" (int32 4y) 4 +do check "cenonoiwc" (uint32 4y) 4u +do check "cenonoiwc" (int64 4y) 4L +do check "cenonoiwc" (uint64 4y) 4UL + + +do check "cenonoiwc" (sbyte 4uy) 4y +do check "cenonoiwc" (byte 4uy) 4uy +do check "cenonoiwc" (int16 4uy) 4s +do check "cenonoiwc" (uint16 4uy) 4us +do check "cenonoiwc" (int32 4uy) 4 +do check "cenonoiwc" (uint32 4uy) 4u +do check "cenonoiwc" (int64 4uy) 4L +do check "cenonoiwc" (uint64 4uy) 4UL + + +do check "cenonoiwc" (sbyte 4s) 4y +do check "cenonoiwc" (byte 4s) 4uy +do check "cenonoiwc" (int16 4s) 4s +do check "cenonoiwc" (uint16 4s) 4us +do check "cenonoiwc" (int32 4s) 4 +do check "cenonoiwc" (uint32 4s) 4u +do check "cenonoiwc" (int64 4s) 4L +do check "cenonoiwc" (uint64 4s) 4UL + +do check "cenonoiwc" (sbyte 4us) 4y +do check "cenonoiwc" (byte 4us) 4uy +do check "cenonoiwc" (int16 4us) 4s +do check "cenonoiwc" (uint16 4us) 4us +do check "cenonoiwc" (int32 4us) 4 +do check "cenonoiwc" (uint32 4us) 4u +do check "cenonoiwc" (int64 4us) 4L +do check "cenonoiwc" (uint64 4us) 4UL + +do check "cenonoiwc" (sbyte 4u) 4y +do check "cenonoiwc" (byte 4u) 4uy +do check "cenonoiwc" (int16 4u) 4s +do check "cenonoiwc" (uint16 4u) 4us +do check "cenonoiwc" (int32 4u) 4 +do check "cenonoiwc" (uint32 4u) 4u +do check "cenonoiwc" (int64 4u) 4L +do check "cenonoiwc" (uint64 4u) 4UL + +do check "cenonoiwc" (sbyte 4L) 4y +do check "cenonoiwc" (byte 4L) 4uy +do check "cenonoiwc" (int16 4L) 4s +do check "cenonoiwc" (uint16 4L) 4us +do check "cenonoiwc" (int32 4L) 4 +do check "cenonoiwc" (uint32 4L) 4u +do check "cenonoiwc" (int64 4L) 4L +do check "cenonoiwc" (uint64 4L) 4UL + + +do check "cenonoiwc" (sbyte 4UL) 4y +do check "cenonoiwc" (byte 4UL) 4uy +do check "cenonoiwc" (int16 4UL) 4s +do check "cenonoiwc" (uint16 4UL) 4us +do check "cenonoiwc" (int32 4UL) 4 +do check "cenonoiwc" (uint32 4UL) 4u +do check "cenonoiwc" (int64 4UL) 4L +do check "cenonoiwc" (uint64 4UL) 4UL +do check "cenonoiwc" (match null with null -> 2 | _ -> 1) 2 + +module SameTestsUsingNonStructuralComparison2 = + open NonStructuralComparison + + do check "ffcenonoiwe1" (3 > 1) true + do check "ffcenonoiwe2" (3y > 1y) true + do check "ffcenonoiwe3" (3uy > 1uy) true + do check "ffcenonoiwe4" (3s > 1s) true + do check "ffcenonoiwe5" (3us > 1us) true + do check "ffcenonoiwe6" (3 > 1) true + do check "ffcenonoiwe7" (3u > 1u) true + do check "ffcenonoiwe8" (3L > 1L) true + do check "ffcenonoiwe9" (3UL > 1UL) true + do check "ffcenonoiwe9" (3.14 > 3.1) true + do check "ffcenonoiwe9" (3.14f > 3.1f) true + do check "ffcenonoiwe9" ("bbb" > "aaa") true + do check "ffcenonoiwe9" ("bbb" > "bbb") false + do check "ffcenonoiwe9" ("aaa" > "bbb") false + do check "ffcenonoiwe9" ('b' > 'a') true + do check "ffcenonoiwe9" ('a' > 'b') false + do check "ffcenonoiwe9" ('b' > 'b') false + + do check "ffcenonoiwea" (3 >= 3) true + do check "ffcenonoiwes" (3y >= 3y) true + do check "ffcenonoiwed" (3uy >= 3uy) true + do check "ffcenonoiwef" (3s >= 3s) true + do check "ffcenonoiweg" (3us >= 3us) true + do check "ffcenonoiweh" (3 >= 3) true + do check "ffcenonoiwej" (3u >= 3u) true + do check "ffcenonoiwek" (3L >= 3L) true + do check "ffcenonoiwel" (3UL >= 3UL) true + do check "ffcenonoiwem" (3.14 >= 3.1) true + do check "ffcenonoiwen" (3.14f >= 3.1f) true + do check "ffcenonoiwen" (3.14M >= 3.1M) true + do check "ffcenonoiwe91r" ("bbb" >= "aaa") true + do check "ffcenonoiwe92r" ("bbb" >= "bbb") true + do check "ffcenonoiwe93r" ("aaa" >= "bbb") false + do check "ffcenonoiwe94r" ('b' >= 'a') true + do check "ffcenonoiwe95r" ('a' >= 'b') false + do check "ffcenonoiwe96r" ('b' >= 'b') true + + + do check "ffcenonoiwd1" (3 < 1) false + do check "ffcenonoiwd2" (3y < 1y) false + do check "ffcenonoiwd3" (3uy < 1uy) false + do check "ffcenonoiwd4" (3s < 1s) false + do check "ffcenonoiwd5" (3us < 1us) false + do check "ffcenonoiwd6" (3 < 1) false + do check "ffcenonoiwd7" (3u < 1u) false + do check "ffcenonoiwd8" (3L < 1L) false + do check "ffcenonoiwd9" (3UL < 1UL) false + do check "ffcenonoiwd9" (3.14 < 1.0) false + do check "ffcenonoiwd9" (3.14f < 1.0f) false + do check "ffcenonoiwd9" (3.14M < 1.0M) false + do check "ffcenonoiwe91a" ("bbb" < "aaa") false + do check "ffcenonoiwe92a" ("bbb" < "bbb") false + do check "ffcenonoiwe93a" ("aaa" < "bbb") true + do check "ffcenonoiwe94a" ('b' < 'a') false + do check "ffcenonoiwe95a" ('a' < 'b') true + do check "ffcenonoiwe96a" ('b' < 'b') false + + + do check "ffcenonoiwdq" (3 <= 1) false + do check "ffcenonoiwdw" (3y <= 1y) false + do check "ffcenonoiwde" (3uy <= 1uy) false + do check "ffcenonoiwdr" (3s <= 1s) false + do check "ffcenonoiwdt" (3us <= 1us) false + do check "ffcenonoiwdy" (3 <= 1) false + do check "ffcenonoiwdu" (3u <= 1u) false + do check "ffcenonoiwdi" (3L <= 1L) false + do check "ffcenonoiwdo" (3UL <= 1UL) false + do check "ffcenonoiwdg" (3.14 <= 1.0) false + do check "ffcenonoiwdt" (3.14f <= 1.0f) false + do check "ffcenonoiwdt" (3.14M <= 1.0M) false + do check "ffcenonoiwe91q" ("bbb" <= "aaa") false + do check "ffcenonoiwe92q" ("bbb" <= "bbb") true + do check "ffcenonoiwe93q" ("aaa" <= "bbb") true + do check "ffcenonoiwe94q" ('b' <= 'a') false + do check "ffcenonoiwe95q" ('a' <= 'b') true + do check "ffcenonoiwe96q" ('b' <= 'b') true + + + do check "ffcenonoiwda" (3 <= 3) true + do check "ffcenonoiwds" (3y <= 3y) true + do check "ffcenonoiwdd" (3uy <= 3uy) true + do check "ffcenonoiwdf" (3s <= 3s) true + do check "ffcenonoiwdg" (3us <= 3us) true + do check "ffcenonoiwdh" (3 <= 3) true + do check "ffcenonoiwdj" (3u <= 3u) true + do check "ffcenonoiwdk" (3L <= 3L) true + do check "ffcenonoiwdl" (3UL <= 3UL) true + do check "ffcenonoiwdo" (3.14 <= 3.14) true + do check "ffcenonoiwdp" (3.14f <= 3.14f) true + do check "ffcenonoiwdp" (3.14M <= 3.14M) true + + +module NonStructuralComparisonOverDateTime = + open NonStructuralComparison + let now = System.DateTime.Now + let tom = now.AddDays 1.0 + do check "ffcenonoiwe90" (now = tom) false + do check "ffcenonoiwe9q" (now <> tom) true + do check "ffcenonoiwe91" (now < tom) true + do check "ffcenonoiwe92" (now <= now) true + do check "ffcenonoiwe93" (now <= tom) true + do check "ffcenonoiwe94" (tom > now) true + do check "ffcenonoiwe95" (now >= now) true + do check "ffcenonoiwe96" (tom >= now) true + do check "ffcenonoiwe97" (compare now now) 0 + do check "ffcenonoiwe98" (compare now tom) -1 + do check "ffcenonoiwe99" (compare tom now) 1 + do check "ffcenonoiwe9a" (max tom tom) tom + do check "ffcenonoiwe9b" (max tom now) tom + do check "ffcenonoiwe9c" (max now tom) tom + do check "ffcenonoiwe9d" (min tom tom) tom + do check "ffcenonoiwe9e" (min tom now) now + do check "ffcenonoiwe9f" (min now tom) now + + do check "ffcenonoiwe97a1" (ComparisonIdentity.NonStructural.Compare (1, 1)) 0 + do check "ffcenonoiwe98b2" (ComparisonIdentity.NonStructural.Compare (0, 1)) -1 + do check "ffcenonoiwe99c3" (ComparisonIdentity.NonStructural.Compare (1, 0)) 1 + + do check "ffcenonoiwe97a4" (ComparisonIdentity.NonStructural.Compare (now, now)) 0 + do check "ffcenonoiwe98b5" (ComparisonIdentity.NonStructural.Compare (now, tom)) -1 + do check "ffcenonoiwe99c6" (ComparisonIdentity.NonStructural.Compare (tom, now)) 1 + + do check "ffcenonoiwe97a7" (HashIdentity.NonStructural.Equals (now, now)) true + do check "ffcenonoiwe98b8" (HashIdentity.NonStructural.Equals (now, tom)) false + do check "ffcenonoiwe99c9" (HashIdentity.NonStructural.Equals (tom, now)) false + + do check "ffcenonoiwe97a7" (HashIdentity.NonStructural.GetHashCode now) (hash now) + do check "ffcenonoiwe97a7" (HashIdentity.NonStructural.GetHashCode tom) (hash tom) + do check "ffcenonoiwe97a7" (HashIdentity.NonStructural.GetHashCode 11) (hash 11) + do check "ffcenonoiwe97a7" (HashIdentity.NonStructural.GetHashCode 11L) (hash 11L) + do check "ffcenonoiwe97a7" (HashIdentity.NonStructural.GetHashCode 11UL) (hash 11UL) + + do check "ffcenonoiwe97aa" (HashIdentity.NonStructural.Equals (1, 1)) true + do check "ffcenonoiwe98bb" (HashIdentity.NonStructural.Equals (1, 0)) false + do check "ffcenonoiwe99cc" (HashIdentity.NonStructural.Equals (0, 1)) false + + +module NonStructuralComparisonOverTimeSpan = + open NonStructuralComparison + let now = System.TimeSpan.Zero + let tom = System.TimeSpan.FromDays 1.0 + do check "tscenonoiwe90" (now = tom) false + do check "tscenonoiwe9q" (now <> tom) true + do check "tscenonoiwe91" (now < tom) true + do check "tscenonoiwe92" (now <= now) true + do check "tscenonoiwe93" (now <= tom) true + do check "tscenonoiwe94" (tom > now) true + do check "tscenonoiwe95" (now >= now) true + do check "tscenonoiwe96" (tom >= now) true + do check "tscenonoiwe97" (compare now now) 0 + do check "tscenonoiwe98" (compare now tom) -1 + do check "tscenonoiwe99" (compare tom now) 1 + do check "tscenonoiwe9a" (max tom tom) tom + do check "tscenonoiwe9b" (max tom now) tom + do check "tscenonoiwe9c" (max now tom) tom + do check "tscenonoiwe9d" (min tom tom) tom + do check "tscenonoiwe9e" (min tom now) now + do check "tscenonoiwe9f" (min now tom) now + + +// Check you can use the operators without opening the module by naming them +module NonStructuralComparisonOverTimeSpanDirect = + let now = System.TimeSpan.Zero + let tom = System.TimeSpan.FromDays 1.0 + do check "tscenonoiwe90" (NonStructuralComparison.(=) now tom) false + do check "tscenonoiwe9q" (NonStructuralComparison.(<>) now tom) true + do check "tscenonoiwe91" (NonStructuralComparison.(<) now tom) true + do check "tscenonoiwe92" (NonStructuralComparison.(<=) now now) true + do check "tscenonoiwe94" (NonStructuralComparison.(>) tom now) true + do check "tscenonoiwe95" (NonStructuralComparison.(>=) now now) true + do check "tscenonoiwe97" (NonStructuralComparison.compare now now) 0 + do check "tscenonoiwe9a" (NonStructuralComparison.max tom now) tom + do check "tscenonoiwe9e" (NonStructuralComparison.min tom now) now + + do check "ffcenonoiwe97a7" (NonStructuralComparison.hash now) (Operators.hash now) + do check "ffcenonoiwe97a7" (NonStructuralComparison.hash tom) (Operators.hash tom) + do check "ffcenonoiwe97a7" (NonStructuralComparison.hash 11) (Operators.hash 11) + do check "ffcenonoiwe97a7" (NonStructuralComparison.hash 11L) (Operators.hash 11L) + do check "ffcenonoiwe97a7" (NonStructuralComparison.hash 11UL) (Operators.hash 11UL) + +(*--------------------------------------------------------------------------- +!* Bug 1029: Support conversion functions named after C# type names? e.g. uint for uint32 + *--------------------------------------------------------------------------- *) + +do check "1029: byte" (byte "123") 123uy +do check "1029: sbyte" (sbyte "123") 123y +(* +do printf "Check bug 1029: Support conversion functions named after C# type names? e.g. uint for uint32\n" +do check "1029: short" (short "123") 123s +do check "1029: ushort" (ushort "123") 123us +do check "1029: int" (int "123") 123 +do check "1029: uint" (uint "123") 123u +do check "1029: long" (int64 "123") 123L +do check "1029: ulong" (uint64 "123") 123uL +do check "1029: int8" (int8 "123") 123y +do check "1029: uint8" (uint8 "123") 123uy +*) + +do check "1029: int16" (int16 "123") 123s +do check "1029: uint16" (uint16 "123") 123us +do check "1029: int32" (int32 "123") 123 +do check "1029: uint32" (uint32 "123") 123u +do check "1029: int64" (int64 "123") 123L +do check "1029: uint64" (uint64 "123") 123uL + +do check "1029: float32" (float32 "1.2") 1.2f +do check "1029: float" (float "1.2") 1.2 + +do check "1029: single" (single "1.2") 1.2f +do check "1029: double" (double "1.2") 1.2 + + +(*--------------------------------------------------------------------------- +!* BUG 945: comment lexing does not handle slash-quote inside quoted strings + *--------------------------------------------------------------------------- *) + +(* THIS COMMENT IS THE TEST, DO NOT DELETE + let x = "abc" + let x = "abc\"" + let x = "\"abc" +*) + + +(*--------------------------------------------------------------------------- +!* BUG 946: comment lexing does not handle double-quote and backslash inside @-strings + *--------------------------------------------------------------------------- *) + +(* THIS COMMENT IS THE TEST, DO NOT DELETE + let x = @"abc" + let x = @"abc\" + let x = @"\a\bc\" + let x = @"abc\""and still @-string here tested be ending as follows \" +*) + + +(*--------------------------------------------------------------------------- +!* BUG 1080: Seq.cache_all does not have the properties of cache + *--------------------------------------------------------------------------- *) + + +module SeqCacheTests = begin + let countStart = ref 0 + let countIter = ref 0 + let countStop = ref 0 + let oneUseSequence = + Seq.generate (fun () -> incr countStart; ref 0) + (fun r -> incr countIter; incr r; if !r=10 then None else Some !r) + (fun r -> incr countStop) + let manyUseSeq = Seq.cache oneUseSequence + + do check "Bug1080" (countStart.Value,countIter.Value,countStop.Value) (0,0,0) + let () = + let xs = manyUseSeq |> Seq.truncate 0 |> Seq.toArray in + let xs = manyUseSeq |> Seq.truncate 2 |> Seq.toArray in + let xs = manyUseSeq |> Seq.truncate 3 |> Seq.toArray in + () + manyUseSeq (* In fsi, printing forces some walking of manyUseSeq *) + let () = + let xs = manyUseSeq |> Seq.truncate 6 |> Seq.toArray in + let xs = manyUseSeq |> Seq.truncate 100 |> Seq.toArray in + () + do check "Bug1080" (countStart.Value,countIter.Value,countStop.Value) (1,10,1) + + do (box manyUseSeq :?> System.IDisposable) .Dispose() + do countStart.Value <- 0; countIter.Value <- 0; countStop.Value <- 0 + + do check "Bug1080" (countStart.Value,countIter.Value,countStop.Value) (0,0,0) + let () = + let xs = manyUseSeq |> Seq.truncate 0 |> Seq.toArray in + let xs = manyUseSeq |> Seq.truncate 2 |> Seq.toArray in + let xs = manyUseSeq |> Seq.truncate 3 |> Seq.toArray in + () + manyUseSeq (* In fsi, printing forces some walking of manyUseSeq *) + let () = + let xs = manyUseSeq |> Seq.truncate 6 |> Seq.toArray in + let xs = manyUseSeq |> Seq.truncate 100 |> Seq.toArray in + () + do check "Bug1080" (countStart.Value,countIter.Value,countStop.Value) (1,10,1) + do (box manyUseSeq :?> System.IDisposable) .Dispose() + do countStart.Value <- 0; countIter.Value <- 0; countStop.Value <- 0 + do check "Bug1080" (countStart.Value,countIter.Value,countStop.Value) (0,0,0) + + let () = + let xs = manyUseSeq |> Seq.truncate 0 |> Seq.toArray in + let xs = manyUseSeq |> Seq.truncate 2 |> Seq.toArray in + let xs = manyUseSeq |> Seq.truncate 3 |> Seq.toArray in + () + manyUseSeq (* In fsi, printing forces some walking of manyUseSeq *) + let () = + let xs = manyUseSeq |> Seq.truncate 6 |> Seq.toArray in + let xs = manyUseSeq |> Seq.truncate 100 |> Seq.toArray in + () + + do check "Bug1080" (countStart.Value,countIter.Value,countStop.Value) (1,10,1) + +end + + +(*--------------------------------------------------------------------------- +!* BUG 747: Parsing (expr :> type) as top-level expression in fsi requires brackets, grammar issue + *--------------------------------------------------------------------------- *) + +(*Pending inclusion... +(* Do not delete below, they are part of the test, since they delimit the interactions *) + +12 : int (* <-- without brackets, this was rejected by fsi *) +"12" :> System.Object (* <-- without brackets, this was rejected by fsi *) +(box "12") :?> string (* <-- without brackets, this was rejected by fsi *) + +*) + + +(*--------------------------------------------------------------------------- +!* BUG 1049: Adding string : 'a -> string, test cases. + *--------------------------------------------------------------------------- *) + +do printf "Bug1049: string conversion checks\n" +do check "Bug1049.int8" (string 123y) "123" +do check "Bug1049.int16" (string 123s) "123" +do check "Bug1049.int32" (string 123) "123" +do check "Bug1049.int64" (string 123L) "123" +do check "Bug1049.nativeint" (string 123n) "123" + +do check "Bug1049.-int8" (string (-123y)) "-123" +do check "Bug1049.-int16" (string (-123s)) "-123" +do check "Bug1049.-int32" (string (-123)) "-123" +do check "Bug1049.-int64" (string (-123L)) "-123" +do check "Bug1049.-nativeint" (string (-123n)) "-123" + +do check "Bug1049.uint8" (string 123uy) "123" +do check "Bug1049.uint16" (string 123us) "123" +do check "Bug1049.uint32" (string 123u) "123" +do check "Bug1049.uint64" (string 123uL) "123" +do check "Bug1049.unativeint" (string 123un) "123" + +do check "Bug1049.float64" (string 1.234) "1.234" +do check "Bug1049.float64" (string (-1.234)) "-1.234" +do check "Bug1049.float64" (string System.Double.NaN) "NaN" +do check "Bug1049.float64" (string System.Double.PositiveInfinity) "Infinity" +do check "Bug1049.float64" (string System.Double.NegativeInfinity) "-Infinity" +do check "Bug1049.float64" (string nan) "NaN" +do check "Bug1049.float64" (string infinity) "Infinity" +do check "Bug1049.float64" (string (-infinity)) "-Infinity" + +do check "Bug1049.float32" (string 1.234f) "1.234" +do check "Bug1049.float32" (string (-1.234f)) "-1.234" +do check "Bug1049.float32" (string System.Single.NaN) "NaN" +do check "Bug1049.float32" (string System.Single.PositiveInfinity) "Infinity" +do check "Bug1049.float32" (string System.Single.NegativeInfinity) "-Infinity" + +type ToStringClass(x) = + class + override this.ToString() = x + end +do check "Bug1049.customClass" (string (ToStringClass("fred"))) "fred" + +[] +type ToStringStruct = + struct + val x : int + new(x) = {x=x} + override this.ToString() = string this.x + end +do check "Bug1049.customStruct" (string (ToStringStruct(123))) "123" +type ToStringEnum = + | A = 1 + | B = 2 +do check "bug5995.Enum.A" (string ToStringEnum.A) "A" +do check "bug5995.Enum.B" (string ToStringEnum.B) "B" + + + +(*--------------------------------------------------------------------------- +!* BUG 1178: Seq.init and Seq.initInfinite implemented using Seq.unfold which evaluates Current on every step + *--------------------------------------------------------------------------- *) + +module Check1178 = begin + do printf "\n\nTest 1178: check finite/infinite sequences have lazy (f i) for each i\n\n" + (* Test cases for Seq.item. *) + let counter = ref 0 + let reset (r:int ref) = r.Value <- 0 + let fails f = try f() |> ignore;false with _ -> true + let claim x = check "Bugs 1178/1482" x true + + (* Bug 1178: Check Seq.init only computes f on the items requested *) + let initial_100 = Seq.init 100 (fun i -> incr counter; i) + do reset counter; claim(Seq.item 0 initial_100=0); claim(counter.Value = 1) + do reset counter; claim(Seq.item 50 initial_100=50); claim(counter.Value = 1) + do reset counter; claim(fails (fun () -> Seq.item 100 initial_100)); claim(counter.Value = 0) + do reset counter; claim(fails (fun () -> Seq.item (-10) initial_100)); claim(counter.Value = 0) + + let initial_w = Seq.initInfinite (fun i -> incr counter; i) + do reset counter; claim(Seq.item 0 initial_w=0); claim(counter.Value = 1) + do reset counter; claim(Seq.item 50 initial_w=50); claim(counter.Value = 1) + do reset counter; claim(fails (fun () -> Seq.item (-10) initial_w)); claim(counter.Value = 0) + do reset counter; claim(fails (fun () -> Seq.item (-1) initial_w)); claim(counter.Value = 0) + + (* Check *) + let on p f x y = f (p x) (p y) + do claim(on Seq.toArray (=) (Seq.init 10 (fun x -> x*10)) (seq { for x in 0 .. 9 -> x*10 })) + + +(*--------------------------------------------------------------------------- +!* BUG 1482: Seq.initInfinite overflow and Seq.init negative count to be trapped + *--------------------------------------------------------------------------- *) + +#if LONGTESTS + do printf "\n\nTest 1482: check that an infinite sequence fails after i = Int32.MaxValue. This may take ~40 seconds.\n\n" + do claim(fails (fun () -> Seq.length initial_w)) +#endif +end + +module IntegerLoopsWithMinAndMaxIntAndKnownBounds = begin + let x0() = + let r = new ResizeArray<_>() in + for i = 0 to 10 do + r.Add i + done; + check "clkevrw1" (List.ofSeq r) [ 0 .. 10] + + let x1() = + let r = new ResizeArray<_>() in + for i = System.Int32.MinValue to System.Int32.MinValue + 2 do + r.Add i + done; + check "clkevrw2" (List.ofSeq r) [System.Int32.MinValue .. System.Int32.MinValue + 2] + + let x2() = + let r = new ResizeArray<_>() in + for i = System.Int32.MaxValue - 3 to System.Int32.MaxValue - 1 do + r.Add i + done; + check "clkevrw3" (List.ofSeq r) [System.Int32.MaxValue - 3 .. System.Int32.MaxValue - 1] + + let x3() = + let r = new ResizeArray<_>() in + for i = System.Int32.MaxValue - 3 to System.Int32.MaxValue do + r.Add i + done; + check "clkevrw4" (List.ofSeq r) [System.Int32.MaxValue - 3 .. System.Int32.MaxValue ] + + let x4() = + let r = new ResizeArray<_>() in + for i = System.Int32.MaxValue to System.Int32.MaxValue do + r.Add i + done; + check "clkevrw5" (List.ofSeq r) [System.Int32.MaxValue .. System.Int32.MaxValue ] + + let x5() = + let r = new ResizeArray<_>() in + for i = System.Int32.MinValue to System.Int32.MinValue do + r.Add i + done; + check "clkevrw6" (List.ofSeq r) [System.Int32.MinValue .. System.Int32.MinValue ] + + let x6() = + for lower in [ -5 .. 5 ] do + for upper in [ -5 .. 5 ] do + let r = new ResizeArray<_>() in + for i = lower to upper do + r.Add i + done; + check "clkevrw7" (List.ofSeq r) [ lower .. upper ] + done; + done + do x0() + do x1() + do x2() + do x3() + do x4() + do x5() + do x6() +end + +module IntegerLoopsWithMinAndMaxIntAndKnownBoundsGoingDown = begin + + let x0() = + let r = new ResizeArray<_>() in + for i = 10 downto 0 do + r.Add i + done; + check "clkevrw1" (List.ofSeq r |> List.rev) [ 0 .. 10] + + let x1() = + let r = new ResizeArray<_>() in + for i = System.Int32.MinValue + 2 downto System.Int32.MinValue do + r.Add i + done; + check "clkevrw2" (List.ofSeq r |> List.rev) [System.Int32.MinValue .. System.Int32.MinValue + 2] + + let x2() = + let r = new ResizeArray<_>() in + for i = System.Int32.MaxValue - 1 downto System.Int32.MaxValue - 3 do + r.Add i + done; + check "clkevrw3" (List.ofSeq r |> List.rev) [System.Int32.MaxValue - 3 .. System.Int32.MaxValue - 1] + + let x3() = + let r = new ResizeArray<_>() in + for i = System.Int32.MaxValue downto System.Int32.MaxValue - 3 do + r.Add i + done; + check "clkevrw4" (List.ofSeq r |> List.rev) [System.Int32.MaxValue - 3 .. System.Int32.MaxValue ] + + let x4() = + let r = new ResizeArray<_>() in + for i = System.Int32.MaxValue downto System.Int32.MaxValue do + r.Add i + done; + check "clkevrw5" (List.ofSeq r |> List.rev) [System.Int32.MaxValue .. System.Int32.MaxValue ] + + let x5() = + let r = new ResizeArray<_>() in + for i = System.Int32.MinValue downto System.Int32.MinValue do + r.Add i + done; + check "clkevrw6" (List.ofSeq r |> List.rev) [System.Int32.MinValue .. System.Int32.MinValue ] + + let x6() = + for lower in [ -5 .. 5 ] do + for upper in [ -5 .. 5 ] do + let r = new ResizeArray<_>() in + for i = upper downto lower do + r.Add i + done; + check "clkevrw7" (List.ofSeq r |> List.rev) [ lower .. upper ] + done; + done + + do x0() + do x1() + do x2() + do x3() + do x4() + do x5() + do x6() + + +end + + +(*--------------------------------------------------------------------------- +!* BUG 1477: struct with field offset attributes on fields throws assertions in fsi + *--------------------------------------------------------------------------- *) + +module Check1477 = begin + (* FSI ilreflect regression *) + open System.Runtime.InteropServices + [] + [] + type Align16 = struct + [] + val x0 : string + [] + val x1 : string + end +end + +(*--------------------------------------------------------------------------- +!* BUG 1561: (-star-star-) opens a comment but does not close it and other XML Doc issues. + *--------------------------------------------------------------------------- *) + +(* QA note: how to test for XML doc? Programatically? *) +module Check1561 = begin + (** Should be XML Doc *) + let itemA = () + (** Should be XML Doc too even with a * inside *) + let itemB = () + (*** No longer XML Doc, since it starts with 3 stars *) + let itemC = () + (**) + let itemD = () +end + + +(*--------------------------------------------------------------------------- +!* BUG 1750: ilxgen stack incorrect during multi-branch match tests + *--------------------------------------------------------------------------- *) + +module Repro1750 = begin + let rec loop x = loop x + let f p x = + let test = + match int16 x with + | 0s when (try p x finally ()) -> 3 + (* | 1 when (for x = 1 to 100 do printf "" done; true) -> 3 *) + | _ -> 5 + in + loop test +end + + +(*--------------------------------------------------------------------------- +!* BUG 2247: Unverifiable code from struct valued tyfunc + *--------------------------------------------------------------------------- *) + +module Repro2247 = begin + + [] + type MyLazy<'a> = struct + [] + val mutable f : unit -> int + member this.InitFun ff = this.f <- ff + end + + let my_lazy_from_fun f = + let r = MyLazy<_>() in (* Keep this binding, required for repro *) + r (* Warning: Fragile repro *) + + (* With optimisations off, code failed to verify *) +end + + +(*--------------------------------------------------------------------------- +!* BUG 1190, 3569: record and list patterns do not permit trailing seperator + *--------------------------------------------------------------------------- *) + +module Repro_1190 = begin + type R = {p:int;q:int} + let fA {p=p;q=q} = p+q + let fB {p=p;q=q;} = p+q (* Fix 1190 *) +end + +module Repro_3569 = begin + let f [] = 12 +(*let fx [;] = 12 -- this is not permitted *) + let fA [p] = p + let fAx [p;] = p + let fAA [p;q] = p+q + let fAAx [p;q;] = p+q (* Fix 3569 *) +end + + + + +(*--------------------------------------------------------------------------- +!* BUG 3947 + *--------------------------------------------------------------------------- *) + +module Repro_3947 = begin + type PublicType = PTA | PTB of int + type internal InternalType = ITA | ITB of int +#if COMPILING_WITH_EMPTY_SIGNATURE + // PublicType is not actually public if there is a signature +#else + do check "Bug3947.Public%A" (sprintf "%A (%A)" PTA (PTB 2)) "PTA (PTB 2)" +#endif + do check "Bug3947.Public%+A" (sprintf "%+A (%+A)" PTA (PTB 2)) "PTA (PTB 2)" + do check "Bug3947.Internal%+A" (sprintf "%+A (%+A)" ITA (ITB 2)) "ITA (ITB 2)" + + // The follow are not very useful outputs, but adding regression tests to pick up any changes... + do check "Bug3947.Internal%A.ITA" (sprintf "%A" ITA) "ITA" + do check "Bug3947.Internal%A.ITB" (sprintf "%A" (ITB 2)) "ITB 2" +end + + +(*--------------------------------------------------------------------------- +!* BUG 4063: ilreflect ctor emit regression - Type/TypeBuilder change + *--------------------------------------------------------------------------- *) + +let _ = printf "========== Bug 4063 repro ==========\n" + +// ctor case +type 'a T4063 = AT4063 of 'a +let valAT3063 = AT4063 12 + +type M4036<'a> = class new(x:'a) = {} end +let v4063 = M4036(1) + +// method case? +type Taaaaa<'a>() = class end +type Taaaaa2<'a>() = class inherit Taaaaa<'a>() member x.M() = x end + +// method case? +type Tbbbbb<'a>(x:'a) = class member this.M() = x end +type T2bbbbbb(x) = class inherit Tbbbbb(x) end +(let t2 = T2bbbbbb("2") in t2.M) + +let _ = printf "========== Bug 4063 done. ==========\n" + + +(*--------------------------------------------------------------------------- +!* BUG 4139: %A formatter does not accept width, e.g. printf "%10000A" + *--------------------------------------------------------------------------- *) + +module Check4139 = begin + do check "Bug4139.percent.A" (sprintf "%8A" [1..10]) "[1; 2; 3;\n 4; 5; 6;\n 7; 8; 9;\n 10]" + do check "Bug4139.percent.A" (sprintf "%8.4A" [1..10]) "[1; 2; 3;\n 4; ...]" + do check "Bug4139.percent.A" (sprintf "%0.4A" [1..10]) "[1; 2; 3; 4; ...]" +end + + +(*--------------------------------------------------------------------------- +!* BUG 1043: Can (-star-) again be lexed specially and recognised as bracket-star-bracket? + *--------------------------------------------------------------------------- *) + +(* Make this the last test since it confuses fontification in tuareg mode *) +module Check1043 = begin + (* LBRACKET STAR RBRACKET becomes a valid operator identifier *) + let (*) = 12 + let x = (*) + let test() = let f (*) = 12 + (*) in f 12 + let x24 = test() +end + + +(*--------------------------------------------------------------------------- +!* Tail-cons optimized operators temporarily put 'null' in lists + *--------------------------------------------------------------------------- *) + +let rec checkForNoNullsInList a = + test "non-null list check" (match box a with null -> false | _ -> true); + match a with + | [] -> () + | h::t -> checkForNoNullsInList t + + +module TestNoNullElementsInListChainFromPartition = begin + + + + let test l = + printfn "testing %A" l; + let a,b = List.partition (fun x -> x = 1) l in + checkForNoNullsInList a; + checkForNoNullsInList b + + + let _ = + test [] + + let _ = + for i in [1;2] do + test [i] + done + + let _ = + for i in [1;2] do + for j in [1;2] do + test [i;j] + done + done + + let _ = + for i in [1;2] do + for j in [1;2] do + for k in [1;2] do + test [i;j;k] + done + done + done + +end + +module TestNoNullElementsInListChainFromInit = begin + + let test n x = + printfn "testing %A" n; + let a = List.init n x in + checkForNoNullsInList a + + + let _ = + for i in 0..5 do + test i (fun i -> i + 1) + + done + +end + +module TestNoNullElementsInListChainFromUnzip = begin + + let test x = + printfn "testing %A" x; + let a,b = List.unzip x in + checkForNoNullsInList a; + checkForNoNullsInList b + + + let _ = + for i in 0..5 do + test (List.init i (fun i -> (i,i))) + + done + +end + + +module TestNoNullElementsInListChainFromUnzip3 = begin + + let test x = + printfn "testing %A" x; + let a,b,c = List.unzip3 x in + checkForNoNullsInList a; + checkForNoNullsInList b; + checkForNoNullsInList c + + + let _ = + for i in 0..5 do + test (List.init i (fun i -> (i,i,i))) + + done + +end + +module TestListToString = begin + + do check "lknsdv0vrknl0" ([].ToString()) "[]" + do check "lknsdv0vrknl1" ([1].ToString()) "[1]" + do check "lknsdv0vrknl2" ([1; 2].ToString()) "[1; 2]" + do check "lknsdv0vrknl3" ([1; 2; 3].ToString()) "[1; 2; 3]" + do check "lknsdv0vrknl4" ([1; 2; 3; 4].ToString()) "[1; 2; 3; ... ]" + do check "lknsdv0vrknl5" (["1"].ToString()) "[1]" // unfortunate but true - no quotes + do check "lknsdv0vrknl6" (["1"; null].ToString()) "[1; null]" + do check "lknsdv0vrknl7" ([None].ToString()) "[null]" // unfortunate but true + + do check "lknsdv0vrknl01" (Some(1).ToString()) "Some(1)" + do check "lknsdv0vrknl02" (Some(None).ToString()) "Some(null)" // unfortunate but true + do check "lknsdv0vrknl03" (Some(1,2).ToString()) "Some((1, 2))" // unfortunate but true + do check "lknsdv0vrknl04" (Some(Some(1)).ToString()) "Some(Some(1))" +end + + + +module SetToString = begin + do check "cewjhnkrveo1" ((set []).ToString()) "set []" + do check "cewjhnkrveo2" ((set [1]).ToString()) "set [1]" + do check "cewjhnkrveo3" ((set [1;2]).ToString()) "set [1; 2]" + do check "cewjhnkrveo4" ((set [1;2;3]).ToString()) "set [1; 2; 3]" + do check "cewjhnkrveo5" ((set [3;2;1]).ToString()) "set [1; 2; 3]" + do check "cewjhnkrveo6" ((set [2;3;4]).ToString()) "set [2; 3; 4]" + do check "cewjhnkrveo7" ((set [1;2;3;4]).ToString()) "set [1; 2; 3; ... ]" + do check "cewjhnkrveo8" ((set [4;3;2;1]).ToString()) "set [1; 2; 3; ... ]" + + do check "cewjhnkrveo11" ((Map.ofList []).ToString()) "map []" + do check "cewjhnkrveo21" ((Map.ofList [(1,10)]).ToString()) "map [(1, 10)]" + do check "cewjhnkrveo31" ((Map.ofList [(1,10);(2,20)]).ToString()) "map [(1, 10); (2, 20)]" + do check "cewjhnkrveo41" ((Map.ofList [(1,10);(2,20);(3,30)]).ToString()) "map [(1, 10); (2, 20); (3, 30)]" + do check "cewjhnkrveo51" ((Map.ofList [(3,30);(2,20);(1,10)]).ToString()) "map [(1, 10); (2, 20); (3, 30)]" + do check "cewjhnkrveo61" ((Map.ofList [(2,20);(3,30);(4,40)]).ToString()) "map [(2, 20); (3, 30); (4, 40)]" + do check "cewjhnkrveo71" ((Map.ofList [(1,10);(2,20);(3,30);(4,40)]).ToString()) "map [(1, 10); (2, 20); (3, 30); ... ]" + do check "cewjhnkrveo81" ((Map.ofList [(4,40);(3,30);(2,20);(1,10)]).ToString()) "map [(1, 10); (2, 20); (3, 30); ... ]" + + do check "cewjhnkrveo1p" ((set []) |> sprintf "%A") "set []" + do check "cewjhnkrveo2p" ((set [1]) |> sprintf "%A") "set [1]" + do check "cewjhnkrveo3p" ((set [1;2]) |> sprintf "%A") "set [1; 2]" + do check "cewjhnkrveo4p" ((set [1;2;3]) |> sprintf "%A") "set [1; 2; 3]" + do check "cewjhnkrveo5p" ((set [3;2;1]) |> sprintf "%A") "set [1; 2; 3]" + do check "cewjhnkrveo6p" ((set [2;3;4]) |> sprintf "%A") "set [2; 3; 4]" + do check "cewjhnkrveo7p" ((set [1;2;3;4]) |> sprintf "%A") "set [1; 2; 3; 4]" + do check "cewjhnkrveo8p" ((set [4;3;2;1]) |> sprintf "%A") "set [1; 2; 3; 4]" + + do check "cewjhnkrveo11p" ((Map.ofList []) |> sprintf "%A") "map []" + do check "cewjhnkrveo21p" ((Map.ofList [(1,10)]) |> sprintf "%A") "map [(1, 10)]" + do check "cewjhnkrveo31p" ((Map.ofList [(1,10);(2,20)]) |> sprintf "%A") "map [(1, 10); (2, 20)]" + do check "cewjhnkrveo41p" ((Map.ofList [(1,10);(2,20);(3,30)]) |> sprintf "%A") "map [(1, 10); (2, 20); (3, 30)]" + do check "cewjhnkrveo51p" ((Map.ofList [(3,30);(2,20);(1,10)]) |> sprintf "%A") "map [(1, 10); (2, 20); (3, 30)]" + do check "cewjhnkrveo61p" ((Map.ofList [(2,20);(3,30);(4,40)]) |> sprintf "%A") "map [(2, 20); (3, 30); (4, 40)]" + do check "cewjhnkrveo71p" ((Map.ofList [(1,10);(2,20);(3,30);(4,40)]) |> sprintf "%A") "map [(1, 10); (2, 20); (3, 30); (4, 40)]" + do check "cewjhnkrveo81p" ((Map.ofList [(4,40);(3,30);(2,20);(1,10)]) |> sprintf "%A") "map [(1, 10); (2, 20); (3, 30); (4, 40)]" +end + +(*--------------------------------------------------------------------------- +!* Bug 5816: Unable to define mutually recursive types with mutually recursive generic constraints within FSI + *--------------------------------------------------------------------------- *) +module Bug5816 = begin + type IView<'v, 'vm when 'v :> IView<'v,'vm> and 'vm :> IViewModel<'v,'vm>> = interface + abstract ViewModel : 'vm + end + and IViewModel<'v, 'vm when 'v :> IView<'v,'vm> and 'vm :> IViewModel<'v,'vm>> = interface + abstract View : 'v + end +end + +(*--------------------------------------------------------------------------- +!* Bug 5825: Constraints with nested types + *--------------------------------------------------------------------------- *) +module Bug5825 = begin + type I = interface + abstract member m : unit + end + type C() = class + interface I with + member this.m = () + end + end + let f (c : #C) = () +end + +module Bug5981 = begin + // guard against type variable tokens leaking into the IL stream + // (in this case, we're trying to ensure that the lambda is handled properly) + let t1 = Array2D.init 2 2 (fun x y -> x,y) + + // test basic use of indirect calling + let t2 = Array2D.zeroCreate 10 10 + + let throwAnException (a: int) = + raise (System.Exception("Foo!")) + Array2D.zeroCreate<'T> a a + + let throwAnExceptionUnit () = + raise (System.Exception("Foo!")) + Array2D.zeroCreate<'T> 10 10 + + // ensure that TargetInvocationException is properly unwrapped + do test "cwewe0982" ((try throwAnException(10) |> ignore ; false with | :? System.Reflection.TargetInvocationException -> false | _ -> true)) + + // same as above, making sure that we handle methods that take no args properly + do test "cwewe0982" ((try throwAnExceptionUnit() |> ignore ; false with | :? System.Reflection.TargetInvocationException -> false | _ -> true)) + +end + +module Bug920236 = + open System.Collections + open System.Collections.Generic + + type Arr(a : int[]) = + interface IEnumerable with + member this.GetEnumerator() = + let i = ref -1 + { new IEnumerator with + member this.Reset() = failwith "not supported" + member this.MoveNext() = incr i; !i < a.Length + member this.Current = box (a.[!i]) + } + + let a = Arr([|1|]) + let result = ref [] + for i in a do + result.Value <- i::(result.Value) + do test "hfduweyr" (!result = [box 1]) + +module TripleQuoteStrings = + + check "ckjenew-0ecwe1" """Hello world""" "Hello world" + check "ckjenew-0ecwe2" """Hello "world""" "Hello \"world" + check "ckjenew-0ecwe3" """Hello ""world""" "Hello \"\"world" +#if UNIX +#else +#if INTERACTIVE // FSI prints \r\n or \n depending on PIPE vs FEED so we'll just skip it +#else + if System.Environment.GetEnvironmentVariable("APPVEYOR_CI") <> "1" then + check "ckjenew-0ecwe4" """Hello +""world""" "Hello \r\n\"\"world" +#endif +#endif + // cehcek there is no escaping... + check "ckjenew-0ecwe5" """Hello \"world""" "Hello \\\"world" + check "ckjenew-0ecwe6" """Hello \\"world""" "Hello \\\\\"world" + check "ckjenew-0ecwe7" """Hello \nworld""" "Hello \\nworld" + check "ckjenew-0ecwe8" """Hello \""" "Hello \\" + check "ckjenew-0ecwe9" """Hello \\""" "Hello \\\\" + check "ckjenew-0ecwe10" """Hello \n""" "Hello \\n" + + // check some embedded comment terminators + check "ckjenew-0ecwe11" (* """Hello *) world""" *) """Hello world""" "Hello world" + check "ckjenew-0ecwe1" (* (* """Hello *) world""" *) *) """Hello world""" "Hello world" + check "ckjenew-0ecwe2" (* """Hello *) "world""" *) """Hello "world""" "Hello \"world" + + +#if MONO +#else +module FloatInRegisterConvertsToFloat = + + let simpleTest() = + let x : float = -1.7976931348623157E+308 + let sum = x + x + let equal = (sum = float (x + x)) + test "vw09rwejkn" equal + + simpleTest() +#endif + +(*--------------------------------------------------------------------------- +!* Bug 122495: Bad code generation in code involving structs/property settings/slice operator + *--------------------------------------------------------------------------- *) +module bug122495 = + [] + [] + type C = + [] + val mutable internal goo : byte [] + // Note: you need some kind of side effect or use of 'x' here + member this.P with set(x) = this.goo <- x + + let a = [|0uy..10uy|] + // this should not throw an InvalidProgramException + let c = C( P = a.[0..1]) + + +#if !NETCOREAPP +(*--------------------------------------------------------------------------- +!* Bug 33760: wrong codegen for params[] Action overload + *--------------------------------------------------------------------------- *) +module bug33760 = + open System + open System.Threading.Tasks + + type C() = + static member M1([] arg: System.Action []) = () + + // these just need to typecheck + C.M1(fun () -> ()) + Parallel.Invoke(fun () -> ()) +#endif + + +module Regression_139182 = + [] + type S = + member x.TheMethod() = x.TheMethod() : int64 + let theMethod (s:S) = s.TheMethod() + type T() = + static let s = S() + static let str = "test" + let s2 = S() + static member Prop1 = s.TheMethod() // error FS0422 + static member Prop2 = theMethod s // ok + static member Prop3 = let s' = s in s'.TheMethod() // ok + static member Prop4 = str.ToLower() // ok + member x.Prop5 = s2.TheMethod() // ok + +module LittleTestFor823 = + let x, y = 1, 2 + let v = Some ((x = y), (x = x)) + + +(*--------------------------------------------------------------------------- +!* wrap up + *--------------------------------------------------------------------------- *) + +#if TESTS_AS_APP +let RUN() = !failures +#else +let aa = + match !failures with + | [] -> + stdout.WriteLine "Test Passed" + System.IO.File.WriteAllText("test.ok","ok") + exit 0 + | _ -> + stdout.WriteLine "Test Failed" + exit 1 +#endif + diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/measures.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/measures.fsx new file mode 100644 index 00000000000..4f1aba6958b --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/measures.fsx @@ -0,0 +1,606 @@ +// #Conformance #UnitsOfMeasure #Constants +#if TESTS_AS_APP +module Core_measures +#endif +#light + +let failures = ref [] + +let report_failure (s : string) = + stderr.Write" NO: " + stderr.WriteLine s + failures.Value <- failures.Value @ [s] + +let test (s : string) b = + stderr.Write(s) + if b then stderr.WriteLine " OK" + else report_failure (s) + +(* TEST SUITE FOR Operators on units-of-measure *) + +[] type kg +[] type s +[] type m + +[] type sqrm = m^2 + +// Now some measures with members + +[] +type lb = + static member fromKg (x:float) = x*2.2 + +// Augmentation +type s with + static member Name = "seconds" + +type s with + static member Symbol = "s" + +type lb with + static member Name = "pounds" + +type area = float +type intarea = int + +module GENERICS = + + let f<'a when 'a:struct>(x:'a) = 1 + let x1 = f>(3.0) + let x2 = f>(4.0f) + let x3 = f(5.0M) + +module FLOAT = + + // set up bindings + let x1 = 2.0 + 4.0 + let x2 = 2.0 - 4.0 + let x3 = 2.0 / 4.0 + let x3a = 2.0 / 4.0 + let x3b = 1.0 / 4.0 + let x3c = 1.0 / 4.0 + let x4 = 2.0 * 4.0 + let x4a = 2.0 * 4.0 + let x4b = 2.0 * 4.0 + let x4c = 2.0 * 4.0 + let x5 = 5.0 % 3.0 + let x6 = - (2.0) + let x7 = abs (-2.0) + let x8 = sqrt (4.0) + let x8a = sqrt (4.0) + let x8b = sqrt (4.0) + let x9 = [ 1.0 .. 1.0 .. 4.0 ] + let x10 = sign (3.0) + let x11 = atan2 4.4 5.4 + let x11a : float<1> = acos 4.4<1> + let x11b : float<1> = asin 4.4<1> + let x11c : float<1> = atan 4.4<1> + let x11d : float<1> = ceil 4.4<1> + let x11e : float<1> = cos 4.4<1> + let x11f : float<1> = cosh 4.4<1> + let x11g : float<1> = exp 4.4<1> + let x11h : float<1> = floor 4.4<1> + let x11i : float<1> = log 4.4<1> + let x11j : float<1> = log10 4.4<1> + let x11k : float<1> = 4.4<1> ** 3.0<1> + let x11l : float<1> = pown 4.4<1> 3 + let x11m : float<1> = round 4.4<1> + let x11n : int = sign 4.4<1> + let x11o : float<1> = sin 4.4<1> + let x11p : float<1> = sinh 4.4<1> + let x11q : float<1> = sqrt 4.4<1> + let x11r : float<1> = tan 4.4<1> + let x11s : float<1> = tanh 4.4<1> + let x12 = Seq.sum [2.0; 3.0] + let x12a = Seq.sumBy (fun x -> x*x) [(2.0 : area); 3.0] + let x13 = (Seq.average [2.0; 3.0]) : area + let x13a = Seq.averageBy (fun x -> x*x) [2.0; 3.0] + let x14 = x13 + x13a + let x15 = 5.0 < 3.0 + let x16 = 5.0 <= 3.0 + let x17 = 5.0 > 3.0 + let x18 = 5.0 >= 3.0 + let x19 = max 5.0 3.0 + let x20 = min 5.0 3.0 + let x21 = typeof> + let x22<[] 'a>() = typeof> + + // Force trig functions etc to be dimensionless + let x23a = acos (4.4<_>) + let x23b = asin (4.4<_>) + let x23c = atan (4.4<_>) + let x23d = ceil (4.4<_>) + let x23e = cos (4.4<_>) + let x23f = cosh (4.4<_>) + let x23g = exp (4.4<_>) + let x23h = floor (4.4<_>) + let x23i = log (4.4<_>) + let x23j = log10 (4.4<_>) + let x23k = 4.4<_> ** 3.0<_> + let x23l = pown (4.4<_>) 3 + let x23m = round (4.4<_>) + let x23o = sin (4.4<_>) + let x23p = sinh (4.4<_>) + let x23r = tan (4.4<_>) + let x23s = tanh (4.4<_>) +#if !NETCOREAPP + let x23t = truncate (4.5<_>) +#endif + // check the types and values! + test "x1" (x1 = 6.0) + test "x2" (x2 = -2.0) + test "x3" (x3 = 0.5) + test "x3a" (x3a = 0.5) + test "x3b" (x3b = 0.25<1/s>) + test "x3c" (x3c = 0.25) + test "x4" (x4 = 8.0) + test "x4a" (x4a = 8.0) + test "x4b" (x4b = 8.0) + test "x4c" (x4c = 8.0) + test "x5" (x5 = 2.0) + test "x6" (x6 = -2.0) + test "x7" (x7 = 2.0) + test "x8" (x8 = 2.0) + test "x8a" (x8a = 2.0) + test "x8b" (x8b = 2.0) + test "x9" (x9 = [1.0; 2.0; 3.0; 4.0]) + test "x10" (x10 = 1) + test "x12" (x12 = 5.0) + test "x12a" (x12a = 13.0) + test "x13" (x13 = 2.5) + test "x13a" (x13a = 6.5) + test "x14" (x14 = 9.0) + test "x15" (x15 = false) + test "x16" (x16 = false) + test "x17" (x17 = true) + test "x18" (x18 = true) + test "x19" (x19 = 5.0) + test "x20" (x20 = 3.0) + test "x21" (x21 = typeof) + test "x22" (x22() = typeof) + + +module INT = + + // set up bindings + let x1 = 2 + 4 + let x2 = 2 - 4 + let x3 = 8 / 4 + let x3a = 8 / 4 + let x3b = 8 / 4 + let x3c = 8 / 4 + let x4 = 2 * 4 + let x4a = 2 * 4 + let x4b = 2 * 4 + let x4c = 2 * 4 + let x5 = 5 % 3 + let x6 = - (2) + let x7 = abs (-2) + let x9 = [ 1 .. 1 .. 4 ] + let x10 = sign (3) + let x11n : int = sign 4<1> + let x12 = Seq.sum [2; 3] + let x12a = Seq.sumBy (fun x -> x*x) [(2 : intarea); 3] + let x15 = 5 < 3 + let x16 = 5 <= 3 + let x17 = 5 > 3 + let x18 = 5 >= 3 + let x19 = max 5 3 + let x20 = min 5 3 + let x21 = typeof> + let x22<[] 'a>() = typeof> + + // Force bitwise functions etc to be dimensionless + let x23a = 4<_> ||| 8<_> + let x23b = 3<_> &&& 1<_> + let x23c = ~~~ 1<_> + let x23d = 2<_> >>> 1<_> + let x23e = 2<_> <<< 1<_> + let x23f = 3<_> ^^^ 3<_> + + // check the types and values! + test "x1" (x1 = 6) + test "x2" (x2 = -2) + test "x3" (x3 = 2) + test "x3a" (x3a = 2) + test "x3b" (x3b = 2<1/s>) + test "x3c" (x3c = 2) + test "x4" (x4 = 8) + test "x4a" (x4a = 8) + test "x4b" (x4b = 8) + test "x4c" (x4c = 8) + test "x5" (x5 = 2) + test "x6" (x6 = -2) + test "x7" (x7 = 2) + test "x9" (x9 = [1; 2; 3; 4]) + test "x10" (x10 = 1) + test "x12" (x12 = 5) + test "x12a" (x12a = 13) + test "x15" (x15 = false) + test "x16" (x16 = false) + test "x17" (x17 = true) + test "x18" (x18 = true) + test "x19" (x19 = 5) + test "x20" (x20 = 3) + test "x21" (x21 = typeof) + test "x22" (x22() = typeof) + + +module FLOAT32 = + + let y1 = 2.0f + 4.0f + let y2 = 2.0f - 4.0f + let y3 = 2.0f / 4.0f + let y3a = 2.0f / 4.0f + let y3b = 1.0f / 4.0f + let y3c = 1.0f / 4.0f + let y4 = 2.0f * 4.0f + let y4a = 2.0f * 4.0f + let y4b = 2.0f * 4.0f + let y4c = 2.0f * 4.0f + let y5 = 5.0f % 3.0f + let y6 = - (2.0f) + let y7 = abs (2.0f) + let y8 = sqrt (4.0f) + let y9 = [ 1.0f .. 1.0f .. 4.0f ] + let y10 = sign (3.0f) + let y11 = atan2 4.4f 5.4f + let x11a : float32<1> = acos 4.4f<1> + let x11b : float32<1> = asin 4.4f<1> + let x11c : float32<1> = atan 4.4f<1> + let x11d : float32<1> = ceil 4.4f<1> + let x11e : float32<1> = cos 4.4f<1> + let x11f : float32<1> = cosh 4.4f<1> + let x11g : float32<1> = exp 4.4f<1> + let x11h : float32<1> = floor 4.4f<1> + let x11i : float32<1> = log 4.4f<1> + let x11j : float32<1> = log10 4.4f<1> + let x11k : float32<1> = 4.4f<1> ** 3.0f<1> + let x11l : float32<1> = pown 4.4f<1> 3 + let x11m : float32<1> = round 4.4f<1> + let x11n : int = sign 4.4f<1> + let x11o : float32<1> = sin 4.4f<1> + let x11p : float32<1> = sinh 4.4f<1> + let x11q : float32<1> = sqrt 4.4f<1> + let x11r : float32<1> = tan 4.4f<1> + let x11s : float32<1> = tanh 4.4f<1> + let y12 = Seq.sum [2.0f; 3.0f] + let y12a = Seq.sumBy (fun y -> y*y) [2.0f; 3.0f] + let y13 = Seq.average [2.0f; 3.0f] + let y13a = Seq.averageBy (fun y -> y*y) [2.0f; 3.0f] + + // check the types and values! + test "y1" (y1 = 6.0f) + test "y2" (y2 = -2.0f) + test "y3" (y3 = 0.5f) + test "y3a" (y3a = 0.5f) + test "y3b" (y3b = 0.25f<1/s>) + test "y3c" (y3c = 0.25f) + test "y4" (y4 = 8.0f) + test "y4a" (y4a = 8.0f) + test "y4b" (y4b = 8.0f) + test "y4c" (y4c = 8.0f) + test "y5" (y5 = 2.0f) + test "y6" (y6 = -2.0f) + test "y7" (y7 = 2.0f) + test "y8" (y8 = 2.0f) + test "y9" (y9 = [1.0f; 2.0f; 3.0f; 4.0f]) + test "y10" (y10 = 1) + test "y12" (y12 = 5.0f) + test "y12a" (y12a = 13.0f) + test "y13" (y13 = 2.5f) + test "y13a" (y13a = 6.5f) + + +module DECIMAL = + + let z1 = 2.0M + 4.0M + let z2 = 2.0M - 4.0M + let z3 = 2.0M / 4.0M + let z3a = 2.0M / 4.0M + let z3b = 1.0M / 4.0M + let z3c = 1.0M / 4.0M + let z4 = 2.0M * 4.0M + let z4a = 2.0M * 4.0M + let z4b = 2.0M * 4.0M + let z4c = 2.0M * 4.0M + let z5 = 5.0M % 3.0M + let z6 = - (2.0M) + let z7 = abs (2.0M) +// let z9 = [ 1.0M .. 4.0M ] + let z10 = sign (3.0M) + + let x1d : decimal = ceil 4.4M + let x1h : decimal = floor 4.4M + let x1l : decimal = pown 4.4M 3 +#if !NETCOREAPP + let x1m : decimal = round 4.4M +#endif + let x1n : int = sign 4.4M + + //let x11d : decimal<1> = ceil 4.4M<1> + //let x11h : decimal<1> = floor 4.4M<1> + //let x11m : decimal<1> = round 4.4M<1> + let x11l : decimal<1> = pown 4.4M<1> 3 + let x11n : int = sign 4.4M<1> + + let z12 = Seq.sum [2.0M; 3.0M] + let z12a = Seq.sumBy (fun z -> z*z) [2.0M; 3.0M] + let z13 = Seq.average [2.0M; 3.0M] + let z13a = Seq.averageBy (fun z -> z*z) [2.0M; 3.0M] + + + // check the types and values! + test "z1" (z1 = 6.0M) + test "z2" (z2 = -2.0M) + test "z3" (z3 = 0.5M) + test "z3a" (z3a = 0.5M) + test "z3b" (z3b = 0.25M<1/s>) + test "z3c" (z3c = 0.25M) + test "z4" (z4 = 8.0M) + test "z4a" (z4a = 8.0M) + test "z4b" (z4b = 8.0M) + test "z4c" (z4c = 8.0M) + test "z5" (z5 = 2.0M) + test "z6" (z6 = -2.0M) + test "z7" (z7 = 2.0M) + test "z10" (z10 = 1) + test "z12" (z12 = 5.0M) + test "z12a" (z12a = 13.0M) + test "z13" (z13 = 2.5M) + test "z13a" (z13a = 6.5M) + + +module FLOAT_CHECKED = + open Microsoft.FSharp.Core.Operators.Checked + + // set up bindings + let x1 = 2.0 + 4.0 + let x2 = 2.0 - 4.0 + let x3 = 2.0 / 4.0 + let x3a = 2.0 / 4.0 + let x3b = 1.0 / 4.0 + let x3c = 1.0 / 4.0 + let x4 = 2.0 * 4.0 + let x4a = 2.0 * 4.0 + let x4b = 2.0 * 4.0 + let x4c = 2.0 * 4.0 + let x5 = 5.0 % 3.0 + let x6 = - (2.0) + let x7 = abs (-2.0) + let x8 = sqrt (4.0) + let x9 = [ 1.0 .. 1.0 .. 4.0 ] + let x10 = sign (3.0) + let x11 = atan2 4.4 5.4 + let x12 = Seq.sum [2.0; 3.0] + let x12a = Seq.sumBy (fun x -> x*x) [(2.0 : area); 3.0] + let x13 = (Seq.average [2.0; 3.0]) : area + let x13a = Seq.averageBy (fun x -> x*x) [2.0; 3.0] + let x14 = x13 + x13a + + // check the types and values! + test "x1" (x1 = 6.0) + test "x2" (x2 = -2.0) + test "x3" (x3 = 0.5) + test "x3a" (x3a = 0.5) + test "x3b" (x3b = 0.25<1/s>) + test "x3c" (x3c = 0.25) + test "x4" (x4 = 8.0) + test "x4a" (x4a = 8.0) + test "x4b" (x4b = 8.0) + test "x4c" (x4c = 8.0) + test "x5" (x5 = 2.0) + test "x6" (x6 = -2.0) + test "x7" (x7 = 2.0) + test "x8" (x8 = 2.0) + test "x9" (x9 = [1.0; 2.0; 3.0; 4.0]) + test "x10" (x10 = 1) + test "x12" (x12 = 5.0) + test "x12a" (x12a = 13.0) + test "x13" (x13 = 2.5) + test "x13a" (x13a = 6.5) + + +module FLOAT32_CHECKED = + open Microsoft.FSharp.Core.Operators.Checked + + let y1 = 2.0f + 4.0f + let y2 = 2.0f - 4.0f + let y3 = 2.0f / 4.0f + let y3a = 2.0f / 4.0f + let y3b = 1.0f / 4.0f + let y3c = 1.0f / 4.0f + let y4 = 2.0f * 4.0f + let y4a = 2.0f * 4.0f + let y4b = 2.0f * 4.0f + let y4c = 2.0f * 4.0f + let y5 = 5.0f % 3.0f + let y6 = - (2.0f) + let y7 = abs (2.0f) + let y8 = sqrt (4.0f) + let y9 = [ 1.0f .. 1.0f .. 4.0f ] + let y10 = sign (3.0f) + let y11 = atan2 4.4f 5.4f + let y12 = Seq.sum [2.0f; 3.0f] + let y12a = Seq.sumBy (fun y -> y*y) [2.0f; 3.0f] + let y13 = Seq.average [2.0f; 3.0f] + let y13a = Seq.averageBy (fun y -> y*y) [2.0f; 3.0f] + + // check the types and values! + test "y1" (y1 = 6.0f) + test "y2" (y2 = -2.0f) + test "y3" (y3 = 0.5f) + test "y3a" (y3a = 0.5f) + test "y3b" (y3b = 0.25f<1/s>) + test "y3c" (y3c = 0.25f) + test "y4" (y4 = 8.0f) + test "y4a" (y4a = 8.0f) + test "y4b" (y4b = 8.0f) + test "y4c" (y4c = 8.0f) + test "y5" (y5 = 2.0f) + test "y6" (y6 = -2.0f) + test "y7" (y7 = 2.0f) + test "y8" (y8 = 2.0f) + test "y9" (y9 = [1.0f; 2.0f; 3.0f; 4.0f]) + test "y10" (y10 = 1) + test "y12" (y12 = 5.0f) + test "y12a" (y12a = 13.0f) + test "y13" (y13 = 2.5f) + test "y13a" (y13a = 6.5f) + + +module DECIMAL_CHECKED = + open Microsoft.FSharp.Core.Operators.Checked + + let z1 = 2.0M + 4.0M + let z2 = 2.0M - 4.0M + let z3 = 2.0M / 4.0M + let z3a = 2.0M / 4.0M + let z3b = 1.0M / 4.0M + let z3c = 1.0M / 4.0M + let z4 = 2.0M * 4.0M + let z4a = 2.0M * 4.0M + let z4b = 2.0M * 4.0M + let z4c = 2.0M * 4.0M + let z5 = 5.0M % 3.0M + let z6 = - (2.0M) + let z7 = abs (2.0M) +// let z9 = [ 1.0M .. 4.0M ] + let z10 = sign (3.0M) + let z12 = Seq.sum [2.0M; 3.0M] + let z12a = Seq.sumBy (fun z -> z*z) [2.0M; 3.0M] + let z13 = Seq.average [2.0M; 3.0M] + let z13a = Seq.averageBy (fun z -> z*z) [2.0M; 3.0M] + + + // check the types and values! + test "z1" (z1 = 6.0M) + test "z2" (z2 = -2.0M) + test "z3" (z3 = 0.5M) + test "z3a" (z3a = 0.5M) + test "z3b" (z3b = 0.25M<1/s>) + test "z3c" (z3c = 0.25M) + test "z4" (z4 = 8.0M) + test "z4a" (z4a = 8.0M) + test "z4b" (z4b = 8.0M) + test "z4c" (z4c = 8.0M) + test "z5" (z5 = 2.0M) + test "z6" (z6 = -2.0M) + test "z7" (z7 = 2.0M) + test "z10" (z10 = 1) + test "z12" (z12 = 5.0M) + test "z12a" (z12a = 13.0M) + test "z13" (z13 = 2.5M) + test "z13a" (z13a = 6.5M) + + +module MembersTest = + let f = 2.0 + let s = 2.0f + let d = 2.0M + + let tmpCulture = System.Threading.Thread.CurrentThread.CurrentCulture + System.Threading.Thread.CurrentThread.CurrentCulture <- System.Globalization.CultureInfo("en-US") + test "f" (f.ToString().Equals("2")) + test "s" (s.ToString().Equals("2")) + test "d" (d.ToString().Equals("2.0")) + System.Threading.Thread.CurrentThread.CurrentCulture <- tmpCulture + + let fc = (f :> System.IComparable>).CompareTo(f+f) + let sc = (s :> System.IComparable>).CompareTo(s+s) + let dc = (d :> System.IComparable>).CompareTo(d+d) + test "fc" (fc = -1) + test "sc" (sc = -1) + test "dc" (dc = -1) + + let f1 = (f :> System.IFormattable) + let f2 = (f :> System.IComparable) + let f3 = (f :> System.IEquatable>) +#if !NETCOREAPP + let f4 = (f :> System.IConvertible) +#endif + +module WrappedFloatTypeTest = + type C<[] 'T> (v:float<'T>) = + member x.V : float<'T> = v // note, a type annotation is needed here to allow generic recursion + static member (+) (c1:C<'T>,c2:C<'T>) = C<'T>(c1.V + c2.V) + static member (*) (c1:C<'T>,c2:C<'U>) = C<'T 'U>(c1.V * c2.V) + static member (/) (c1:C<'T>,c2:C<'U>) = C<'T / 'U>(c1.V / c2.V) + static member (-) (c1:C<'T>,c2:C<'T>) = C<'T>(c1.V - c2.V) + static member Sqrt (c1:C<_>) = C<_>(sqrt c1.V) + static member Abs (c1:C<_>) = C<_>(abs c1.V) + static member Acos (c1:C<1>) = C<1>(acos c1.V) + static member Asin (c1:C<1>) = C<1>(asin c1.V) + static member Atan (c1:C<1>) = C<1>(atan c1.V) + static member Atan2 (c1:C<'u>,c2:C<'u>) = C<1>(atan2 c1.V c2.V) + static member Ceiling (c1:C<1>) = C<1>(ceil c1.V) + static member Floor (c1:C<1>) = C<1>(floor c1.V) + member c1.Sign = sign c1.V + static member Round (c1:C<1>) = C<1>(round c1.V) +#if LOGC + static member Log (c1:C<'u>) = LogC<'u>(log (float c1.V)) +#else + static member Exp (c1:C<1>) = C<1>(exp (float c1.V)) + static member Log (c1:C<1>) = C<1>(log (float c1.V)) +#endif + static member Log10 (c1:C<1>) = C<1>(log10 (float c1.V)) + static member Cos (c1:C<1>) = C<1>(cos c1.V) + static member Cosh (c1:C<1>) = C<1>(cosh c1.V) + static member Sin (c1:C<1>) = C<1>(sin c1.V) + static member Sinh (c1:C<1>) = C<1>(sinh c1.V) + static member Tanh (c1:C<1>) = C<1>(tan c1.V) +#if !NETCOREAPP + static member Truncate (c1:C<1>) = C<1>(truncate c1.V) +#endif + static member Pow (c1:C<1>,c2:C<1>) = C<1>( c1.V ** c2.V) + static member Mul (c1:C<'T>,c2:C<'U>) = C<'T 'U>(c1.V * c2.V) +#if LOGC + and LogC<[] 'T> (v:float) = + member x.UnsafeV = v + static member Exp (c1:LogC<'U>) = C<'U>(exp c1.UnsafeV |> box |> unbox) +#endif + + [] + type kg + + //let v1 = pown 3.0 2 + // let v2 = pown 3.0 1 + // let x = acos (3.0<_>) + //acosr 3.0 : 3.0 + + let c1 = C(3.0) + let c2 = C(4.0) + + let c3 = c1 + c2 + let c5 = c1 * c2 + let c6 = c1 / c2 + let c7 = c1 - c2 + let c8a : C = c1 * c1 + let c8b = C.Sqrt c8a + let c8 = sqrt c8a + let c9 = acos (C<1>(0.5)) + let c11 = abs (C<1>(0.5)) + let c12 = asin (C<1>(0.5)) + let c13 = atan (C<1>(0.5)) + let c14 = atan2 (C<1>(0.5)) (C<1>(0.5)) + let c15 = atan2 (C(0.5)) (C(0.5)) + let c16 = ceil (C<1>(0.5)) + let c17 = exp (C<1>(0.5)) + let c18 = floor (C<1>(0.5)) + let c19 = sign (C<1>(0.5)) + let c20 = sign (C<1>(0.5)) + let c21 = round (C<1>(0.5)) + let c22 = log (C<1>(0.5)) + let c23 = log10 (C<1>(0.5)) + let c24 = cos (C<1>(0.5)) + let c25 = cosh (C<1>(0.5)) + let c26 = sin (C<1>(0.5)) + let c27 = sinh (C<1>(0.5)) + let c28 = tanh (C<1>(0.5)) +#if !NETCOREAPP + let c29 = truncate (C<1>(0.5)) +#endif + let c30 = C<1>(0.5) ** C<1>(2.0) + let c31 = C<1>.Mul (C<1>(0.5),C<1>(2.0)) + let c32 = C.Mul (C(0.5),C(2.0)) + diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/members_basics.fs b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/members_basics.fs new file mode 100644 index 00000000000..5107dd919d4 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/members_basics.fs @@ -0,0 +1,3454 @@ +module Global + +let (!) (r: 'T ref) = r.Value +let (:=) (r: 'T ref) (v: 'T) = r.Value <- v +let incr (r: int ref) = r.Value <- r.Value + 1 +let decr (r: int ref) = r.Value <- r.Value - 1 + +#nowarn "62" +#nowarn "25" +#nowarn "49" +#nowarn "52" +#nowarn "60" +#nowarn "69" + +let failures = ref [] + +let report_failure (s : string) = + stderr.Write" NO: " + stderr.WriteLine s + failures := !failures @ [s] + +let test (s : string) b = + stderr.Write(s) + if b then stderr.WriteLine " OK" + else report_failure (s) + +let check s b1 b2 = test s (b1 = b2) + +//-------------------------------------------------------------- +// Test defining a record using object-expression syntax + +type RecordType = { a: int; mutable b: int } + +let rval = { new RecordType with a = 1 and b = 2 } + +do test "fweoew091" (rval.a = 1) +do test "fweoew092" (rval.b = 2) +do rval.b <- 3 +do test "fweoew093" (rval.b = 3) + +type RecordType2<'a,'b> = { a: 'a; mutable b: 'b } + +let rval2 = { new RecordType2 with a = 1 and b = 2 } + +do test "fweoew091" (rval2.a = 1) +do test "fweoew092" (rval2.b = 2) +do rval2.b <- 3 +do test "fweoew093" (rval2.b = 3) + +let f(x) = + { new RecordType2<'a,int> with a = x and b = 2 } + +do test "fweoew091" ((f(1)).a = 1) +do test "fweoew092" ((f(1)).b = 2) +do (f(1)).b <- 3 +do test "fweoew093" ((f(1)).b = 2) + + +open System +open System.Collections +//open System.Windows.Forms + +//----------------------------------------- +// Some simple object-expression tests + +let x0 = { new System.Object() with member __.GetHashCode() = 3 } +//let x1 = { new System.Windows.Forms.Form() with member __.GetHashCode() = 3 } + +//----------------------------------------- +// Test defining an F# class + + +type ClassType1 = + class + inherit System.Object + val someField : string + + interface IEnumerable + + abstract VirtualMethod1: string -> int + abstract VirtualMethod2: string * string -> int + abstract VirtualMethod1PostHoc: string -> int + abstract VirtualMethod2PostHoc: string * string -> int + default x.VirtualMethod1(s) = 3 + default x.VirtualMethod2(s1,s2) = 3 + + new(s: string) = { inherit System.Object(); someField = "abc" } + end + +type ClassType1 + with + default x.VirtualMethod1PostHoc(s) = 3 + default x.VirtualMethod2PostHoc(s1,s2) = 3 + new(s1,s2) = { inherit System.Object(); someField = "constructor2" + s1 + s2 } + end + +type ClassType1 + with + interface IEnumerable with + member x.GetEnumerator() = failwith "no implementation" + end + + end + +let x2 = { new ClassType1("a") with member __.GetHashCode() = 3 } +let x3 = { new ClassType1("a") with member __.VirtualMethod1(s) = 4 } +let x4 = { new ClassType1("a") with + member __.VirtualMethod1(s) = 5 + member __.VirtualMethod2(s1,s2) = s1.Length + s2.Length } + + + +do test "e09wckj2d" (try ignore((x2 :> IEnumerable).GetEnumerator()); false with Failure "no implementation" -> true) + +do test "e09wckj2ddwdw" (try ignore(((x2 :> obj) :?> IEnumerable).GetEnumerator()); false with Failure "no implementation" -> true) +do test "e09wckj2defwe" (x2.VirtualMethod1("abc") = 3) +do test "e09wckd2jfew3" (x3.VirtualMethod1("abc") = 4) +do test "e09wckf3q2j" (x4.VirtualMethod1("abc") = 5) +do test "e09wckj321" (x4.VirtualMethod2("abc","d") = 4) + + +//----------------------------------------- +// Test inheriting from an F# type + + +type ClassType2 = + class + inherit ClassType1 + val someField2 : string + + override x.VirtualMethod1(s) = 2001 + override x.VirtualMethod2(s1,s2) = s1.Length + s2.Length + String.length x.someField2 + + new(s) = { inherit ClassType1(s); someField2 = s } + end + + +let x22 = { new ClassType2("a") with member __.GetHashCode() = 3 } +let x32 = { new ClassType2("abc") with member __.VirtualMethod1(s) = 4002 } +let x42 = { new ClassType2("abcd") with + member __.VirtualMethod1(s) = 5004 + member __.VirtualMethod2(s1,s2) = 500 + s1.Length + s2.Length } + +do test "e09wckj2ddwdw" (ignore(((x22 :> obj) :?> ClassType1)); true) +do test "e09wckj2ddwdw" (ignore((x22 :> ClassType1)); true) + +do test "e09wckjd3" (x22.VirtualMethod1("abc") = 2001) +do test "e09wckjd3" (x32.VirtualMethod1("abc") = 4002) +do test "e09wckjfew" (x42.VirtualMethod1("abc") = 5004) +do test "e09wckjd3" (x22.VirtualMethod2("abcd","dqw") = 8) +do test "e09wckjd3" (x32.VirtualMethod2("abcd","dqw") = 10) + + + +//----------------------------------------- +// Test defining an F# class + + +module AbstractClassTest = begin + + [] + type ClassType1 = + class + inherit System.Object + val someField : string + + interface IEnumerable + + abstract AbstractMethod1: string -> int + abstract AbstractMethod2: string * string -> int + + new(s: string) = { inherit System.Object(); someField = "abc" } + end + + type ClassType1 + with + interface IEnumerable with + member x.GetEnumerator() = failwith "no implementation" + end + + end + + //let shouldGiveError1 = { new ClassType1("a") with GetHashCode() = 3 } + //let shouldGiveError2 = { new ClassType1("a") with AbstractMethod1(s) = 4 } + //let shouldGiveError3a = new ClassType1("a") + let x4 = { new ClassType1("a") with + member __.AbstractMethod1(s) = 5 + member __.AbstractMethod2(s1,s2) = s1.Length + s2.Length } + + + do test "e09wckj2d" (try ignore((x2 :> IEnumerable).GetEnumerator()); false with Failure "no implementation" -> true) + + do test "e09wckj2ddwdw" (try ignore(((x2 :> obj) :?> IEnumerable).GetEnumerator()); false with Failure "no implementation" -> true) + do test "e09wckf3q2j" (x4.AbstractMethod1("abc") = 5) + do test "e09wckj321" (x4.AbstractMethod2("abc","d") = 4) + + + type ClassType2 = + class + inherit ClassType1 + val someField2 : string + + override x.AbstractMethod1(s) = 2001 + override x.AbstractMethod2(s1,s2) = s1.Length + s2.Length + String.length x.someField2 + + new(s) = { inherit ClassType1(s); someField2 = s } + end + + + let x22 = { new ClassType2("a") with member __.GetHashCode() = 3 } + let x32 = { new ClassType2("abc") with member __.AbstractMethod1(s) = 4002 } + let x42 = { new ClassType2("abcd") with + member __.AbstractMethod1(s) = 5004 + member __.AbstractMethod2(s1,s2) = 500 + s1.Length + s2.Length } + + do test "e09wckj2ddwdw" (ignore(((x22 :> obj) :?> ClassType1)); true) + do test "e09wckj2ddwdw" (ignore((x22 :> ClassType1)); true) + + do test "e09wckjd3" (x22.AbstractMethod1("abc") = 2001) + do test "e09wckjd3" (x32.AbstractMethod1("abc") = 4002) + do test "e09wckjfew" (x42.AbstractMethod1("abc") = 5004) + do test "e09wckjd3" (x22.AbstractMethod2("abcd","dqw") = 8) + do test "e09wckjd3" (x32.AbstractMethod2("abcd","dqw") = 10) + + type ClassType3 = + class + inherit ClassType2 + val someField3 : string + + override x.AbstractMethod1(s) = 2001 + override x.AbstractMethod2(s1,s2) = s1.Length + s2.Length + String.length x.someField2 + x.someField3.Length + + new(s) = { inherit ClassType2(s); someField3 = s } + end + + + +end + +//----------------------------------------- +//----------------------------------------- + + + + +// Various rejected syntaxes for constructors: +// new(s: string) = { base=new Form(); x = "abc" } +// new ClassType1(s: string) : base() = { x = "abc" } +// new(s: string) = { inherit Form(); x = "abc" } +// member ClassType1(s: string) = new { inherit Form(); x = "abc" } +// member ClassType1(s: string) = { inherit Form(); x = "abc" } +// initializer(s: string) = { inherit Form(); x = "abc" } +// new ClassType1(s: string) = { inherit Form(); x = "abc" } + +// new(s: string) = { inherit Form(); x = "abc" } + +// new((s: string), (s2:string)) = { inherit Form(); x = s } + + +// abstract AbstractProperty: string +// abstract AbstractMutableProperty: string with get,set + + +// new(s: string) = { new ClassType1 with base=new Object() and x = "abc" } +// new(s: string) = { new ClassType1 with base=new Form() and x = "abc" } +// new(s: string) = ((new System.Object()) :?> ClassType1) + + +//----------------------------------------- +// Thorough testing of members for records. + +module RecordTypeTest = begin + + type AbstractType = + { instanceField: string; + mutable mutableInstanceField: string; + instanceArray: string array; + instanceArray2: string array array; + mutableInstanceArray: string array; + mutableInstanceArray2: string array array; + recursiveInstance: AbstractType; + } + + let staticField = "staticField" + let mutableStaticField = ref "mutableStaticFieldInitialValue" + let staticArray = [| "staticArrayElement1"; "staticArrayElement2" |] + let mutableStaticArray = [| "mutableStaticArrayElement1InitialValue"; "mutableStaticArrayElement2InitialValue" |] + + let NewAbstractValue(s) = + let rec self = + { instanceField=s; + mutableInstanceField=s; + instanceArray=[| s;s |]; + instanceArray2=[| [| s;s |];[| s;s |] |]; + mutableInstanceArray =[| s;s |]; + mutableInstanceArray2 =[| [| s;s |];[| s;s |] |]; + recursiveInstance=self; + } in + self + + type AbstractType + with + // properties + override x.ToString() = x.instanceField + member x.InstanceProperty = x.instanceField + ".InstanceProperty" + member x.RecursiveInstance = x.recursiveInstance + member x.RecursiveInstanceMethod() = x.recursiveInstance + member x.MutableInstanceProperty + with get() = x.mutableInstanceField + and set(v:string) = x.mutableInstanceField <- v + + member x.InstanceIndexerCount = Array.length x.instanceArray + + member x.InstanceIndexer + with get(idx) = x.instanceArray.[idx] + member x.InstanceIndexer2 + with get(idx1,idx2) = x.instanceArray2.[idx1].[idx2] + member x.InstanceIndexer2Count1 = 2 + member x.InstanceIndexer2Count2 = 2 + + member x.MutableInstanceIndexerCount = Array.length x.mutableInstanceArray + + member x.MutableInstanceIndexer + with get (idx1) = x.mutableInstanceArray.[idx1] + and set (idx1) (v:string) = x.mutableInstanceArray.[idx1] <- v + + member x.MutableInstanceIndexer2 + with get (idx1,idx2) = x.mutableInstanceArray2.[idx1].[idx2] + and set (idx1,idx2) (v:string) = x.mutableInstanceArray2.[idx1].[idx2] <- v + member x.MutableInstanceIndexer2Count1 = 2 + member x.MutableInstanceIndexer2Count2 = 2 + + static member StaticProperty = staticField + static member MutableStaticProperty + with get() = !mutableStaticField + and set(v:string) = mutableStaticField := v + + static member StaticIndexer + with get(idx) = staticArray.[idx] + + static member StaticIndexerCount = Array.length staticArray + + static member MutableStaticIndexer + with get(idx:int) = mutableStaticArray.[idx] + and set(idx:int) (v:string) = mutableStaticArray.[idx] <- v + + static member MutableStaticIndexerCount = Array.length mutableStaticArray + + // methods + member x.InstanceMethod(s1:string) = Printf.sprintf "%s.InstanceMethod(%s)" x.instanceField s1 + static member StaticMethod((s1:string),(s2:string)) = Printf.sprintf "AbstractType.StaticMethod(%s,%s)" s1 s2 + + // private versions of the above + member x.PrivateInstanceProperty = x.instanceField + ".InstanceProperty" + member x.PrivateMutableInstanceProperty + with get() = x.mutableInstanceField + and set(v:string) = x.mutableInstanceField <- v + + member x.PrivateInstanceIndexerCount = Array.length x.instanceArray + + member x.PrivateInstanceIndexer + with get(idx) = x.instanceArray.[idx] + member x.PrivateInstanceIndexer2 + with get(idx1,idx2) = x.instanceArray2.[idx1].[idx2] + member x.PrivateInstanceIndexer2Count1 = 2 + member x.PrivateInstanceIndexer2Count2 = 2 + + member x.PrivateMutableInstanceIndexerCount = Array.length x.mutableInstanceArray + + member x.PrivateMutableInstanceIndexer + with get (idx1) = x.mutableInstanceArray.[idx1] + and set (idx1) (v:string) = x.mutableInstanceArray.[idx1] <- v + + member x.PrivateMutableInstanceIndexer2 + with get (idx1,idx2) = x.mutableInstanceArray2.[idx1].[idx2] + and set (idx1,idx2) (v:string) = x.mutableInstanceArray2.[idx1].[idx2] <- v + member x.PrivateMutableInstanceIndexer2Count1 = 2 + member x.PrivateMutableInstanceIndexer2Count2 = 2 + + static member PrivateStaticProperty = staticField + static member PrivateMutableStaticProperty + with get() = !mutableStaticField + and set(v:string) = mutableStaticField := v + + static member PrivateStaticIndexer + with get(idx) = staticArray.[idx] + + static member PrivateStaticIndexerCount = Array.length staticArray + + static member PrivateMutableStaticIndexer + with get(idx:int) = mutableStaticArray.[idx] + and set(idx:int) (v:string) = mutableStaticArray.[idx] <- v + + static member PrivateMutableStaticIndexerCount = Array.length mutableStaticArray + + // methods + member x.PrivateInstanceMethod(s1:string) = Printf.sprintf "%s.InstanceMethod(%s)" x.instanceField s1 + static member PrivateStaticMethod((s1:string),(s2:string)) = Printf.sprintf "AbstractType.StaticMethod(%s,%s)" s1 s2 + + + end + + + + // Test accesses of static properties, methods + do System.Console.WriteLine("AbstractType.StaticProperty = {0}", AbstractType.StaticProperty) + do AbstractType.MutableStaticProperty <- "MutableStaticProperty (mutated!)" + do System.Console.WriteLine("AbstractType.StaticIndexer(0) = {0}", AbstractType.StaticIndexer(0) ) + do System.Console.WriteLine("AbstractType.StaticMethod(abc,def) = {0}", AbstractType.StaticMethod("abc","def") ) + do System.Console.WriteLine("AbstractType.PrivateStaticProperty = {0}", AbstractType.PrivateStaticProperty ) + do AbstractType.PrivateMutableStaticProperty <- "PrivateMutableStaticProperty (mutated!)" + do System.Console.WriteLine("AbstractType.PrivateStaticIndexer(0) = {0}", AbstractType.PrivateStaticIndexer(0) ) + do System.Console.WriteLine("AbstractType.PrivateStaticMethod(abc,def) = {0}", AbstractType.PrivateStaticMethod("abc","def") ) + + // Torture this poor object + let xval = NewAbstractValue("abc") + + // Test dynamic rediscovery of type + do test "e09wckdw" (not ((xval :> obj) :? IEnumerable)) + do test "e09wckdwddw" (not ((xval :> obj) :? string)) + do test "e09dwdw" (not ((xval :> obj) :? list)) + do test "e09dwwd2" ((xval :> obj) :? AbstractType) + + // Test access of instance properties, methods through variables + do System.Console.WriteLine("abc.instanceField = {0}", xval.instanceField) + do System.Console.WriteLine("abc.InstanceMethod(def) = {0}", xval.InstanceMethod("def") ) + do System.Console.WriteLine("abc.InstanceProperty = {0}", xval.InstanceProperty ) + do System.Console.WriteLine("abc.InstanceIndexer(0) = {0}", xval.InstanceIndexer(0) ) + do System.Console.WriteLine("abc.InstanceIndexer2(0,1) = {0}", xval.InstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.MutableInstanceProperty ) + do xval.MutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.MutableInstanceProperty ) + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", xval.MutableInstanceIndexer(0) ) + do xval.MutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", xval.MutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", xval.MutableInstanceIndexer2(0,1) ) + do xval.MutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", xval.MutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.MutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceMethod(def) = {0}", xval.PrivateInstanceMethod("def") ) + do System.Console.WriteLine("abc.PrivateInstanceProperty = {0}", xval.PrivateInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer(0) = {0}", xval.PrivateInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer2(0,1) = {0}", xval.PrivateInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.PrivateMutableInstanceProperty ) + do xval.PrivateMutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.PrivateMutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", xval.PrivateMutableInstanceIndexer(0) ) + do xval.PrivateMutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", xval.PrivateMutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", xval.PrivateMutableInstanceIndexer2(0,1) ) + do xval.PrivateMutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", xval.PrivateMutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc..PrivateMutableInstanceProperty = {0}", xval.PrivateMutableInstanceProperty ) + + // repeat all the above through a long-path field lookup + do System.Console.WriteLine("abc.instanceField = {0}", xval.recursiveInstance.instanceField) + do System.Console.WriteLine("abc.InstanceMethod(def) = {0}", xval.recursiveInstance.InstanceMethod("def") ) + do System.Console.WriteLine("abc.InstanceProperty = {0}", xval.recursiveInstance.InstanceProperty ) + do System.Console.WriteLine("abc.InstanceIndexer(0) = {0}", xval.recursiveInstance.InstanceIndexer(0) ) + do System.Console.WriteLine("abc.InstanceIndexer2(0,1) = {0}", xval.recursiveInstance.InstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.recursiveInstance.MutableInstanceProperty ) + do xval.recursiveInstance.MutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.recursiveInstance.MutableInstanceProperty ) + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", xval.recursiveInstance.MutableInstanceIndexer(0) ) + do xval.recursiveInstance.MutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", xval.recursiveInstance.MutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", xval.recursiveInstance.MutableInstanceIndexer2(0,1) ) + do xval.recursiveInstance.MutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", xval.recursiveInstance.MutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.recursiveInstance.MutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceMethod(def) = {0}", xval.recursiveInstance.PrivateInstanceMethod("def") ) + do System.Console.WriteLine("abc.PrivateInstanceProperty = {0}", xval.recursiveInstance.PrivateInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer(0) = {0}", xval.recursiveInstance.PrivateInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer2(0,1) = {0}", xval.recursiveInstance.PrivateInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.recursiveInstance.PrivateMutableInstanceProperty ) + do xval.recursiveInstance.PrivateMutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.recursiveInstance.PrivateMutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", xval.recursiveInstance.PrivateMutableInstanceIndexer(0) ) + do xval.recursiveInstance.PrivateMutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", xval.recursiveInstance.PrivateMutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", xval.recursiveInstance.PrivateMutableInstanceIndexer2(0,1) ) + do xval.recursiveInstance.PrivateMutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", xval.recursiveInstance.PrivateMutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.recursiveInstance.PrivateMutableInstanceProperty ) + + + // repeat all the above through a long-path property lookup + do System.Console.WriteLine("abc.instanceField = {0}", xval.RecursiveInstance.instanceField) + do System.Console.WriteLine("abc.InstanceMethod(def) = {0}", xval.RecursiveInstance.InstanceMethod("def") ) + do System.Console.WriteLine("abc.InstanceProperty = {0}", xval.RecursiveInstance.InstanceProperty ) + do System.Console.WriteLine("abc.InstanceIndexer(0) = {0}", xval.RecursiveInstance.InstanceIndexer(0) ) + do System.Console.WriteLine("abc.InstanceIndexer2(0,1) = {0}", xval.RecursiveInstance.InstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.RecursiveInstance.MutableInstanceProperty ) + do xval.RecursiveInstance.MutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.RecursiveInstance.MutableInstanceProperty ) + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", xval.RecursiveInstance.MutableInstanceIndexer(0) ) + do xval.RecursiveInstance.MutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", xval.RecursiveInstance.MutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", xval.RecursiveInstance.MutableInstanceIndexer2(0,1) ) + do xval.RecursiveInstance.MutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", xval.RecursiveInstance.MutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.RecursiveInstance.MutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceMethod(def) = {0}", xval.RecursiveInstance.PrivateInstanceMethod("def") ) + do System.Console.WriteLine("abc.PrivateInstanceProperty = {0}", xval.RecursiveInstance.PrivateInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer(0) = {0}", xval.RecursiveInstance.PrivateInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer2(0,1) = {0}", xval.RecursiveInstance.PrivateInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.RecursiveInstance.PrivateMutableInstanceProperty ) + do xval.RecursiveInstance.PrivateMutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.RecursiveInstance.PrivateMutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", xval.RecursiveInstance.PrivateMutableInstanceIndexer(0) ) + do xval.RecursiveInstance.PrivateMutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", xval.RecursiveInstance.PrivateMutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", xval.RecursiveInstance.PrivateMutableInstanceIndexer2(0,1) ) + do xval.RecursiveInstance.PrivateMutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", xval.RecursiveInstance.PrivateMutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.RecursiveInstance.PrivateMutableInstanceProperty ) + + // repeat all the above through a long-path method lookup + do System.Console.WriteLine("abc.instanceField = {0}", (xval.RecursiveInstanceMethod()).instanceField) + do System.Console.WriteLine("abc.InstanceMethod(def) = {0}", (xval.RecursiveInstanceMethod()).InstanceMethod("def") ) + do System.Console.WriteLine("abc.InstanceProperty = {0}", (xval.RecursiveInstanceMethod()).InstanceProperty ) + do System.Console.WriteLine("abc.InstanceIndexer(0) = {0}", (xval.RecursiveInstanceMethod()).InstanceIndexer(0) ) + do System.Console.WriteLine("abc.InstanceIndexer2(0,1) = {0}", (xval.RecursiveInstanceMethod()).InstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", (xval.RecursiveInstanceMethod()).MutableInstanceProperty ) + do (xval.RecursiveInstanceMethod()).MutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", (xval.RecursiveInstanceMethod()).MutableInstanceProperty ) + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", (xval.RecursiveInstanceMethod()).MutableInstanceIndexer(0) ) + do (xval.RecursiveInstanceMethod()).MutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", (xval.RecursiveInstanceMethod()).MutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", (xval.RecursiveInstanceMethod()).MutableInstanceIndexer2(0,1) ) + do (xval.RecursiveInstanceMethod()).MutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", (xval.RecursiveInstanceMethod()).MutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", (xval.RecursiveInstanceMethod()).MutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceMethod(def) = {0}", (xval.RecursiveInstanceMethod()).PrivateInstanceMethod("def") ) + do System.Console.WriteLine("abc.PrivateInstanceProperty = {0}", (xval.RecursiveInstanceMethod()).PrivateInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer(0) = {0}", (xval.RecursiveInstanceMethod()).PrivateInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer2(0,1) = {0}", (xval.RecursiveInstanceMethod()).PrivateInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", (xval.RecursiveInstanceMethod()).PrivateMutableInstanceProperty ) + do (xval.RecursiveInstanceMethod()).PrivateMutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", (xval.RecursiveInstanceMethod()).PrivateMutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", (xval.RecursiveInstanceMethod()).PrivateMutableInstanceIndexer(0) ) + do (xval.RecursiveInstanceMethod()).PrivateMutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", (xval.RecursiveInstanceMethod()).PrivateMutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", (xval.RecursiveInstanceMethod()).PrivateMutableInstanceIndexer2(0,1) ) + do (xval.RecursiveInstanceMethod()).PrivateMutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", (xval.RecursiveInstanceMethod()).PrivateMutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", (xval.RecursiveInstanceMethod()).PrivateMutableInstanceProperty ) + +end + +//----------------------------------------- +// Thorough testing of members for records. + +module UnionTypeTest = begin + + type AbstractType = A of AbstractType | B of string + + let staticField = "staticField" + let mutableStaticField = ref "mutableStaticFieldInitialValue" + let staticArray = [| "staticArrayElement1"; "staticArrayElement2" |] + let mutableStaticArray = [| "mutableStaticArrayElement1InitialValue"; "mutableStaticArrayElement2InitialValue" |] + + let NewAbstractValue(s) = B(s) + + type AbstractType + with + // properties + override x.ToString() = match x with A _ -> "A" | B(s) -> "B" + member x.InstanceProperty = "instanceProperty" + member x.RecursiveInstance = match x with A y -> y | B s -> x + member x.RecursiveInstanceMethod() = x.RecursiveInstance + member x.MutableInstanceProperty + with get() = x.InstanceProperty + and set(v:string) = Printf.printf "called MutableInstanceProperty.set\n" + + member x.InstanceIndexerCount = 1 + + member x.InstanceIndexer + with get(idx) = "a" + member x.InstanceIndexer2 + with get(idx1,idx2) = "a" + member x.InstanceIndexer2Count1 = 2 + member x.InstanceIndexer2Count2 = 2 + + member x.MutableInstanceIndexerCount = 1 + + member x.MutableInstanceIndexer + with get (idx1) = "a" + and set (idx1) (v:string) = Printf.printf "called MutableInstanceIndexer.set\n" + + member x.MutableInstanceIndexer2 + with get (idx1,idx2) = "a" + and set (idx1,idx2) (v:string) = Printf.printf "called MutableInstanceIndexer2.set\n" + member x.MutableInstanceIndexer2Count1 = 2 + member x.MutableInstanceIndexer2Count2 = 2 + + static member StaticProperty = staticField + static member MutableStaticProperty + with get() = !mutableStaticField + and set(v:string) = mutableStaticField := v + + static member StaticIndexer + with get(idx) = staticArray.[idx] + + static member StaticIndexerCount = Array.length staticArray + + static member MutableStaticIndexer + with get(idx:int) = mutableStaticArray.[idx] + and set(idx:int) (v:string) = mutableStaticArray.[idx] <- v + + static member MutableStaticIndexerCount = Array.length mutableStaticArray + + // methods + member x.InstanceMethod(s1:string) = Printf.sprintf "InstanceMethod(%s)" s1 + static member StaticMethod((s1:string),(s2:string)) = Printf.sprintf "AbstractType.StaticMethod(%s,%s)" s1 s2 + + // private versions of the above + member x.PrivateInstanceProperty = "InstanceProperty" + member x.PrivateMutableInstanceProperty + with get() = "a" + and set(v:string) = Printf.printf "called mutator\n" + + member x.PrivateInstanceIndexerCount = 1 + + member x.PrivateInstanceIndexer + with get(idx) = "b" + member x.PrivateInstanceIndexer2 + with get(idx1,idx2) = "c" + member x.PrivateInstanceIndexer2Count1 = 1 + member x.PrivateInstanceIndexer2Count2 = 1 + + member x.PrivateMutableInstanceIndexerCount = 3 + + member x.PrivateMutableInstanceIndexer + with get (idx1) = "a" + and set (idx1) (v:string) = Printf.printf "called mutator\n" + + member x.PrivateMutableInstanceIndexer2 + with get (idx1,idx2) = "a" + and set (idx1,idx2) (v:string) = Printf.printf "called mutator\n" + member x.PrivateMutableInstanceIndexer2Count1 = 2 + member x.PrivateMutableInstanceIndexer2Count2 = 2 + + static member PrivateStaticProperty = staticField + static member PrivateMutableStaticProperty + with get() = !mutableStaticField + and set(v:string) = mutableStaticField := v + + static member PrivateStaticIndexer + with get(idx) = staticArray.[idx] + + static member PrivateStaticIndexerCount = Array.length staticArray + + static member PrivateMutableStaticIndexer + with get(idx:int) = mutableStaticArray.[idx] + and set(idx:int) (v:string) = mutableStaticArray.[idx] <- v + + static member PrivateMutableStaticIndexerCount = Array.length mutableStaticArray + + // methods + member x.PrivateInstanceMethod(s1:string) = Printf.sprintf "InstanceMethod(%s)" s1 + static member PrivateStaticMethod((s1:string),(s2:string)) = Printf.sprintf "AbstractType.StaticMethod(%s,%s)" s1 s2 + + end + + + + // Test accesses of static properties, methods + do System.Console.WriteLine("AbstractType.StaticProperty = {0}", AbstractType.StaticProperty) + do AbstractType.MutableStaticProperty <- "MutableStaticProperty (mutated!)" + do System.Console.WriteLine("AbstractType.StaticIndexer(0) = {0}", AbstractType.StaticIndexer(0) ) + do System.Console.WriteLine("AbstractType.StaticMethod(abc,def) = {0}", AbstractType.StaticMethod("abc","def") ) + do System.Console.WriteLine("AbstractType.PrivateStaticProperty = {0}", AbstractType.PrivateStaticProperty ) + do AbstractType.PrivateMutableStaticProperty <- "PrivateMutableStaticProperty (mutated!)" + do System.Console.WriteLine("AbstractType.PrivateStaticIndexer(0) = {0}", AbstractType.PrivateStaticIndexer(0) ) + do System.Console.WriteLine("AbstractType.PrivateStaticMethod(abc,def) = {0}", AbstractType.PrivateStaticMethod("abc","def") ) + + // Torture this poor object + let xval = NewAbstractValue("abc") + + // Test dynamic rediscovery of type + do test "e09wckdw" (not ((xval :> obj) :? IEnumerable)) + do test "e09wckdwddw" (not ((xval :> obj) :? string)) + do test "e09dwdw" (not ((xval :> obj) :? list)) + do test "e09dwwd2" ((xval :> obj) :? AbstractType) + + // Test access of instance properties, methods through variables + + do System.Console.WriteLine("abc.InstanceMethod(def) = {0}", xval.InstanceMethod("def") ) + do System.Console.WriteLine("abc.InstanceProperty = {0}", xval.InstanceProperty ) + do System.Console.WriteLine("abc.InstanceIndexer(0) = {0}", xval.InstanceIndexer(0) ) + do System.Console.WriteLine("abc.InstanceIndexer2(0,1) = {0}", xval.InstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.MutableInstanceProperty ) + do xval.MutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.MutableInstanceProperty ) + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", xval.MutableInstanceIndexer(0) ) + do xval.MutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", xval.MutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", xval.MutableInstanceIndexer2(0,1) ) + do xval.MutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", xval.MutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.MutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceMethod(def) = {0}", xval.PrivateInstanceMethod("def") ) + do System.Console.WriteLine("abc.PrivateInstanceProperty = {0}", xval.PrivateInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer(0) = {0}", xval.PrivateInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer2(0,1) = {0}", xval.PrivateInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.PrivateMutableInstanceProperty ) + do xval.PrivateMutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.PrivateMutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", xval.PrivateMutableInstanceIndexer(0) ) + do xval.PrivateMutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", xval.PrivateMutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", xval.PrivateMutableInstanceIndexer2(0,1) ) + do xval.PrivateMutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", xval.PrivateMutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc..PrivateMutableInstanceProperty = {0}", xval.PrivateMutableInstanceProperty ) + + // repeat all the above through a long-path field lookup + + do System.Console.WriteLine("abc.InstanceMethod(def) = {0}", xval.RecursiveInstance.InstanceMethod("def") ) + do System.Console.WriteLine("abc.InstanceProperty = {0}", xval.RecursiveInstance.InstanceProperty ) + do System.Console.WriteLine("abc.InstanceIndexer(0) = {0}", xval.RecursiveInstance.InstanceIndexer(0) ) + do System.Console.WriteLine("abc.InstanceIndexer2(0,1) = {0}", xval.RecursiveInstance.InstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.RecursiveInstance.MutableInstanceProperty ) + do xval.RecursiveInstance.MutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.RecursiveInstance.MutableInstanceProperty ) + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", xval.RecursiveInstance.MutableInstanceIndexer(0) ) + do xval.RecursiveInstance.MutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", xval.RecursiveInstance.MutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", xval.RecursiveInstance.MutableInstanceIndexer2(0,1) ) + do xval.RecursiveInstance.MutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", xval.RecursiveInstance.MutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.RecursiveInstance.MutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceMethod(def) = {0}", xval.RecursiveInstance.PrivateInstanceMethod("def") ) + do System.Console.WriteLine("abc.PrivateInstanceProperty = {0}", xval.RecursiveInstance.PrivateInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer(0) = {0}", xval.RecursiveInstance.PrivateInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer2(0,1) = {0}", xval.RecursiveInstance.PrivateInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.RecursiveInstance.PrivateMutableInstanceProperty ) + do xval.RecursiveInstance.PrivateMutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.RecursiveInstance.PrivateMutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", xval.RecursiveInstance.PrivateMutableInstanceIndexer(0) ) + do xval.RecursiveInstance.PrivateMutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", xval.RecursiveInstance.PrivateMutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", xval.RecursiveInstance.PrivateMutableInstanceIndexer2(0,1) ) + do xval.RecursiveInstance.PrivateMutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", xval.RecursiveInstance.PrivateMutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.RecursiveInstance.PrivateMutableInstanceProperty ) + + + // repeat all the above through a long-path property lookup + do System.Console.WriteLine("abc.InstanceMethod(def) = {0}", xval.RecursiveInstance.InstanceMethod("def") ) + do System.Console.WriteLine("abc.InstanceProperty = {0}", xval.RecursiveInstance.InstanceProperty ) + do System.Console.WriteLine("abc.InstanceIndexer(0) = {0}", xval.RecursiveInstance.InstanceIndexer(0) ) + do System.Console.WriteLine("abc.InstanceIndexer2(0,1) = {0}", xval.RecursiveInstance.InstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.RecursiveInstance.MutableInstanceProperty ) + do xval.RecursiveInstance.MutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.RecursiveInstance.MutableInstanceProperty ) + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", xval.RecursiveInstance.MutableInstanceIndexer(0) ) + do xval.RecursiveInstance.MutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", xval.RecursiveInstance.MutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", xval.RecursiveInstance.MutableInstanceIndexer2(0,1) ) + do xval.RecursiveInstance.MutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", xval.RecursiveInstance.MutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", xval.RecursiveInstance.MutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceMethod(def) = {0}", xval.RecursiveInstance.PrivateInstanceMethod("def") ) + do System.Console.WriteLine("abc.PrivateInstanceProperty = {0}", xval.RecursiveInstance.PrivateInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer(0) = {0}", xval.RecursiveInstance.PrivateInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer2(0,1) = {0}", xval.RecursiveInstance.PrivateInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.RecursiveInstance.PrivateMutableInstanceProperty ) + do xval.RecursiveInstance.PrivateMutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.RecursiveInstance.PrivateMutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", xval.RecursiveInstance.PrivateMutableInstanceIndexer(0) ) + do xval.RecursiveInstance.PrivateMutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", xval.RecursiveInstance.PrivateMutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", xval.RecursiveInstance.PrivateMutableInstanceIndexer2(0,1) ) + do xval.RecursiveInstance.PrivateMutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", xval.RecursiveInstance.PrivateMutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", xval.RecursiveInstance.PrivateMutableInstanceProperty ) + + // repeat all the above through a long-path method lookup + do System.Console.WriteLine("abc.InstanceMethod(def) = {0}", (xval.RecursiveInstanceMethod()).InstanceMethod("def") ) + do System.Console.WriteLine("abc.InstanceProperty = {0}", (xval.RecursiveInstanceMethod()).InstanceProperty ) + do System.Console.WriteLine("abc.InstanceIndexer(0) = {0}", (xval.RecursiveInstanceMethod()).InstanceIndexer(0) ) + do System.Console.WriteLine("abc.InstanceIndexer2(0,1) = {0}", (xval.RecursiveInstanceMethod()).InstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", (xval.RecursiveInstanceMethod()).MutableInstanceProperty ) + do (xval.RecursiveInstanceMethod()).MutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", (xval.RecursiveInstanceMethod()).MutableInstanceProperty ) + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", (xval.RecursiveInstanceMethod()).MutableInstanceIndexer(0) ) + do (xval.RecursiveInstanceMethod()).MutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer = {0}", (xval.RecursiveInstanceMethod()).MutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", (xval.RecursiveInstanceMethod()).MutableInstanceIndexer2(0,1) ) + do (xval.RecursiveInstanceMethod()).MutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.MutableInstanceIndexer2 = {0}", (xval.RecursiveInstanceMethod()).MutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.MutableInstanceProperty = {0}", (xval.RecursiveInstanceMethod()).MutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceMethod(def) = {0}", (xval.RecursiveInstanceMethod()).PrivateInstanceMethod("def") ) + do System.Console.WriteLine("abc.PrivateInstanceProperty = {0}", (xval.RecursiveInstanceMethod()).PrivateInstanceProperty ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer(0) = {0}", (xval.RecursiveInstanceMethod()).PrivateInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateInstanceIndexer2(0,1) = {0}", (xval.RecursiveInstanceMethod()).PrivateInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", (xval.RecursiveInstanceMethod()).PrivateMutableInstanceProperty ) + do (xval.RecursiveInstanceMethod()).PrivateMutableInstanceProperty <- "MutableInstanceProperty (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", (xval.RecursiveInstanceMethod()).PrivateMutableInstanceProperty ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", (xval.RecursiveInstanceMethod()).PrivateMutableInstanceIndexer(0) ) + do (xval.RecursiveInstanceMethod()).PrivateMutableInstanceIndexer(0) <- "MutableInstanceIndexer(0) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer = {0}", (xval.RecursiveInstanceMethod()).PrivateMutableInstanceIndexer(0) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", (xval.RecursiveInstanceMethod()).PrivateMutableInstanceIndexer2(0,1) ) + do (xval.RecursiveInstanceMethod()).PrivateMutableInstanceIndexer2(0,1) <- "MutableInstanceIndexer2(0,1) (mutated!)" + do System.Console.WriteLine("abc.PrivateMutableInstanceIndexer2 = {0}", (xval.RecursiveInstanceMethod()).PrivateMutableInstanceIndexer2(0,1) ) + do System.Console.WriteLine("abc.PrivateMutableInstanceProperty = {0}", (xval.RecursiveInstanceMethod()).PrivateMutableInstanceProperty ) + +end + + +//--------------------------------------------------------------------- +// Test that we can change the default structural comparison semantics + + +module OverrideIComparableOnClassTest = begin + + type MyStringClass = + class + val cache: int + val v: string + interface IComparable with + member x.CompareTo(y:obj) = compare x.v (y :?> MyStringClass).v + end + override x.GetHashCode() = hash(x.v) + override x.Equals(y:obj) = (compare x.v (y :?> MyStringClass).v) = 0 + member x.Length = x.cache + new(s:string) = { inherit Object(); cache=s.Length; v=s } + end + + let s1 = new MyStringClass("abc") + let s2 = new MyStringClass("def") + let s3 = new MyStringClass("abc") + let s4 = new MyStringClass("abcd") + do test "cepoiwelk" (s1.Length = 3) + do test "cepoiwelk" (s2.Length = 3) + let testc (s1:MyStringClass) (s2:MyStringClass) = + test "cepoiwelk1" ((s1 = s2) = (s1.v = s2.v)); + test "cepoiwelk2" ((s1 < s2) = (s1.v < s2.v)); + test "cepoiwelk3" ((s1 > s2) = (s1.v > s2.v)); + test "cepoiwelk4" ((s1 <= s2) = (s1.v <= s2.v)); + test "cepoiwelk5" ((s1 >= s2) = (s1.v >= s2.v)); + test "cepoiwelk6a" ((s1 <> s2) = (s1.v <> s2.v)); + Printf.printf "hash s1 = %d\n" (hash(s1)); + Printf.printf "hash s1.v = %d\n" (hash(s1.v)); + test "cepoiwelk7" (hash(s1) = hash(s1.v)); + test "cepoiwelk8" (hash(s2) = hash(s2.v)) + + do testc s1 s2 + do testc s1 s3 + do testc s2 s3 + do testc s2 s1 + do testc s3 s1 + do testc s3 s2 + do testc s4 s2 +end + +module OverrideIStructuralComparableOnClassTest = begin + + type MyStringClass = + class + val cache: int + val v: string + interface IStructuralComparable with + member x.CompareTo(y:obj,comp:System.Collections.IComparer) = compare x.v (y :?> MyStringClass).v + end + interface IStructuralEquatable with + member x.GetHashCode(comp:System.Collections.IEqualityComparer) = hash(x.v) + member x.Equals(y:obj,comp:System.Collections.IEqualityComparer) = (compare x.v (y :?> MyStringClass).v) = 0 + end + member x.Length = x.cache + new(s:string) = { inherit Object(); cache=s.Length; v=s } + end + + let s1 = new MyStringClass("abc") + let s2 = new MyStringClass("def") + let s3 = new MyStringClass("abc") + let s4 = new MyStringClass("abcd") + do test "cepoiwelk" (s1.Length = 3) + do test "cepoiwelk" (s2.Length = 3) + let testc (s1:MyStringClass) (s2:MyStringClass) = + test "cepoiwelk1" ((s1 = s2) = (s1.v = s2.v)); + test "cepoiwelk2" ((s1 < s2) = (s1.v < s2.v)); + test "cepoiwelk3" ((s1 > s2) = (s1.v > s2.v)); + test "cepoiwelk4" ((s1 <= s2) = (s1.v <= s2.v)); + test "cepoiwelk5" ((s1 >= s2) = (s1.v >= s2.v)); + test "cepoiwelk6a" ((s1 <> s2) = (s1.v <> s2.v)); + Printf.printf "hash s1 = %d\n" (hash(s1)); + Printf.printf "hash s1.v = %d\n" (hash(s1.v)); + test "cepoiwelk7" (hash(s1) = hash(s1.v)); + test "cepoiwelk8" (hash(s2) = hash(s2.v)) + + do testc s1 s2 + do testc s1 s3 + do testc s2 s3 + do testc s2 s1 + do testc s3 s1 + do testc s3 s2 + do testc s4 s2 +end + +module OverrideIComparableOnStructTest = begin + + [] + type MyStringStruct = + struct + val cache: int + val v: string + interface IComparable with + member x.CompareTo(y:obj) = compare x.v (y :?> MyStringStruct).v + end + override x.GetHashCode() = hash(x.v) + override x.Equals(y:obj) = (compare x.v (y :?> MyStringStruct).v) = 0 + member x.Length = x.cache + new(s:string) = { cache=s.Length; v=s } + end + + let s1 = new MyStringStruct("abc") + let s2 = new MyStringStruct("def") + let s3 = new MyStringStruct("abc") + let s4 = new MyStringStruct("abcd") + do test "cepoiwelk" (s1.Length = 3) + do test "cepoiwelk" (s2.Length = 3) + let testc (s1:MyStringStruct) (s2:MyStringStruct) = + test "cepoiwelk1" ((s1 = s2) = (s1.v = s2.v)); + test "cepoiwelk2" ((s1 < s2) = (s1.v < s2.v)); + test "cepoiwelk3" ((s1 > s2) = (s1.v > s2.v)); + test "cepoiwelk4" ((s1 <= s2) = (s1.v <= s2.v)); + test "cepoiwelk5" ((s1 >= s2) = (s1.v >= s2.v)); + test "cepoiwelk6a" ((s1 <> s2) = (s1.v <> s2.v)); + Printf.printf "hash s1 = %d\n" (hash(s1)); + Printf.printf "hash s1.v = %d\n" (hash(s1.v)); + test "cepoiwelk7" (hash(s1) = hash(s1.v)); + test "cepoiwelk8" (hash(s2) = hash(s2.v)) + + do testc s1 s2 + do testc s1 s3 + do testc s2 s3 + do testc s2 s1 + do testc s3 s1 + do testc s3 s2 + do testc s4 s2 +end + +module OverrideIStructuralComparableOnStructTest = begin + + [] + type MyStringStruct = + struct + val cache: int + val v: string + interface IStructuralComparable with + member x.CompareTo(y:obj,comp:System.Collections.IComparer) = compare x.v (y :?> MyStringStruct).v + end + interface IStructuralEquatable with + member x.GetHashCode(comp:System.Collections.IEqualityComparer) = hash(x.v) + member x.Equals(y:obj,comp:System.Collections.IEqualityComparer) = (compare x.v (y :?> MyStringStruct).v) = 0 + end + member x.Length = x.cache + new(s:string) = { cache=s.Length; v=s } + end + + let s1 = new MyStringStruct("abc") + let s2 = new MyStringStruct("def") + let s3 = new MyStringStruct("abc") + let s4 = new MyStringStruct("abcd") + do test "cepoiwelk" (s1.Length = 3) + do test "cepoiwelk" (s2.Length = 3) + let testc (s1:MyStringStruct) (s2:MyStringStruct) = + test "cepoiwelk1" ((s1 = s2) = (s1.v = s2.v)); + test "cepoiwelk2" ((s1 < s2) = (s1.v < s2.v)); + test "cepoiwelk3" ((s1 > s2) = (s1.v > s2.v)); + test "cepoiwelk4" ((s1 <= s2) = (s1.v <= s2.v)); + test "cepoiwelk5" ((s1 >= s2) = (s1.v >= s2.v)); + test "cepoiwelk6a" ((s1 <> s2) = (s1.v <> s2.v)); + Printf.printf "hash s1 = %d\n" (hash(s1)); + Printf.printf "hash s1.v = %d\n" (hash(s1.v)); + test "cepoiwelk7" (hash(s1) = hash(s1.v)); + test "cepoiwelk8" (hash(s2) = hash(s2.v)) + + do testc s1 s2 + do testc s1 s3 + do testc s2 s3 + do testc s2 s1 + do testc s3 s1 + do testc s3 s2 + do testc s4 s2 +end + +module OverrideIComparableOnRecordTest = begin + + [] + type MyStringRecord = { cache: int; v: string } + with + interface IComparable with + member x.CompareTo(y:obj) = compare x.v (y :?> MyStringRecord).v + end + override x.GetHashCode() = hash(x.v) + override x.Equals(y:obj) = (compare x.v (y :?> MyStringRecord).v) = 0 + member x.Length = x.cache + static member Create(s:string) = { cache=s.Length; v=s } + end + + + let s1 = MyStringRecord.Create("abc") + let s2 = MyStringRecord.Create("def") + let s3 = MyStringRecord.Create("abc") + let s4 = MyStringRecord.Create("abcd") + do test "recd-cepoiwelk" (s1.Length = 3) + do test "recd-cepoiwelk" (s2.Length = 3) + let testc s1 s2 = + test "recd-cepoiwelk1" ((s1 = s2) = (s1.v = s2.v)); + test "recd-cepoiwelk2" ((s1 < s2) = (s1.v < s2.v)); + test "recd-cepoiwelk3" ((s1 > s2) = (s1.v > s2.v)); + test "recd-cepoiwelk4" ((s1 <= s2) = (s1.v <= s2.v)); + test "recd-cepoiwelk5" ((s1 >= s2) = (s1.v >= s2.v)); + test "recd-cepoiwelk6b" ((s1 <> s2) = (s1.v <> s2.v)); + Printf.printf "hash s1 = %d\n" (hash(s1)); + Printf.printf "hash s1.v = %d\n" (hash(s1.v)); + test "recd-cepoiwelk7" (hash(s1) = hash(s1.v)); + test "recd-cepoiwelk8" (hash(s2) = hash(s2.v)) + + do testc s1 s2 + do testc s1 s3 + do testc s2 s3 + do testc s2 s1 + do testc s3 s1 + do testc s3 s2 + do testc s4 s2 +end + +module OverrideIStructuralComparableOnRecordTest = begin + + [] + type MyStringRecord = { cache: int; v: string } + with + interface IStructuralComparable with + member x.CompareTo(y:obj,comp:System.Collections.IComparer) = compare x.v (y :?> MyStringRecord).v + end + interface IStructuralEquatable with + member x.GetHashCode(comp:System.Collections.IEqualityComparer) = hash(x.v) + member x.Equals(y:obj,comp:System.Collections.IEqualityComparer) = (compare x.v (y :?> MyStringRecord).v) = 0 + end + member x.Length = x.cache + static member Create(s:string) = { cache=s.Length; v=s } + end + + + let s1 = MyStringRecord.Create("abc") + let s2 = MyStringRecord.Create("def") + let s3 = MyStringRecord.Create("abc") + let s4 = MyStringRecord.Create("abcd") + do test "recd-cepoiwelk" (s1.Length = 3) + do test "recd-cepoiwelk" (s2.Length = 3) + let testc s1 s2 = + test "recd-cepoiwelk1" ((s1 = s2) = (s1.v = s2.v)); + test "recd-cepoiwelk2" ((s1 < s2) = (s1.v < s2.v)); + test "recd-cepoiwelk3" ((s1 > s2) = (s1.v > s2.v)); + test "recd-cepoiwelk4" ((s1 <= s2) = (s1.v <= s2.v)); + test "recd-cepoiwelk5" ((s1 >= s2) = (s1.v >= s2.v)); + test "recd-cepoiwelk6b" ((s1 <> s2) = (s1.v <> s2.v)); + Printf.printf "hash s1 = %d\n" (hash(s1)); + Printf.printf "hash s1.v = %d\n" (hash(s1.v)); + test "recd-cepoiwelk7" (hash(s1) = hash(s1.v)); + test "recd-cepoiwelk8" (hash(s2) = hash(s2.v)) + + do testc s1 s2 + do testc s1 s3 + do testc s2 s3 + do testc s2 s1 + do testc s3 s1 + do testc s3 s2 + do testc s4 s2 +end + +module OverrideIComparableOnUnionTest = begin + + [] + type MyStringUnion = A of int * string | B of int * string + with + member x.Value = match x with A(_,s) | B(_,s) -> s + override x.GetHashCode() = + hash(x.Value) + override x.Equals(y:obj) = + x.Value = (y :?> MyStringUnion).Value + interface IComparable with + member x.CompareTo(y:obj) = + compare x.Value (y :?> MyStringUnion).Value + end + member x.Length = match x with A(n,_) | B(n,_) -> n + static member Create(s:string) = A(s.Length,s) + end + + + let s1 = MyStringUnion.Create("abc") + let s2 = MyStringUnion.Create("def") + let s3 = MyStringUnion.Create("abc") + let s4 = MyStringUnion.Create("abcd") + do test "union-cepoiwelk" (s1.Length = 3) + do test "union-cepoiwelk" (s2.Length = 3) + let testc (s1:MyStringUnion) (s2:MyStringUnion) = + test "union-cepoiwelk1" ((s1 = s2) = (s1.Value = s2.Value)); + test "union-cepoiwelk2" ((s1 < s2) = (s1.Value < s2.Value)); + test "union-cepoiwelk3" ((s1 > s2) = (s1.Value > s2.Value)); + test "union-cepoiwelk4" ((s1 <= s2) = (s1.Value <= s2.Value)); + check "union-cepoiwelk5" (s1 >= s2) (s1.Value >= s2.Value); + check "union-cepoiwelk5b" (compare s1 s2) (compare s1.Value s2.Value); + test "union-cepoiwelk6c" ((s1 <> s2) = (s1.Value <> s2.Value)); + Printf.printf "hash s1 = %d\n" (hash(s1)); + Printf.printf "hash s1.Value = %d\n" (hash(s1.Value)); + test "union-cepoiwelk7" (hash(s1) = hash(s1.Value)); + test "union-cepoiwelk8" (hash(s2) = hash(s2.Value)) + + do testc s1 s2 + do testc s1 s3 + do testc s2 s3 + do testc s2 s1 + do testc s3 s1 + do testc s3 s2 + do testc s4 s2 +end + +module TwoCaseUnionTest = + + [] + type MyUnion = A | B + + do test "union-TwoCaseUnionTest-def" (A <> B) + do test "union-TwoCaseUnionTest-def" (A = A) + do test "union-TwoCaseUnionTest-def" (B = B) + do test "union-TwoCaseUnionTest-def" (B > A) + do test "union-TwoCaseUnionTest-def" (A < B) + do test "union-TwoCaseUnionTest-def" (A <= B) + do test "union-TwoCaseUnionTest-def" (B >= A) + + +module ToStringOnUnionTest = begin + + type MyUnion = A of string | B + + [] + type MyStructUnion = C of string | D + + let a1 = A "FOO" + let c1 = C "FOO" + + let expected1 = "A \"FOO\"" + let expected2 = "C \"FOO\"" + + do test "union-tostring-def" (a1.ToString() = expected1) + do test "union-sprintfO-def" ((sprintf "%O" a1) = expected1) + do test "struct-union-tostring-def" (c1.ToString() = expected2) + do test "struct-union-sprintfO-def" ((sprintf "%O" c1) = expected2) + +end + +module ToStringOnUnionTestOverride = begin + let expected1 = "MyUnion" + + type MyUnion = A of string | B + with + override x.ToString() = expected1 + + let expected2 = "MyStructUnion" + + type MyStructUnion = C of string | D + with + override x.ToString() = expected2 + + let a1 = A "FOO" + let c1 = C "FOO" + + do test "union-tostring-with-override" (a1.ToString() = expected1) + do test "union-sprintfO-with-override" ((sprintf "%O" a1) = expected1) + do test "struct-union-tostring-with-override" (c1.ToString() = expected2) + do test "struct-union-sprintfO-with-override" ((sprintf "%O" c1) = expected2) + +end + +module ToStringOnRecordTest = begin + + type MyRecord = { A: string; B: int } + + [] + type MyStructRecord = { C: string; D: int } + + let a1 = {A = "201"; B = 7} + let c1 = {C = "20"; D = 17} + let expected1 = "{ A = \"201\"\n B = 7 }" + let expected2 = "{ C = \"20\"\n D = 17 }" + + do test "record-tostring-def" (a1.ToString() = expected1) + do test "record-sprintfO-def" ((sprintf "%O" a1) = expected1) + do test "struct-record-tostring-def" (c1.ToString() = expected2) + do test "struct-record-sprintfO-def" ((sprintf "%O" c1) = expected2) + +end + +module ToStringOnRecordTestOverride = begin + + let expected1 = "MyRecord" + + type MyRecord = { A: string; B: int } + with + override x.ToString() = expected1 + + let expected2 = "MyStructRecord" + + [] + type MyStructRecord = { C: string; D: int } + with + override x.ToString() = expected2 + + let a1 = {A = "201"; B = 7} + let c1 = {C = "20"; D = 17} + + do test "record-tostring-with-override" (a1.ToString() = expected1) + do test "record-sprintfO-with-override" ((sprintf "%O" a1) = expected1) + do test "struct-record-tostring-with-override" (c1.ToString() = expected2) + do test "struct-record-sprintfO-with-override" ((sprintf "%O" c1) = expected2) + +end + +module OverrideIStructuralComparableOnUnionTest = begin + + [] + type MyStringUnion = A of int * string | B of int * string + with + member x.Value = match x with A(_,s) | B(_,s) -> s + interface IStructuralEquatable with + member x.GetHashCode(comp:System.Collections.IEqualityComparer) = + hash(x.Value) + member x.Equals(y:obj,comp:System.Collections.IEqualityComparer) = + x.Value = (y :?> MyStringUnion).Value + end + interface IStructuralComparable with + member x.CompareTo(y:obj,comp:System.Collections.IComparer) = + compare x.Value (y :?> MyStringUnion).Value + end + member x.Length = match x with A(n,_) | B(n,_) -> n + static member Create(s:string) = A(s.Length,s) + end + + + let s1 = MyStringUnion.Create("abc") + let s2 = MyStringUnion.Create("def") + let s3 = MyStringUnion.Create("abc") + let s4 = MyStringUnion.Create("abcd") + do test "union-cepoiwelk" (s1.Length = 3) + do test "union-cepoiwelk" (s2.Length = 3) + let testc (s1:MyStringUnion) (s2:MyStringUnion) = + test "union-cepoiwelk1" ((s1 = s2) = (s1.Value = s2.Value)); + //test "union-cepoiwelk2" ((s1 < s2) = (s1.Value < s2.Value)); + //test "union-cepoiwelk3" ((s1 > s2) = (s1.Value > s2.Value)); + //test "union-cepoiwelk4" ((s1 <= s2) = (s1.Value <= s2.Value)); + //check "union-cepoiwelk5" (s1 >= s2) (s1.Value >= s2.Value); + //check "union-cepoiwelk5b" (compare s1 s2) (compare s1.Value s2.Value); + test "union-cepoiwelk6c" ((s1 <> s2) = (s1.Value <> s2.Value)); + Printf.printf "hash s1 = %d\n" (hash(s1)); + Printf.printf "hash s1.Value = %d\n" (hash(s1.Value)); + test "union-cepoiwelk7" (hash(s1) = hash(s1.Value)); + test "union-cepoiwelk8" (hash(s2) = hash(s2.Value)) + + do testc s1 s2 + do testc s1 s3 + do testc s2 s3 + do testc s2 s1 + do testc s3 s1 + do testc s3 s2 + do testc s4 s2 +end + +//--------------------------------------------------------------------- +// Test we can define an attribute + + +type DontPressThisButtonAttribute = + class + inherit System.Attribute + val v: string + member x.Message = x.v + new(s:string) = { inherit System.Attribute(); v=s } + end + +// BUG: +type [] button = Buttpon +let [] button () = 1 + +//--------------------------------------------------------------------- +// Test we can use base calls + +//open System.Windows.Forms + +//type MyCanvas2 = +// class +// inherit Form +// override x.OnPaint(args) = Printf.printf "OnPaint\n"; base.OnPaint(args) + +// new() = { inherit Form(); } +// end + +//let form2 = new MyCanvas2() +// do form.Paint.Add(...) +// do form.add_Paint(...) +//do form.Activate() +//do Application.Run(form) + + +//--------------------------------------------------------------------- +// Test we can inherit from the Event<'a> type to define our listeners + +let (|>) x f = f x + + +(* +type MyEventListeners<'a> = + class + inherit Event<'a> + + val mutable listeners2: (Handler<'a>) list + + member l.Fire(x : 'a) = + let arg = new SimpleEventArgs<_>(x) in + l.listeners2 |> List.iter (fun d -> ignore(d.Invoke((null:obj),arg))) + + new() = + { inherit Event<'a>(); + listeners2 = [] } + + end + +*) + +(* +type MyCanvas2 = + class + inherit Form + member x.Redraw : Event + new: unit -> MyCanvas2 + end +*) + +(* +type MyCanvas2 = + class + inherit Form + val redrawListeners: MyEventListeners + member x.Redraw = x.redrawListeners + override x.OnPaint(args) = x.redrawListeners.Fire(args) + + new() = { inherit Form(); redrawListeners= new MyEventListeners() } + end +*) + +(* +class MyCanvas2() = + let l = MyEventListeners() in + object + inherit Form() + member x.Redraw = l + override x.OnPaint(args) = l.Fire(args) + end + +class MyCanvas2 = + let l = MyEventListeners() in + object + inherit Form + member x.Redraw = l + override x.OnPaint(args) = l.Fire(args) + end +*) + +(* +let form = new MyCanvas2() +// do form.Paint.Add(...) +// do form.add_Paint(...) +do form.Redraw.AddHandler(new Handler(fun _ args -> Printf.printf "OnRedraw\n")) +do form.Redraw.Add(fun args -> Printf.printf "OnRedraw\n") + + +do form.Activate() +do Application.Run(form) +*) + +//do x.add_Redraw + +//--------------------------------------------------------------------- +// Test we can define an exception + +type MyException = + class + inherit System.Exception + val v: string + override x.Message = x.v + new(s:string) = { inherit System.Exception(); v=s } + end + +let _ = try raise(new MyException("help!")) with :? MyException as me -> Printf.printf "message = %s\n" me.Message + +//--------------------------------------------------------------------- +// Test we can define and subscribe to an interface + +(* +type IMyInterface = + interface + abstract MyMethod: string -> int + end +*) + +// type IMyStructuralConstraint = < MyMethod: string -> int > +// 'a :> < MyMethod: string -> int > +// 'a :> IMyStructuralConstraint +// 'a : IMyStructuralConstraint + + +//--------------------------------------------------------------------- +// Test we can define and subscribe to a generic interface + + +//--------------------------------------------------------------------- +// Test we can define a struct + + +(* +type MyStruct = + struct + val x: int + val y: int + end +*) + + +//--------------------------------------------------------------------- +// Test we can define a generic struct + +//--------------------------------------------------------------------- +// Test we can define a class with no fields + +type NoFieldClass = + class + new() = { inherit System.Object() } + end + +//--------------------------------------------------------------------- +// Test we can implement more than one interface on a class + +module MultiInterfaceTest = begin + type PrivateInterfaceA1 = interface abstract M1 : unit -> unit end + type PrivateInterfaceA2 = interface abstract M2 : unit -> unit end + + [] + type C1 = + class + interface PrivateInterfaceA1 with + member x.M1() = () + end + interface PrivateInterfaceA2 with + member x.M2() = () + end + end +end + +module MultiInterfaceTestNameConflict = begin + type PrivateInterfaceA1 = interface abstract M : unit -> unit end + type PrivateInterfaceA2 = interface abstract M : unit -> unit end + [] + type C1 = + class + interface PrivateInterfaceA1 with + member x.M() = () + end + interface PrivateInterfaceA2 with + member x.M() = () + end + end +end + + +module GenericMultiInterfaceTestNameConflict = begin + type PrivateInterfaceA1<'a> = interface abstract M : 'a -> 'a end + type PrivateInterfaceA2<'a> = interface abstract M : 'a -> 'a end + [] + type C1 = + class + interface PrivateInterfaceA1 with + member x.M(y) = y + end + interface PrivateInterfaceA2 with + member x.M(y) = y + end + end +end + + +module DeepInterfaceInheritance = begin + type InterfaceA1 = interface abstract M1 : int -> int end + type InterfaceA2 = interface inherit InterfaceA1 abstract M2 : int -> int end + type InterfaceA3 = interface inherit InterfaceA1 inherit InterfaceA2 abstract M3 : int -> int end + + type C1 = + class + interface InterfaceA2 with + member x.M1(y) = y + member x.M2(y) = y + y + end + new() = { inherit Object(); } + end + type C2 = + class + interface InterfaceA3 with + member x.M1(y) = y + member x.M2(y) = y + y + member x.M3(y) = y + y + y + end + new() = { inherit Object(); } + end + type C3 = + class + interface InterfaceA2 with + member x.M1(y) = y + member x.M2(y) = y + y + end + interface InterfaceA3 with + member x.M3(y) = y + y + y + end + new() = { inherit Object(); } + end + + do test "fewopvrej1" (((new C1()) :> InterfaceA1).M1(4) = 4) + do test "fewopvrej2" (((new C1()) :> InterfaceA2).M2(4) = 8) + + do test "fewopvrej3" (((new C2()) :> InterfaceA1).M1(4) = 4) + do test "fewopvrej4" (((new C2()) :> InterfaceA2).M2(4) = 8) + do test "fewopvrej5" (((new C2()) :> InterfaceA3).M3(4) = 12) + do test "fewopvrej6" (((new C2()) :> InterfaceA3).M1(4) = 4) + do test "fewopvrej7" (((new C2()) :> InterfaceA3).M2(4) = 8) + + do test "fewopvrej8" (((new C3()) :> InterfaceA1).M1(4) = 4) + do test "fewopvrej9" (((new C3()) :> InterfaceA2).M2(4) = 8) + do test "fewopvrej10" (((new C3()) :> InterfaceA3).M3(4) = 12) + do test "fewopvrej11" (((new C3()) :> InterfaceA3).M1(4) = 4) + do test "fewopvrej12" (((new C3()) :> InterfaceA3).M2(4) = 8) + +end + +module DeepGenericInterfaceInheritance = begin + type InterfaceA1<'a> = interface abstract M1 : 'a -> 'a end + type InterfaceA2<'b> = interface inherit InterfaceA1<'b list> abstract M2 : 'b * 'b list -> 'b list end + type InterfaceA3 = interface inherit InterfaceA2 abstract M3 : string list -> string list end + + type C1 = + class + interface InterfaceA2 with + member obj.M1(y) = 1::y + member obj.M2(x,y) = x::y + end + new() = { inherit Object(); } + end + type C2 = + class + interface InterfaceA3 with + member obj.M1(y) = "a" :: y + member obj.M2(x,y) = x :: y + member obj.M3(y) = "a" :: "b" :: "c" :: y + end + new() = { inherit Object(); } + end + type C3 = + class + interface InterfaceA2 with + member obj.M1(y) = "a" :: y + member obj.M2(x,y) = x :: y + end + interface InterfaceA3 with + member obj.M3(y) = "a" :: "b" :: "c" :: y + end + new() = { inherit Object(); } + end + + do test "fewopvrej1" (((new C1()) :> InterfaceA1).M1([1]) = [1;1]) + do test "fewopvrej2" (((new C1()) :> InterfaceA2).M2(3,[1]) = [3;1]) + + do test "fewopvrej3" (((new C2()) :> InterfaceA1).M1(["hi"]) = ["a";"hi"]) + do test "fewopvrej4" (((new C2()) :> InterfaceA2).M1(["hi"]) = ["a";"hi"]) + do test "fewopvrej4" (((new C2()) :> InterfaceA2).M2("a",["hi"]) = ["a";"hi"]) + do test "fewopvrej5" (((new C2()) :> InterfaceA3).M3(["hi"]) = ["a";"b";"c";"hi"]) + do test "fewopvrej6" (((new C2()) :> InterfaceA3).M1(["hi"]) = ["a";"hi"]) + do test "fewopvrej7" (((new C2()) :> InterfaceA3).M2("a",["hi"]) = ["a";"hi"]) + + do test "fewopvrej8" (((new C3()) :> InterfaceA1).M1(["hi"]) = ["a";"hi"]) + do test "fewopvrej8" (((new C3()) :> InterfaceA2).M1(["hi"]) = ["a";"hi"]) + do test "fewopvrej9" (((new C3()) :> InterfaceA2).M2("a",["hi"]) = ["a";"hi"]) + do test "fewopvrej10" (((new C3()) :> InterfaceA3).M3(["hi"]) = ["a";"b";"c";"hi"]) + do test "fewopvrej11" (((new C3()) :> InterfaceA3).M1(["hi"]) = ["a";"hi"]) + do test "fewopvrej12" (((new C3()) :> InterfaceA3).M2("a",["hi"]) = ["a";"hi"]) + +end + + +module PointTest = begin + + + type Point = + class + new(x_init) = { inherit System.Object(); x_init = x_init; x = x_init } + val x_init : int + val mutable x : int + member p.X = p.x + member p.Offset = p.x - p.x_init + member p.Move d1 d2 = p.x <- p.x + d1 + d2 + static member TwoArgs d1 d2 = d1 + d2 + static member TwoPatternArgs [d1] [d2] = d1 + d2 + static member ThreeArgs d1 d2 d3 = d1 + d2 + d3 + static member ThreePatternArgs [d1] [d2] [d3] = d1 + d2 + d3 + member p.InstanceTwoArgs d1 d2 = p.x + d1 + d2 + member p.InstanceTwoPatternArgs [d1] [d2] = p.x + d1 + d2 + member p.InstanceThreeArgs d1 d2 d3 = p.x + d1 + d2 + d3 + member p.InstanceThreePatternArgs [d1] [d2] [d3] = p.x + d1 + d2 + d3 + end + + type Point_with_no_inherits_clause = + class + new x_init = { x_init = x_init; x = x_init } + val x_init : int + val mutable x : int + member p.X = p.x + member p.Offset = p.x - p.x_init + member p.Move d1 d2 = p.x <- p.x + d1 + d2 + end + + do + let p = (new Point_with_no_inherits_clause(3)) in + let f = p.Move 4 in + test "wdfjcdwkj1" (p.X = 3); + f 4; + test "wdfjcdwkj2" (p.X = 11); + f 1; + test "wdfjcdwkj3" (p.X = 16); + test "wdfjcdwkj4" (Point.TwoArgs 1 2 = 3); + test "wdfjcdwkj5" (Point.TwoPatternArgs [1] [2] = 3); + test "wdfjcdwkj6" (Point.ThreeArgs 1 2 3 = 6); + test "wdfjcdwkj7" (Point.ThreePatternArgs [1] [2] [3] = 6); + let p2 = (new Point(16)) in + test "wdfjcdwkj4" (p2.InstanceTwoArgs 1 2 = 16 + 3); + test "wdfjcdwkj5" (p2.InstanceTwoPatternArgs [1] [2] = 16 + 3); + test "wdfjcdwkj6" (p2.InstanceThreeArgs 1 2 3 = 16 + 6); + test "wdfjcdwkj7" (p2.InstanceThreePatternArgs [1] [2] [3] = 16 + 6) + +end + + +//--------------------------------------------------------------------- +// Test we can implement a debug view + +open System.Diagnostics + + +type + [) >] + MyIntList = MyNil | MyCons of int * MyIntList + +and MyIntListDebugView = + class + val v: MyIntList + new(x) = { v = x } + [] + member x.Items = + let rec length x acc = match x with MyNil -> acc | MyCons(a,b) -> length b (acc+1) in + let len = length x.v 0 in + let items = Array.zeroCreate len in + let rec go n l = match l with MyNil -> () | MyCons(a,b) -> items.[n] <- a; go (n+1) b in + go 0 x.v; + items + end + + +//--------------------------------------------------------------------- +// Pattern matching on objects + +module PatternMatchTests = begin + type P = class val x1: int; val x2: string; new(a,b) = {x1=a; x2=b } end + let p = new P(3,"34") +end + + +//--------------------------------------------------------------------- +// 'then' on construction + +module ThenDoTest = begin + let res = ref 2 + type P = + class + val x1: int; val x2: string; + new(a,b) = {x1=a; x2=(test "ewqonce1" (!res = 2); b) } then res := !res + 1 + end + + do ignore(new P(3,"5")) + do test "ewqonce2" (!res = 3) + +end + +//--------------------------------------------------------------------- +// 'then' on construction recursive reference + +module ThenDoTest2 = begin + let res = ref 2 + type P = + class + val x1: int; val x2: string; + new(a,b) as x = + { x1= !res; + x2=(test "ewqonce3" (!res = 2); b) } + then + test "ewqonce4" (!res = 2); + res := !res + 1; + test "ewqonce5" (!res = 3); + test "ewqonce6" (x.x1 = 2) + end + + do ignore(new P(3,"5")) + do test "ewqonce7" (!res = 3) + +end + +module GenericInterfaceTest = begin + + type Foo<'a> = + interface + abstract fun1 : 'a -> 'a + abstract fun2 : int -> int + end + + + type Bar<'b> = + class + val store : 'b + interface Foo<'b> with + member self.fun1(x) = x + member self.fun2(x) = 1 + end + new(x) = { store = x } + end + + + type Bar2<'b> = + class + val store : 'b + interface Foo<'b> with + member self.fun1(x:'b) = x + member self.fun2(x) = 1 + end + new(x) = { store = x } + end + + type Bar3<'b> = + class + val store : int + interface Foo<'b> with + member self.fun1(x) = x + member self.fun2(x) = 1 + end + new(x) = { store = x } + end + +end + + +//--------------------------------------------------------------------- +// + + + +module Inventory = begin + + type item = A | B + type image = A | B + + type ItemDetails = + { ItemIndex: item; + InventoryImage: image; + Name : string } + + type IInventory = interface + abstract Contains : item -> bool + abstract Remove : item -> unit + abstract GetDetails : item -> ItemDetails + abstract Add : ItemDetails -> unit + abstract GetTuple : unit -> (item * image * string) list + end + + + module List = + let indexNotFound() = raise (new System.Collections.Generic.KeyNotFoundException("An index satisfying the predicate was not found in the collection")) + + let rec assoc x l = + match l with + | [] -> indexNotFound() + | ((h,r)::t) -> if x = h then r else assoc x t + let rec remove_assoc x l = + match l with + | [] -> [] + | (((h,_) as p) ::t) -> if x = h then t else p:: remove_assoc x t + + + type Inventory = class + val inv : ItemDetails list ref + new() = { inv = ref [] } + interface IInventory with + member this.Contains i = try (List.assoc i (List.map (fun itd -> (itd.ItemIndex, true)) !this.inv)) with Not_found -> false + member this.Remove i = this.inv := List.map snd (List.remove_assoc i (List.map (fun itd -> (itd.ItemIndex, itd)) !this.inv)) + member this.GetDetails i = List.assoc i (List.map (fun itd -> (itd.ItemIndex, itd)) !this.inv) + member this.Add itd = if ((this :> IInventory).Contains (itd.ItemIndex) = false) then this.inv := itd :: !this.inv + member this.GetTuple() = List.map (fun itd -> (itd.ItemIndex,itd.InventoryImage,itd.Name)) !this.inv + end + end + +end + +//--------------------------------------------------------------------- +// Another interface test + +module SamplerTest = begin + + type Sampler<'a,'b> = + interface + abstract Sample : 'a -> unit + abstract GetStatistic : unit -> 'b + end + + let NewAverage(toFloat) = + let count = ref 0 in + let total = ref 0.0 in + { new Sampler<_,float> with + member __.Sample(x) = incr count; total := !total + toFloat x + member __.GetStatistic() = !total / float(!count) } + + + type Average<'a> = + class + val mutable total : float + val mutable count : int + val toFloat : 'a -> float + new(toFloat) = {total = 0.0; count =0; toFloat = toFloat } + interface Sampler< 'a,float > with + member this.Sample(x) = this.count <- this.count + 1; this.total <- this.total + this.toFloat x + member this.GetStatistic() = this.total / float(this.count) + end + end + +end + + +//--------------------------------------------------------------------- +// This simple case of forward-reference revealed a bug + +type callconv = AA + with + member x.IsInstance = x.ThisConv + member x.ThisConv = 1 + end + +// Likewise + +module OverloadZeroOneTestSoohyoung = begin + + type Point = + class + val mutable mx: int + + new () = { mx = 0 } + new (ix) = { mx = ix } + end + +end + +//--------------------------------------------------------------------- +// Bad error message case + + +module Ralf = begin + + type Matrix = M | N + + [] + type Distribution = + class + new () = { } + + abstract member NumberOfDimensions : unit -> int + abstract member Sample: int -> System.Random -> Matrix + abstract member Density: Matrix -> float + abstract member CloneConstant: unit -> Distribution + abstract member Clone: unit -> Distribution + abstract member AbsoluteDifference: Distribution -> float + + end + + type Gaussian1D = + class + inherit Distribution + val PrecisionMean : float + val Precision : float + new (precisionMean, precision) = { PrecisionMean = 0.0; Precision = 0.0 } + override x.NumberOfDimensions() = 1 + override x.Density point = 1.0 + override x.AbsoluteDifference distribution = 0.0 + override x.Clone() = new Gaussian1D (0.0,0.0) :> Distribution + override x.CloneConstant() = new Gaussian1D (x.PrecisionMean,x.Precision) :> Distribution + override x.Sample numberOfSamples random = failwith "" // new Matrix (numberOfSamples,x.NumberOfDimensions) + end + +end + + +//--------------------------------------------------------------------- +// A random bunch of overloaded operator tests + +module MultipleOverloadedOperatorTests = begin + + let f1 (x:DateTime) (y:TimeSpan) : DateTime = x - y + let g1 (x:DateTime) (y:DateTime) : TimeSpan = x - y + // Return type is also sufficient: + let f2 (x:DateTime) y : DateTime = x - y + let g2 (x:DateTime) y : TimeSpan = x - y + // Just argument types are also sufficient: + let f3 (x:DateTime) (y:TimeSpan) = x - y + let g3 (x:DateTime) (y:DateTime) = x - y + +end + + +//--------------------------------------------------------------------- +// A random bunch of overloaded operator tests + +module OverloadedOperatorTests = begin + + + let x = [] + do printf "len = %d\n" x.Length + let c = ("abc").[2] + + let arr = [| 1 |] + do printf "len = %d\n" x.Length + let elem = arr.[0] + let _ = arr.[0] <- 3 + + let SCAL = new System.Collections.ArrayList() + let _ = SCAL.Add(3) + let _ = SCAL.[0] + let _ = SCAL.[0] <- box 4 + + let SCGL = new System.Collections.Generic.List() + let _ = SCGL.Add(3) + let _ = SCGL.[0] + let _ = SCGL.[0] <- 3 + + let f (x: 'a) = + let SCGL = new System.Collections.Generic.List<'a>() in + let _ = SCGL.Add(x) in + let _ = SCGL.[0] in + let _ = SCGL.[0] <- x in + () + + // check we have generalized + do f 1 + do f "3" + + let SCGD = new System.Collections.Generic.Dictionary() + let _ = SCGD.Add("hello",3.0) + let _ = SCGD.["hello"] + + let g (k: 'a) (v:'b)= + let SCGD = new System.Collections.Generic.Dictionary<'a,'b>() in + let _ = SCGD.Add(k,v) in + let _ = SCGD.[k] in + let _ = SCGD.[k] <- v in + () + + + + // check we have generalized + do g 1 "3" + do g "3" 1 + do g "3" "1" + do g 1 1 + + let h (v:'b)= + let arr = [| v;v;v |] in + let elem = arr.[0] in + let _ = arr.[0] <- v in + () + + + // check we have generalized + do h 1 + do h "3" + + +end + +module PropertyOverrideTests = begin + + [] + type A = class + abstract S1 : float with set + abstract S2 : string-> float with set + abstract S3 : string * string -> float with set + abstract G1 : float with get + abstract G2 : string-> float with get + abstract G3 : string * string -> float with get + end + + type IA = interface + abstract S1 : float with set + abstract S2 : string-> float with set + abstract S3 : string * string -> float with set + abstract G1 : float with get + abstract G2 : string-> float with get + abstract G3 : string * string -> float with get + end + + + [] + type CTest = + class + inherit A + override x.S1 with set v = () + override x.S2 with set s v = () + override x.S3 with set (s1,s2) v = () + override x.G1 with get () = 1.0 + override x.G2 with get (s:string) = 2.0 + override x.G3 with get (s1,s2) = 3.0 + interface IA with + override x.S1 with set v = () + override x.S2 with set s v = () + override x.S3 with set (s1,s2) v = () + override x.G1 with get () = 1.0 + override x.G2 with get (s:string) = 2.0 + override x.G3 with get (s1,s2) = 3.0 + end + + end + +end + +module FieldsInClassesDontContributeToRecordFieldInference = begin + + type container = class + val capacity : float + new(cap) = { capacity = cap } + end + + type cargo = class + val capacity : float // (Error does not appear when the name is changed to capacity1) + new(cap) = { capacity = cap } + end + + let total_capacity cl = List.fold(fun sum (z:container) -> z.capacity + sum) 0.0 cl + + let cap = total_capacity [ new container(100.0); new container(50.0)] + +end + +module LucianRecords1 = begin + type MyRecord1 = {a:int; x:int} + type MyRecord2 = {a:int; y:string} + let f (m:MyRecord1) : MyRecord1 = {m with a=3} + let g (m:MyRecord2) : MyRecord2 = {m with a=3} + let h (m:MyRecord1) = m.a + + type Tab = {a:string; b:string} + type Tac = {a:string; c:string} + type Test = Cab of Tab | Cac of Tac + let a = Cab( {a="hello"; b="world";} ) + +end + +//module DefaultConstructorConstraints = begin + +// let f1 () : 'a when 'a : (new : unit -> 'a) = new 'a() +// let x1 = (f1() : obj) +// let x2 = (f1() : int) +// let x3 = (f1() : DateTime) +// let x4 = (f1() : System.Windows.Forms.Form) +// let f2 () = f1() +// let y1 = (f2() : obj) +// let y2 = (f2() : int) +// let y3 = (f2() : DateTime) +// let y4 = (f2() : System.Windows.Forms.Form) + +//end + +//module AccessBugOnFSharpList = begin + +// open System.Web +// open System.Web.Hosting +// open System.Data.SqlClient + +// type TopicPathProvider = +// class +// inherit VirtualPathProvider + +// new() = { inherit VirtualPathProvider(); } + +// member x.TopicExists topic = +// let cmd = new SqlCommand() in +// cmd.CommandText <- "SELECT COUNT(*) FROM Topic WHERE Topic.Name = @name"; +// (cmd.Parameters.Add("@name", System.Data.SqlDbType.NVarChar, 255)).Value <- topic; +// unbox(cmd.ExecuteScalar()) > 0 + +// override x.FileExists((virtualPath: string)) = +// let relPath = VirtualPathUtility.ToAppRelative(virtualPath) in +// if relPath.StartsWith("~/topic") then +// x.TopicExists (relPath.Substring(7)) +// else +// x.Previous.FileExists(virtualPath) + +// override x.DirectoryExists((virtualDir: string)) = +// let relPath = VirtualPathUtility.ToAppRelative(virtualDir) in +// relPath.StartsWith("~/topic") || x.DirectoryExists(virtualDir) +// end + +// let AppInitialize() = +// let provider = new TopicPathProvider() in +// HostingEnvironment.RegisterVirtualPathProvider(provider) + +//end + + +module TupledTests = begin + + [] + type C1<'a> = class static member Foo(x:'a) = x end + + let _ = C1.Foo((1,2)) + + + + +end + + + +(* Bug 692 *) +type action = delegate of unit -> unit + +(* Bug 694 *) +type x = delegate of unit -> int +let ff = new x(fun () -> 1) +let fails = ff.Invoke() + + + +module RecursiveClassCefinitions = begin + + type t1 = + class + val t2: t2 + member t1.M1(t2:t2) = t2.M2() + member t1.M2() = t1.M1(t1.t2) + member t1.M3(t2:t2) = t2.M3() + member t1.P1 = t1.t2.P2 + member t1.P2 = t1.P1 + member t1.P3 = t1.t2.P3 + 1 + new() = { t2 = new t2() } + end + and t2 = + class + val t1: t1 + member t2.M1() = t2.t1.M2() + member t2.M2() = t2.M1() + member t2.M3() = t2.t1.M3(t2) + member t2.P1 : int = t2.P2 + member t2.P2 = t2.t1.P1 + member t2.P3 = t2.P3 + new() = { t1 = new t1() } + end + + //let t2 = new t2() + //let b = (t2.P1 = 3) +end + +module RecursiveAugmentationDefinitions = begin + + type t1 = { t2: t2 } + with + member t1.M1(t2:t2) = t2.M2() + member t1.M2() = t1.M1(t1.t2) + member t1.M3(t2:t2) = t2.M3() + member t1.P1 = t1.t2.P2 + member t1.P2 = t1.P1 + member t1.P3 = t1.t2.P3 + 1 + end + and t2 = { t1:t1 } + with + member t2.M1() = t2.t1.M2() + member t2.M2() = t2.M1() + member t2.M3() = t2.t1.M3(t2) + member t2.P1 : int = t2.P2 + member t2.P2 = t2.t1.P1 + member t2.P3 = t2.P3 + end + + //let t2 = new t2() + //let b = (t2.P1 = 3) +end + +module RecursiveAbstractClassDefinitions = begin + + type t1 = + class + val t2: t2 + abstract M1 : t2 -> t1 + abstract M2 : unit -> t1 + abstract M3 : t2 -> t1 + abstract P1 : int + abstract P2 : int + abstract P3 : int + default t1.M1(t2:t2) = t2.M2() + default t1.M2() = t1.M1(t1.t2) + default t1.M3(t2:t2) = + // Note we can use object expressions within the recursive + // definition of the type itself. This requries real care - the + // exact set of abstract members that still need implementing + // must have been determined correctly before any expressions are + // analyzed. + { new t1() with + member x.P1 = 4 + end } + default t1.P1 = t1.t2.P2 + default t1.P2 = t1.P1 + default t1.P3 = t1.t2.P3 + 1 + new() = { t2 = new t2() } + end + and t2 = + class + val t1: t1 + abstract M1 : unit -> t1 + abstract M2 : unit -> t1 + abstract M3 : unit -> t1 + abstract P1 : int + abstract P2 : int + abstract P3 : int + default t2.M1() = t2.t1.M2() + default t2.M2() = t2.M1() + default t2.M3() = t2.t1.M3(t2) + default t2.P1 : int = t2.P2 + default t2.P2 = t2.t1.P1 + default t2.P3 = t2.P3 + new() = { t1 = new t1() } + end +end + +module RecursiveAbstractClassDefinitions2 = begin + + (* same test as above but in different order and some missing implementations *) + [] + type t1 = + class + val t2: t2 + default t1.M1(t2:t2) = t2.M2() + default x.M3(t2:t2) = { new t1() with + member x.P1 = 4 + member x.M2() = t1.MakeT1() } + static member MakeT1() = { new t1() with + member x.P1 = 4 + member x.M2() = t1.MakeT1() } + default t1.P2 = t1.P1 + default t1.P3 = t1.t2.P3 + 1 + new() = { t2 = new t2() } + abstract M1 : t2 -> t1 + abstract M2 : unit -> t1 + abstract M3 : t2 -> t1 + abstract P1 : int + abstract P2 : int + abstract P3 : int + end + and t2 = + class + val t1: t1 + default t2.M1() = t2.t1.M2() + default t2.M2() = t2.M1() + default t2.M3() = t2.t1.M3(t2) + default t2.P1 : int = t2.P2 + default t2.P2 = t2.t1.P1 + default t2.P3 = t2.P3 + abstract M1 : unit -> t1 + abstract M2 : unit -> t1 + abstract M3 : unit -> t1 + abstract P1 : int + abstract P2 : int + abstract P3 : int + new() = { t1 = t1.MakeT1() } + end + + //let t2 = new t2() + //let b = (t2.P1 = 3) +end + +module WeckerTestCase1 = begin + type A = class + val v1 : B + new(b) = { v1 = b } + member x.m1() = x.v1.v2 + x.v1.m2() + end + + and B = class + val v2 : int + new() = { v2 = 3} + member x.m2() = x.v2 + end +end + +#if GENERICS +module StaticMemberBugs = begin + type x = class + static member empty : byte[] = Array.zeroCreate 0; + end + + let ba = x.empty + type xx = class static member x = 2 end + let v = xx.x + +end +#endif + + +module TestConstrainedItemProperty = begin + type Foo = + interface + abstract Item : int -> string with get + end + + let f1 (x : #Foo) = x.[1] + + let f2 (x : #Foo) = x.[1] +end + + +module DefaultStructCtor = begin + + let i1 = new System.Nullable() + let i2 = new System.Nullable() + do test "cwehoiewc" (i1.HasValue=false) + do test "cwehoiewc" (i2.HasValue=false) + type S = + struct + new(v:int) = { v=v } + val v : int + end + let i3 = new S() + let i3b = new S(3) + let i4 = new System.Nullable() + +end + +module MiscNullableTests = begin + open System + let (>=?!) (x : Nullable<'a>) (y: 'a) = + x.HasValue && x.Value >= y + + let (>?!) (x : Nullable<'a>) (y: 'a) = + x.HasValue && x.Value > y + + let (<=?!) (x : Nullable<'a>) (y: 'a) = + not x.HasValue || x.Value <= y + + let () (y: 'a) = + not x.HasValue || x.Value < y + + let (=?!) (x : Nullable<'a>) (y: 'a) = + x.HasValue && x.Value = y + + let (<>?!) (x : Nullable<'a>) (y: 'a) = + not x.HasValue || x.Value <> y + + /// This overloaded operator divides Nullable values by non-Nullable values + /// using the overloaded operator "/". Inlined to allow use over any type, + /// as this resolves the overloading on "/". + let inline (/?!) (x : Nullable<'a>) (y: 'a) = + if x.HasValue then new Nullable<'a>(x.Value / y) + else x + + /// This overloaded operator adds Nullable values by non-Nullable values + /// using the overloaded operator "+". Inlined to allow use over any type, + /// as this resolves the overloading on "+". + let inline (+?!) (x : Nullable<'a>) (y: 'a) = + if x.HasValue then new Nullable<'a>(x.Value + y) + else x + + /// This overloaded operator adds Nullable values by non-Nullable values + /// using the overloaded operator "-". Inlined to allow use over any type, + /// as this resolves the overloading on "-". + let inline (-?!) (x : Nullable<'a>) (y: 'a) = + if x.HasValue then new Nullable<'a>(x.Value - y) + else x + + /// This overloaded operator adds Nullable values by non-Nullable values + /// using the overloaded operator "*". Inlined to allow use over any type, + /// as this resolves the overloading on "*". + let inline ( *?!) (x : Nullable<'a>) (y: 'a) = + if x.HasValue then new Nullable<'a>(x.Value * y) + else x + + /// This overloaded operator adds Nullable values by non-Nullable values + /// using the overloaded operator "%". Inlined to allow use over any type, + /// as this resolves the overloading on "%". + let inline ( %?!) (x : Nullable<'a>) (y: 'a) = + if x.HasValue then new Nullable<'a>(x.Value % y) + else x + +end + +module BaseCallWorkaround = begin + type C1 = class + new() = {} + abstract Blah : unit -> unit + default this.Blah () = this.Blah_C1_Impl() + member this.Blah_C1_Impl () = ignore <| printf "From C1\n" + end + + type C2 = class + inherit C1 + new() = {inherit C1()} + override this.Blah() = + ignore <| printf "From C2\n"; + this.Blah_C1_Impl() + end + + do (new C2()).Blah() + +end + +module BaseCallTest = begin + let res = ref 0 + type C1 = class + new() = {} + abstract Blah : unit -> unit + default this.Blah () = + ignore <| printf "From C1\n"; + res := !res + 2 + end + + type C2 = class + inherit C1 + new() = {inherit C1()} + override this.Blah() = + ignore <| printf "From C2\n"; + res := !res + 1; + base.Blah() + end + + + do test "ewckjd0" (!res = 0) + do (new C2()).Blah() + do test "ewckjd0" (!res = 3) + +end + +module BaseCallTest2 = begin + let res = ref 0 + type C1 = class + new() = {} + abstract Blah : unit -> unit + default this.Blah () = + ignore <| printf "From C1b\n"; + ignore <| printf "From C1b\n"; + ignore <| printf "From C1b\n"; + ignore <| printf "From C1b\n"; + ignore <| printf "From C1b\n"; + ignore <| printf "From C1b\n"; + res := !res + 3 + end + + type C2 = class + inherit C1 + new() = {inherit C1()} + override this.Blah() = + ignore <| printf "From C2b\n"; + ignore <| printf "From C2b\n"; + ignore <| printf "From C2b\n"; + ignore <| printf "From C2b\n"; + ignore <| printf "From C2b\n"; + res := !res + 2; + base.Blah() + end + + + type C3 = class + inherit C2 + new() = {inherit C2()} + override this.Blah() = + ignore <| printf "From C3c\n"; + ignore <| printf "From C3c\n"; + ignore <| printf "From C3c\n"; + res := !res + 1; + base.Blah() + end + + + do test "ewckjd0a" (!res = 0) + do (new C3()).Blah() + do test "ewckjd0b" (!res = 6) + +end + + +open System +//open System.Windows.Forms +//type Bug856 = +// class +// inherit CheckBox +// new() = { inherit CheckBox(); } +// member x.PerformClick() = x.OnClick(new EventArgs()) // peverify failed +// end +//do let form = new Form() in +// let checkBox = new Bug856(Text="Test") in +// form.Controls.Add(checkBox); + //checkBox.PerformClick() (* got inlined - peverify failed *) + + +module SelfInitCalls = begin + + open System.IO + type File2 = class + val path: string + val innerFile: FileInfo + // note this calls another constructor. + new() = new File2("default.txt") + new(path) = + { path = path ; + innerFile = new FileInfo(path) } + end + +end + +module SelfInitCalls2 = begin + + open System.IO + type File2(path) = class + let path = path + let innerFile = new FileInfo(path) + // note this calls another constructor. + new() = new File2("default.txt") + end + +end + +//module SettingPropertiesInConstruction = begin +// open System.Windows.Forms +// let f = { new Form(Text="hello") with member __.OnPaint(args) = () } +// do test "ce32wygu" (f.Text = "hello") +// type C = class +// val mutable p : int +// member x.P with set v = x.p <- v +// val mutable q : int +// member x.Q with set v = x.q <- v +// abstract Foo : int -> int +// default o.Foo(x) = x +// new() = { p = 0; q = 1 } +// end + +// let check s p = printf "Test %s: %s\n" s (if p then "pass" else "fail") + +// let c0 = new C() +// do test "ce32wygu" (c0.p = 0) +// do test "ce32wygu" (c0.q = 1) + +// let c1 = new C(P = 3) +// do test "ce32wygu" (c1.p = 3) + +// let c2 = { new C(P = 4) with member __.Foo(x) = x + x } +// do test "ce32wygu" (c2.p = 4) + +// let c3 = { new C(Q = 5) with member __.Foo(x) = x + x } +// do test "ce32wygu" (c3.q = 5) + +// let c4 = { new C(P = 3, Q = 5) with member __.Foo(x) = x + x } +// do test "ce32wygu" (c4.p = 3) +// do test "ce32wygu" (c4.q = 5) + +// let c5 = { new C(Q = 5, P = 3) with member __.Foo(x) = x + x } +// do test "ce32wygu" (c5.p = 3) +// do test "ce32wygu" (c5.q = 5) +//end + +// Finish up + + +//type SmoothForm = class +// inherit Form +// new() as x = +// { inherit Form(); } +// then +// x.SetStyle(ControlStyles.AllPaintingInWmPaint ||| ControlStyles.Opaque, true); +//end + +module ENumTests = begin + type Int64Enum = + | One = 1L + | Two = 2L + | Three = 3L + + type UInt64Enum = + | One = 1UL + | Two = 2UL + | Three = 3UL + + type Int32Enum = + | One = 1 + | Two = 2 + | Three = 3 + type UInt32Enum = + | One = 1u + | Two = 2u + | Three = 3u + type UInt16Enum = + | One = 1us + | Two = 2us + | Three = 3us + type Int16Enum = + | One = 1s + | Two = 2s + | Three = 3s + type Int8Enum = + | One = 1y + | Two = 2y + | Three = 3y + type UInt8Enum = + | One = 1uy + | Two = 2uy + | Three = 3uy + + type CharEnum = + | Option1 = '1' + | Option2 = '2' + +(* + type FloatEnum = + | Option1 = 1.0 + | Option2 = 2.0 + + type Float32Enum = + | Option1 = 1.0f + | Option2 = 2.0f +*) +end + +//module AccessingProtectedMembersFromOtherObjects = begin +// type DS() = class +// inherit System.Data.DataSet() +// member t.Foo () = +// let a = new DS() in +// a.GetSchemaSerializable() |> ignore; +// t.GetSchemaSerializable() |> ignore; +// () + + +// end +//end + +//module TestPropertySetWithSyntaxThatLooksLikeANamedArgument = begin +// open System.Windows.Forms + +// let el = new CheckBox() +// let el2 = el +// do el.Checked <- (el = el2) // this is not a named argument!!! +//end + +module SomeMoreCtorCases = begin + type C = + class + val xx : int + new(x,y) = + if y then + { xx = x} + else + { xx = x+x} + new(x) = + let six = 3 + 3 in + { xx = x} + static member Create() = + let six = 3 + 3 in + new C(3+3) + new() = + let six = 3 + 3 in + new C(3+3) + new(a,b,c) = new C(a+b+c) + new(a,b,c,d) = + new C(a+b+c+d) + then + printf "hello" + end + +end + +module StillMoreCtorCases = begin + type C<'a>(x:int) = class + new() = C<'a>(3) + end + type C2<'a>() = class + new(x:int) = C2<'a>() + end +end + +module StephenTolksdorfBug1112 = begin + + open System.Collections.Generic + + type ITest<'T> = interface + abstract Read1: #IList<'T> -> unit + abstract Read2: #IList<'U> -> unit + abstract Read3: #IList<('U * 'T)> -> unit + abstract Read4: IList<('U * 'T)> -> unit + end + + + + + /// other manifestation of the same bug + type ITest2 = interface + abstract Foo<'t> : 't -> 't + end + + + type Test() = class + interface ITest2 with + member x.Foo<'t>(v:'t) : 't = v + end + end + + + /// yet another manifestation of the same bug + type IMonad<'a> = + interface + abstract unit : 'a -> IMonad<'a> + abstract bind : #IMonad<'a> -> ('a -> #IMonad<'b>) -> IMonad<'b> + abstract ret : unit -> 'a + end + +end + +module Bug1281Test = begin + + [] + type node = + struct + + val mutable key: int + new (keyIn) = {key=keyIn} + member n.Item with get(i:int) = if i=0 then 1 else + failwith "node has 2 items only" + end + let nd = new node (10) + let _ = nd.[0] +end + + +module Bug960Test2 = begin + + [] + type B<'a, 'b> = class + val mutable a : 'a + val mutable b : 'b + + new(a, b) = {a=a; b=b} + + member x.C() = x.A + + abstract A : 'a with get,set + + member x.B + with get() = x.b + and set(v) = x.b <- v + end + + [] + type C = class + inherit B + + new() = { inherit B(3,4) } + + override x.A + with get() = 3 + and set(v : int) = (invalidArg "arg" "C.A.set" : unit) end +end + + +module RandomAdditionalNameResolutionTests = begin + + module M = begin + type Foo() = + class + member x.Name = "a" + end + type Foo<'a>() = + class + member x.Name = "a" + end + type Goo<'a>() = + class + member x.Name = "a" + end + type Goo() = + class + member x.Name = "a" + end + end + + let f2 = new M.Foo() + let f3 = new M.Foo< >() + let f4 = new M.Foo() + + let g2 = new M.Goo() + let g3 = new M.Goo< >() + let g4 = new M.Goo() + + open M + + let f5 = new Foo() + let f6 = new Foo< >() + let f7 = new Foo() + + let g5 = new Foo() + let g6 = new Foo< >() + let g7 = new Foo() + +end + +module NonGenericStruct_FSharp1_0_bug_1337_FSharp1_0_bug_1339 = begin + type S = + struct + val mutable x : int + val mutable y : int + member obj.X with set(v) = obj.x <- v + member obj.Y with set(v) = obj.y <- v + end + + let x1 : S = S() + let x2 : S = S(X=1, Y=2) + + do test "veoijw09we1" (x1.x = 0) + do test "veoijw09we2" (x1.y = 0) + + do test "veoijw09we3" (x2.x = 1) + do test "veoijw09we4" (x2.y = 2) +end + +module GenericClass_FSharp1_0_bug_1337_FSharp1_0_bug_1339 = begin + type S<'a,'b> = + class + val mutable x : 'a + val mutable y : 'b + member obj.X with set(v) = obj.x <- v + member obj.Y with set(v) = obj.y <- v + new(a,b) = { x=a; y=b } + end + + let x1 = S(1,"1") + let x2 = S(a=1,b="1") + let x3 = S(1,"1",X=1, Y="2") + + do test "veoijw09we1" (x1.x = 1) + do test "veoijw09we2" (x1.y = "1") + + do test "veoijw09we3" (x2.x = 1) + do test "veoijw09we4" (x2.y = "1") + + do test "veoijw09we3" (x3.x = 1) + do test "veoijw09we4" (x3.y = "2") +end + +module GenericStruct_FSharp1_0_bug_1337_FSharp1_0_bug_1339 = begin + type S<'a,'b> = + struct + val mutable x : 'a + val mutable y : 'b + member obj.X with set(v) = obj.x <- v + member obj.Y with set(v) = obj.y <- v + end + + let x1 = S() + let x2 = S(X=1, Y="2") + + do test "veoijw09we1" (x1.x = 0) + do test "veoijw09we2" (x1.y = null) + + do test "veoijw09we3" (x2.x = 1) + do test "veoijw09we4" (x2.y = "2") + +end + + +module LeakyAbbreviation_bug1542_FSharp_1_0 = begin + + type MM<'a,'b>() = + class + static member Create() = 1 + end + + type Graph<'a> = MM<'a,'a> + let g = Graph.Create() + +end + +module CheckoptionalArgumentAttributeDeclaresOptionalArgument = begin + + type C() = + class + static member M([] x : int option) = x + end + + let v = C.M(x=3) + +end + +module PropertySetter_FSharp1_0_bug_1422 = begin + + type Variable() = + class + member x.Name with set(v:string) = () + end + + type Variable<'a>() = + class + inherit Variable() + static member Random(y:Variable<'b>) = new Variable<'a>() + end + + let x : Variable = new Variable() + let _ = Variable.Random (x, Name = "m_") + + +end + + +module StructKeywordAsConstraintTest = begin + + type Struct0 = + struct + val x : int + end + + type Struct1<'a when 'a : struct> = + struct + val x : int + end + + type Struct2<'a when 'a : not struct> = + struct + val x : int + end + + type Class1<'a when 'a : struct> = + class + val x : int + end + + type Class2<'a when 'a : not struct> = + class + val x : int + end + + let inline f<'a when 'a : null> () : 'a = null + let v1 = f () + let v2 = f () + +end + +module MutateStructFieldOnPropertySet = begin + + type C() = class + [] + val mutable F : int + end + + let c = C(F=3) + + do test "cnoe0wec" (c.F = 3) + +end + + +module Bug618 = begin + type c<'a> when 'a :> c<'a> () = class end + type d() = class inherit c() end + let x = new c() + +end + +(* +module Bug618b = begin + type c<'a> when 'a :> c<'a>() = class end + type d() = class inherit c() end + let x = new c() + +end +*) + +(* Bug: 1284: Enum type definitions do not support negative literals *) +module Bug1284 = begin + (* Negative literal with no space *) + type EnumInt8 = | A1 = -10y + type EnumInt16 = | A1 = -10s + type EnumInt32 = | A1 = -10 + type EnumInt64 = | A1 = -10L +(*type EnumNativeInt = | A1 = -10n -- enum on this type are not support, -ve or +ve *) + //type EnumDouble = | A1 = -1.2 + //type EnumSingle = | A1 = -1.2f +end + + +module ContraintTest = begin + open System.Numerics + let check s p = printf "Test %s: %s\n" s (if p then "pass" else "fail") + do check "d3oc001" (LanguagePrimitives.GenericZero = 0I) + do check "d3oc002" (LanguagePrimitives.GenericZero = '\000') + do check "d3oc003a" (LanguagePrimitives.GenericZero = 0) + do check "d3oc003b" (LanguagePrimitives.GenericZero = 0un) + do check "d3oc003c" (LanguagePrimitives.GenericZero = 0UL) + do check "d3oc003d" (LanguagePrimitives.GenericZero = 0u) + do check "d3oc003e" (LanguagePrimitives.GenericZero = 0us) + do check "d3oc003f" (LanguagePrimitives.GenericZero = 0uy) + do check "d3oc003g" (LanguagePrimitives.GenericZero = 0n) + do check "d3oc003h" (LanguagePrimitives.GenericZero = 0L) + do check "d3oc003i" (LanguagePrimitives.GenericZero = 0) + do check "d3oc003j" (LanguagePrimitives.GenericZero = 0s) + do check "d3oc003k" (LanguagePrimitives.GenericZero = 0y) + do check "d3oc003l" (LanguagePrimitives.GenericZero = 0M) + + do check "d3oc113q" (LanguagePrimitives.GenericOne = 1I) + do check "d3oc113w" (LanguagePrimitives.GenericOne = '\001') + do check "d3oc113e" (LanguagePrimitives.GenericOne = 1) + do check "d3oc113r" (LanguagePrimitives.GenericOne = 1un) + do check "d3oc113t" (LanguagePrimitives.GenericOne = 1UL) + do check "d3oc113y" (LanguagePrimitives.GenericOne = 1u) + do check "d3oc113u" (LanguagePrimitives.GenericOne = 1us) + do check "d3oc113i" (LanguagePrimitives.GenericOne = 1uy) + do check "d3oc113o" (LanguagePrimitives.GenericOne = 1n) + do check "d3oc113a" (LanguagePrimitives.GenericOne = 1L) + do check "d3oc113s" (LanguagePrimitives.GenericOne = 1) + do check "d3oc113d" (LanguagePrimitives.GenericOne = 1s) + do check "d3oc113f" (LanguagePrimitives.GenericOne = 1y) + do check "d3oc113g" (LanguagePrimitives.GenericOne = 1M) +end + +module MiscGenericMethodInference = begin + + type Printer() = + class + let tw = new IO.StringWriter() + member x.TextWriter = tw + member x.Print fmt = Printf.fprintfn tw fmt + end + + let test2 () = + let pr = Printer() in + pr.Print "test %s" "test"; + pr.Print "test"; + pr.TextWriter.ToString() + +end + +module CondensationTest = begin + + open System + open System.Reflection + + [] + type public APropAttribute() = + class + inherit Attribute() + end + [] + type public AMethodAttribute() = + class + inherit Attribute() + end + + type AType() = + class + + [] + member this.Prop = "Hello" + [] + member this.Meth() = "Boo" + end + let getAttribute<'t> (memb: MemberInfo) = + let attrib = memb.GetCustomAttributes(typeof<'t>, false) in + // Only allow a single instance of the attribute on the member for now + match attrib with + | [| theAttrib |] -> Some(memb, (theAttrib :?> 't)) + | _ -> None + + let hasAttribute<'t> (memb: MemberInfo) = + match getAttribute<'t> memb with + | Some(_) -> true + | None -> false + + let t = AType() + let p = t.GetType().GetProperties() |> Array.filter (hasAttribute) + let m = t.GetType().GetMethods() |> Array.filter (hasAttribute) + + +end + +module OptionalArgumentWithSubTyping = begin + type Base() = + class + end + type Child() = + class + inherit Base() + end + + type Test(?bse: Base) = + class + let value = match bse with Some b -> b | _ -> new Base() + member t.Value = value + end + + let t1 = new Test(bse=Base()) // should not trigger exception + let t2 = new Test(?bse=Some(Base())) // should not trigger exception + let t3 = new Test(bse=Child()) // should not trigger exception +end + + + + + +module ParamArgs = begin + let _ = System.Console.WriteLine("") + let _ = System.Console.WriteLine("{0}",1) + let _ = System.Console.WriteLine("{0},{1}",1,2) + let _ = System.Console.WriteLine("{0},{1},{2}",1,2,3) + let _ = System.Console.WriteLine("{0},{1},{2},{3}",1,2,3,4) + let _ = System.Console.WriteLine("{0},{1},{2},{3},{4}",1,2,3,4,5) + + let _ = System.Console.WriteLine("") + let _ = System.Console.WriteLine("{0}",box 1) + let _ = System.Console.WriteLine("{0},{1}",box 1,box 2) + let _ = System.Console.WriteLine("{0},{1},{2}",box 1,box 2,box 3) + let _ = System.Console.WriteLine("{0},{1},{2},{3}",box 1,box 2,box 3,box 4) + let _ = System.Console.WriteLine("{0},{1},{2},{3},{4}",box 1,box 2,box 3,box 4,box 5) + + let () = check "vskncvew1" (System.String.Format("")) "" + let () = check "vskncvew2" (System.String.Format("{0}",1)) "1" + let () = check "vskncvew3" (System.String.Format("{0},{1}",1,2)) "1,2" + let () = check "vskncvew4" (System.String.Format("{0},{1},{2}",1,2,3)) "1,2,3" + let () = check "vskncvew5" (System.String.Format("{0},{1},{2},{3}",1,2,3,4)) "1,2,3,4" + let () = check "vskncvew6" (System.String.Format("{0},{1},{2},{3},{4}",1,2,3,4,5)) "1,2,3,4,5" + + let () = check "vskncvew7" (System.String.Format("")) "" + let () = check "vskncvew8" (System.String.Format("{0}",box 1)) "1" + let () = check "vskncvew9" (System.String.Format("{0},{1}",box 1,box 2)) "1,2" + let () = check "vskncvewq" (System.String.Format("{0},{1},{2}",box 1,box 2,box 3)) "1,2,3" + let () = check "vskncveww" (System.String.Format("{0},{1},{2},{3}",box 1,box 2,box 3,box 4)) "1,2,3,4" + let () = check "vskncvewe" (System.String.Format("{0},{1},{2},{3},{4}",box 1,box 2,box 3,box 4,box 5)) "1,2,3,4,5" + + type C() = class + static member M( fmt:string, [] args : obj[]) = System.String.Format(fmt,args) + end + + + let () = check "vskncvewr" (C.M("")) "" + let () = check "vskncvewt" (C.M("{0}",1)) "1" + let () = check "vskncvewy" (C.M("{0},{1}",1,2)) "1,2" + let () = check "vskncvewu" (C.M("{0},{1},{2}",1,2,3)) "1,2,3" + let () = check "vskncvewi" (C.M("{0},{1},{2},{3}",1,2,3,4)) "1,2,3,4" + let () = check "vskncvewo" (C.M("{0},{1},{2},{3},{4}",1,2,3,4,5)) "1,2,3,4,5" + + let () = check "vskncvewp" (C.M("")) "" + let () = check "vskncvewa" (C.M("{0}",box 1)) "1" + let () = check "vskncvews" (C.M("{0},{1}",box 1,box 2)) "1,2" + let () = check "vskncvewd" (C.M("{0},{1},{2}",box 1,box 2,box 3)) "1,2,3" + let () = check "vskncvewf" (C.M("{0},{1},{2},{3}",box 1,box 2,box 3,box 4)) "1,2,3,4" + let () = check "vskncvewg" (C.M("{0},{1},{2},{3},{4}",box 1,box 2,box 3,box 4,box 5)) "1,2,3,4,5" + + type C2() = class + static member M( fmt:string, [] args : int[]) = System.String.Format(fmt,Array.map box args) + static member M2( fmt:string, [] args : System.ValueType[]) = System.String.Format(fmt,Array.map box args) + static member M3( fmt:string, [] args : string[]) = System.String.Format(fmt,Array.map box args) + end + + + let () = check "vskncvewh" (C2.M("")) "" + let () = check "vskncvewj" (C2.M("{0}",1)) "1" + let () = check "vskncvewk" (C2.M("{0},{1}",1,2)) "1,2" + let () = check "vskncvewl" (C2.M("{0},{1},{2}",1,2,3)) "1,2,3" + let () = check "vskncvewz" (C2.M("{0},{1},{2},{3}",1,2,3,4)) "1,2,3,4" + let () = check "vskncvewx" (C2.M("{0},{1},{2},{3},{4}",1,2,3,4,5)) "1,2,3,4,5" + + let () = check "vskncvewc" (C2.M("")) "" + + let () = check "vskncvewv" (C2.M2("")) "" + let () = check "vskncvewb" (C2.M2("{0}",1)) "1" + let () = check "vskncvewn" (C2.M2("{0},{1}",1,2)) "1,2" + let () = check "vskncvewm" (C2.M2("{0},{1},{2}",1,2,3)) "1,2,3" + let () = check "vskncvewQ" (C2.M2("{0},{1},{2},{3}",1,2,3,4)) "1,2,3,4" + let () = check "vskncvewW" (C2.M2("{0},{1},{2},{3},{4}",1,2,3,4,5)) "1,2,3,4,5" + + let () = check "vskncvewE" (C2.M2("")) "" + + let () = check "vskncvewR" (C2.M("")) "" + + let () = check "vskncvewT" (C2.M3("")) "" + let () = check "vskncvewY" (C2.M3("{0}","1")) "1" + let () = check "vskncvewU" (C2.M3("{0},{1}","1","2")) "1,2" + +end + +module MiscTest = begin + + let f () () = 1 +end + + +module NewConstraintUtilizedInTypeEstablishment_FSharp_1_0_4850 = begin + type I<'self> when 'self : (new : unit -> 'self) = interface + abstract foo : int + end + + type C = class + val private f : int + new() = {f= 0} + interface I with + member x.foo = x.f + 1 + end + end + + + type D() = class + let f = 0 + interface I with + member x.foo = f + 1 + end + end + +end + +module TestTupleOverloadRules_Bug5985 = begin + + type C() = + class + member device.CheckCooperativeLevel() = true + member device.CheckCooperativeLevel([] x:byref) = true + end + + let c = C() + + let z = c.CheckCooperativeLevel() + let _ : bool = z + let a,b = c.CheckCooperativeLevel() +end + +module AutoProps = begin + + type C(ppppp:int) = + /// Test doc StaticProperty + static let ssss = 11 + member val Property = printfn "Property..."; ppppp + member val PropertyExplicitGet = printfn "PropertyExplicitGet..."; ppppp with get + + static member val StaticProperty = printfn "StaticProperty..."; 3 + ssss + static member val StaticPropertyExplicitGet = printfn "StaticPropertyExplicitGet..."; 3 + ssss with get + + /// Test doc SettableProperty + member val SettableProperty = printfn "SettableProperty..."; ppppp with get, set + + /// Test doc MutableStaticProperty + static member val SettableStaticProperty = printfn "SettableStaticProperty..."; 4 + 5 with get, set + + // --- these have type definitions + + /// Test doc PropertyWithType + member val PropertyWithType : int = ppppp + /// Test doc StaticPropertyWithType + static member val StaticPropertyWithType : int = 6 + + /// Test doc SettablePropertyWithType + member val SettablePropertyWithType : int = ppppp with get,set + /// Test doc SettableStaticPropertyWithType + static member val SettableStaticPropertyWithType : int = 7 + 8 with get,set + + // --- use them + + member this.PUse = printfn "PUse..."; this.Property + 9 + member this.PEGUse = printfn "PUse..."; this.PropertyExplicitGet + 9 + member this.QUse = printfn "QUse..."; this.SettableProperty + 10 + member this.QSet() = printfn "QUse..."; this.SettableProperty <- 11 + static member SPUse = printfn "SPUse..."; C.StaticProperty + 12 + static member SPEGUse = printfn "SPUse..."; C.StaticPropertyExplicitGet + 12 + static member SQUse = printfn "SQUse..."; C.SettableStaticProperty + 13 + static member SQSet() = printfn "SQUse..."; C.SettableStaticProperty <- 14 + + member this.TPUse = printfn "PUse..."; this.PropertyWithType + 15 + member this.TQUse = printfn "QUse..."; this.SettablePropertyWithType + 16 + member this.TQSet() = printfn "QUse..."; this.SettablePropertyWithType <- 17 + static member TSPUse = printfn "SPUse..."; C.StaticPropertyWithType + 18 + static member TSQUse = printfn "SQUse..."; C.SettableStaticPropertyWithType + 19 + static member TSQSet() = printfn "SQUse..."; C.SettableStaticPropertyWithType <- 20 + + let c = C(3) + + check "xcelekncew900" c.Property 3 + check "xcelekncew901" c.PropertyExplicitGet 3 + check "xcelekncew902" c.SettableProperty 3 + c.QSet() + check "xcelekncew903" c.SettableProperty 11 + c.SettableProperty <- 3 + check "xcelekncew902" c.SettableProperty 3 + + check "xcelekncew904" C.StaticProperty 14 + check "xcelekncew904b" C.StaticPropertyExplicitGet 14 + check "xcelekncew905" C.SettableStaticProperty 9 + C.SQSet() + check "xcelekncew905" C.SettableStaticProperty 14 + C.SettableStaticProperty <- 9 + + + + check "celekncew901" c.PUse 12 + check "celekncew902" c.QUse 13 + c.QSet() + check "celekncew903" c.QUse 21 + + check "celekncew904" C.SPUse 26 + check "celekncew905" C.SQUse 22 + C.SQSet() + check "celekncew906" C.SQUse 27 + +end + +module AutoProps_2 = begin + + // basic + type C0(x:int) = + member val Property = x with get, set + + let c0 = C0(10) + check "autoprops_200" c0.Property 10 + c0.Property <- 5 + check "autoprops_201" c0.Property 5 + + // override - property + [] + type C1() = + abstract Property : int + + type D1() = + inherit C1() + override val Property = 10 + + let c1 = D1() + check "autoprops_210" c1.Property 10 + + // override - getter + [] + type C2() = + abstract Property : int with get + + type D2() = + inherit C2() + override val Property = 12 + + let c2 = D2() + check "autoprops_220" c2.Property 12 + + type D21() = + inherit C2() + override val Property = 8 with get + + let c21 = D21() + check "autoprops_221" c21.Property 8 + + // override - setter + [] + type C3() = + abstract Property : int with get, set + + type D3() = + inherit C3() + override val Property = 12+9 with get, set + + let c3 = D3() + check "autoprops_230" c3.Property 21 + c3.Property <- 5 + check "autoprops_231" c3.Property 5 + + // default + type C4() = + abstract Property : int with get, set + default val Property = 3 with get, set + + let c4 = C4() + check "autoprops_240" c4.Property 3 + c4.Property <- 19 + check "autoprops_241" c4.Property 19 + + type D4() = + inherit C4() + override val Property = 4 with get, set + + let c41 = D4() + check "autoprops_242" c41.Property 4 + c41.Property <- 13 + check "autoprops_243" c41.Property 13 + + // interface + type I5 = + abstract Property : int + + type C5() = + interface I5 with + member val Property = 43 + + let c5 = C5() :> I5 + check "autoprops_250" c5.Property 43 + + type I51 = + abstract Property : int + + type C51() = + interface I51 with + override val Property = 31 + + let c51 = C51() :> I51 + check "autoprops_251" c51.Property 31 + + // interface - setter + type I6 = + abstract Property : int with get, set + + type C6(x:int) = + interface I6 with + member val Property = x with get, set + + let c6 = C6(17) + check "autoprops_260" (c6 :> I6).Property 17 + + let c61 = C6(23) :> I6 + check "autoprops_261" c61.Property 23 + c61.Property <- c61.Property + 21 + check "autoprops_262" c61.Property 44 +end + +module MoreKindInferenceTests = + + [] + type C1<'a> = class member _.Foo(x:'a) = x end + + + diff --git a/tests/fsharp/core/mixCurriedTupled/test.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/mix_curried_tupled.fsx similarity index 100% rename from tests/fsharp/core/mixCurriedTupled/test.fsx rename to tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/mix_curried_tupled.fsx diff --git a/tests/fsharp/core/nestedModule/test.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/nested_module.fsx similarity index 100% rename from tests/fsharp/core/nestedModule/test.fsx rename to tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/nested_module.fsx diff --git a/tests/fsharp/core/nestedModuleInNamespace/test.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/nested_module_in_namespace.fsx similarity index 100% rename from tests/fsharp/core/nestedModuleInNamespace/test.fsx rename to tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/nested_module_in_namespace.fsx diff --git a/tests/fsharp/core/recursiveNestedModule/test.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/recursive_nested_module.fsx similarity index 100% rename from tests/fsharp/core/recursiveNestedModule/test.fsx rename to tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/recursive_nested_module.fsx diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/struct_private_field_repro.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/struct_private_field_repro.fsx new file mode 100644 index 00000000000..7d1f1e67687 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/struct_private_field_repro.fsx @@ -0,0 +1,7 @@ +module StructPrivateField = + [] + [] + type C = + [] + val mutable (* private. uncomment the private modifier to see an error *) goo : byte [] + member this.P with set(x) = this.goo <- x \ No newline at end of file diff --git a/tests/fsharp/core/typeAliasPrimitives/test.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/type_alias_primitives.fsx similarity index 100% rename from tests/fsharp/core/typeAliasPrimitives/test.fsx rename to tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/type_alias_primitives.fsx diff --git a/tests/fsharp/core/typeAugmentation/test.fsx b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/type_augmentation.fsx similarity index 100% rename from tests/fsharp/core/typeAugmentation/test.fsx rename to tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/type_augmentation.fsx diff --git a/tests/fsharp/core/unionWithFunctionType/test.fs b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/union_with_function_type.fs similarity index 100% rename from tests/fsharp/core/unionWithFunctionType/test.fs rename to tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/union_with_function_type.fs diff --git a/tests/fsharp/core/zeroConstraint/test.fs b/tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/zero_constraint.fs similarity index 100% rename from tests/fsharp/core/zeroConstraint/test.fs rename to tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/zero_constraint.fs diff --git a/tests/fsharp/core/innerpoly/test.fsx b/tests/fsharp/core/innerpoly/test.fsx index 4dd3e65f7cb..cdd873d2367 100644 --- a/tests/fsharp/core/innerpoly/test.fsx +++ b/tests/fsharp/core/innerpoly/test.fsx @@ -447,8 +447,7 @@ module Bug11620A = let getService () : 'Data = createService thing (fun () -> getService) -// The generated signature for this bug repro has mistakes, we are not enabling it yet -#if !FSC_NETFX_TEST_GENERATED_SIGNATURE + module Bug11620B = type Data = interface end @@ -476,8 +475,6 @@ module Bug11620B = main () -#endif - #if TESTS_AS_APP let RUN() = !failures diff --git a/tests/fsharp/single-test.fs b/tests/fsharp/single-test.fs index 6d7b401e003..1b327d49158 100644 --- a/tests/fsharp/single-test.fs +++ b/tests/fsharp/single-test.fs @@ -15,7 +15,6 @@ type Permutation = | FSC_NETFX of optimized: bool * buildOnly: bool | FSI_NETFX | FSI_NETFX_STDIN - | FSC_NETFX_TEST_GENERATED_SIGNATURE | FSC_NETFX_TEST_ROUNDTRIP_AS_DLL #endif @@ -326,25 +325,6 @@ let singleTestBuildAndRunCore cfg copyFiles p languageVersion = testOkFile.CheckExists() - | FSC_NETFX_TEST_GENERATED_SIGNATURE -> - use _cleanup = (cleanUpFSharpCore cfg) - - let source1 = - ["test.ml"; "test.fs"; "test.fsx"] - |> List.rev - |> List.tryFind (fileExists cfg) - - source1 |> Option.iter (fun from -> copy cfg from "tmptest.fs") - - log "Generated signature file..." - fsc cfg "%s --sig:tmptest.fsi --define:FSC_NETFX_TEST_GENERATED_SIGNATURE" cfg.fsc_flags ["tmptest.fs"] - - log "Compiling against generated signature file..." - fsc cfg "%s -o:tmptest1.exe" cfg.fsc_flags ["tmptest.fsi";"tmptest.fs"] - - log "Verifying built .exe..." - peverify cfg "tmptest1.exe" - | FSC_NETFX_TEST_ROUNDTRIP_AS_DLL -> // Compile as a DLL to exercise pickling of interface data, then recompile the original source file referencing this DLL // THe second compilation will not utilize the information from the first in any meaningful way, but the diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index d0a664d7cc5..c43b1aceabf 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -3364,57 +3364,6 @@ namespace CST.RI.Anshun fileVersionInfo.ProductVersion |> Assert.areEqual expected -module GeneratedSignatureTests = - [] - let ``libtest-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/libtest" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``members-basics-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/members/basics" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``access-FSC_NETFX_TEST_GENERATED_SIGNATURE``() = singleTestBuildAndRun "core/access" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``array-FSC_NETFX_TEST_GENERATED_SIGNATURE``() = singleTestBuildAndRun "core/array" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``genericmeasures-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/genericmeasures" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``innerpoly-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/innerpoly" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``measures-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/measures" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``nestedModule-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/nestedModule" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``recursiveNestedModule-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/recursiveNestedModule" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``nestedModuleInNamespace-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/nestedModuleInNamespace" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``classStructInterface-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/classStructInterface" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``typeAugmentation-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/typeAugmentation" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``typeAliasPrimitives-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/typeAliasPrimitives" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``functionTypes-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/functionTypes" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``unionWithFunctionType-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/unionWithFunctionType" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``mixCurriedTupled-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/mixCurriedTupled" FSC_NETFX_TEST_GENERATED_SIGNATURE - - [] - let ``zeroConstraint-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/zeroConstraint" FSC_NETFX_TEST_GENERATED_SIGNATURE #endif #if !NETCOREAPP From 903d39cf04424dea4bf35ce2377b06e73cda9839 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 15 Nov 2022 23:50:07 +0100 Subject: [PATCH 09/14] fix 12761 (#13865) (#14323) Co-authored-by: Don Syme --- src/Compiler/CodeGen/IlxGen.fs | 8 ++- src/Compiler/TypedTree/TypedTreeOps.fs | 19 ++++- src/Compiler/TypedTree/TypedTreeOps.fsi | 7 +- .../Microsoft.FSharp.Control/Tasks.fs | 69 +++++++++++++++++++ 4 files changed, 99 insertions(+), 4 deletions(-) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index c6b672815cf..009c6875ce4 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -6709,7 +6709,13 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenvouter takenN NestedTypeRefForCompLoc eenvouter.cloc cloName // Collect the free variables of the closure - let cloFreeVarResults = freeInExpr (CollectTyparsAndLocalsWithStackGuard()) expr + let cloFreeVarResults = + let opts = CollectTyparsAndLocalsWithStackGuard() + let opts = + match eenvouter.tyenv.TemplateReplacement with + | None -> opts + | Some (tcref, _, typars, _) -> opts.WithTemplateReplacement(tyconRefEq g tcref, typars) + freeInExpr opts expr // Partition the free variables when some can be accessed from places besides the immediate environment // Also filter out the current value being bound, if any, as it is available from the "this" diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 5cc97531e16..11de6b954a6 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -2133,7 +2133,10 @@ type FreeVarOptions = includeRecdFields: bool includeUnionCases: bool includeLocals: bool + templateReplacement: ((TyconRef -> bool) * Typars) option stackGuard: StackGuard option } + + member this.WithTemplateReplacement(f, typars) = { this with templateReplacement = Some (f, typars) } let CollectAllNoCaching = { canCache = false @@ -2144,6 +2147,7 @@ let CollectAllNoCaching = includeUnionCases = true includeTypars = true includeLocals = true + templateReplacement = None stackGuard = None} let CollectTyparsNoCaching = @@ -2155,6 +2159,7 @@ let CollectTyparsNoCaching = includeRecdFields = false includeUnionCases = false includeLocals = false + templateReplacement = None stackGuard = None } let CollectLocalsNoCaching = @@ -2166,6 +2171,7 @@ let CollectLocalsNoCaching = includeRecdFields = false includeUnionCases = false includeLocals = true + templateReplacement = None stackGuard = None } let CollectTyparsAndLocalsNoCaching = @@ -2177,6 +2183,7 @@ let CollectTyparsAndLocalsNoCaching = includeUnionCases = false includeTypars = true includeLocals = true + templateReplacement = None stackGuard = None } let CollectAll = @@ -2188,6 +2195,7 @@ let CollectAll = includeUnionCases = true includeTypars = true includeLocals = true + templateReplacement = None stackGuard = None } let CollectTyparsAndLocalsImpl stackGuardOpt = // CollectAll @@ -2199,6 +2207,7 @@ let CollectTyparsAndLocalsImpl stackGuardOpt = // CollectAll includeLocalTyconReprs = false includeRecdFields = false includeUnionCases = false + templateReplacement = None stackGuard = stackGuardOpt } @@ -2219,12 +2228,18 @@ let accFreeLocalTycon opts x acc = if Zset.contains x acc.FreeTycons then acc else { acc with FreeTycons = Zset.add x acc.FreeTycons } -let accFreeTycon opts (tcref: TyconRef) acc = +let rec accFreeTycon opts (tcref: TyconRef) acc = + let acc = + match opts.templateReplacement with + | Some (isTemplateTyconRef, cloFreeTyvars) when isTemplateTyconRef tcref -> + let cloInst = List.map mkTyparTy cloFreeTyvars + accFreeInTypes opts cloInst acc + | _ -> acc if not opts.includeLocalTycons then acc elif tcref.IsLocalRef then accFreeLocalTycon opts tcref.ResolvedTarget acc else acc -let rec boundTypars opts tps acc = +and boundTypars opts tps acc = // Bound type vars form a recursively-referential set due to constraints, e.g. A: I, B: I // So collect up free vars in all constraints first, then bind all variables let acc = List.foldBack (fun (tp: Typar) acc -> accFreeInTyparConstraints opts tp.Constraints acc) tps acc diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 17d9cc60766..08f1c4693cc 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -796,7 +796,12 @@ val emptyFreeLocals: FreeLocals val unionFreeLocals: FreeLocals -> FreeLocals -> FreeLocals -type FreeVarOptions +/// Represents the options to activate when collecting free variables +[] +type FreeVarOptions = + /// During backend code generation of state machines, register a template replacement for struct types. + /// This may introduce new free variables related to the instantiation of the struct type. + member WithTemplateReplacement: (TyconRef -> bool) * Typars -> FreeVarOptions val CollectLocalsNoCaching: FreeVarOptions diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs index bf6c8cc1e14..4af1df56d39 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs @@ -1259,6 +1259,75 @@ type BasicsNotInParallel() = require ran "never ran") taskOuter.Wait() + [] + member _.testGenericBackgroundTasks() = + printfn "Running testBackgroundTask..." + for i in 1 .. 5 do + let mutable ran = false + let mutable posted = false + let oldSyncContext = SynchronizationContext.Current + let syncContext = { new SynchronizationContext() with member _.Post(d,state) = posted <- true; d.Invoke(state) } + try + SynchronizationContext.SetSynchronizationContext syncContext + let f (result: 'T ref) (x: 'T) = + backgroundTask { + require (System.Threading.Thread.CurrentThread.IsThreadPoolThread) "expect to be on background thread" + ran <- true + result.Value <- x + } + let t = f (ref "") "hello" + t.Wait() + let t2 = f (ref 1) 1 + t2.Wait() + require ran "never ran" + require (not posted) "did not expect post to sync context" + finally + SynchronizationContext.SetSynchronizationContext oldSyncContext + + +/// https://github.com/dotnet/fsharp/issues/12761 +module Test12761A = + + type Dto = { + DtoValue : string + Key : string + } + + type MyGenericType<'Key,'Value> = { + Value : 'Value + Key : 'Key + } + + type ProblematicType<'Key, 'Value, 'Dto, 'E>( fromDto : 'Dto -> Result,'E> ) = + let myTask = + backgroundTask { + let dto = """{"DtoValue":"1","Key":"key1"}""" |> box |> unbox<'Dto> + return fromDto dto |> printfn "%A" + } + member __.ContainsKey = fun (key: 'Key) -> true + + + type MyType = MyGenericType + + module MyType = + let fromDto (dto: Dto) = + try + { + Value = int dto.DtoValue + Key = dto.Key + } + |> Ok + with | e -> Error e + + +/// https://github.com/dotnet/fsharp/issues/12761 +module Test12761B = + let TestFunction<'Dto>() = + backgroundTask { + let dto = Unchecked.defaultof<'Dto> + System.Console.WriteLine(dto) + } + type Issue12184() = member this.TaskMethod() = task { From 1c5b56cfdf39a19b580abad68fad658c42b6f58e Mon Sep 17 00:00:00 2001 From: Nino Floris Date: Mon, 14 Nov 2022 21:06:31 +0100 Subject: [PATCH 10/14] Prefer nullable over other conversions, fixes #14302 --- src/Compiler/Checking/CheckExpressions.fs | 2 +- src/Compiler/Checking/ConstraintSolver.fs | 14 ++-- src/Compiler/Checking/MethodCalls.fs | 22 ++++--- src/Compiler/Checking/MethodCalls.fsi | 2 +- .../Language/TypeDirectedConversionTests.fs | 65 ++++++++++++++++++- 5 files changed, 88 insertions(+), 17 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 1b65421daba..d40479f76ee 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -453,7 +453,7 @@ let UnifyOverallType (cenv: cenv) (env: TcEnv) m overallTy actualTy = | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes(warn, _) -> warning(warn env.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _, _) -> warning(warn env.DisplayEnv) | TypeDirectedConversionUsed.No -> () if AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m reqdTy2 actualTy then diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index c69db854c24..82aaaf3f5e5 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -2738,7 +2738,7 @@ and ArgsMustSubsumeOrConvert msg csenv.DisplayEnv | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _, _) -> do! WarnD(warn csenv.DisplayEnv) | TypeDirectedConversionUsed.No -> () do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln (Some calledArg.CalledArgumentType) calledArgTy callerArg.CallerArgumentType if calledArg.IsParamArray && isArray1DTy g calledArgTy && not (isArray1DTy g callerArg.CallerArgumentType) then @@ -2769,7 +2769,7 @@ and ArgsMustSubsumeOrConvertWithContextualReport msg csenv.DisplayEnv | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _, _) -> do! WarnD(warn csenv.DisplayEnv) | TypeDirectedConversionUsed.No -> () do! SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln (Some calledArg.CalledArgumentType) calledArgTy callerArgTy (fun e -> ArgDoesNotMatchError(e :?> _, calledMeth, calledArg, callerArg)) return usesTDC @@ -2796,7 +2796,7 @@ and ReturnTypesMustSubsumeOrConvert (csenv: ConstraintSolverEnv) ad ndeep trace msg csenv.DisplayEnv | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _, _) -> do! WarnD(warn csenv.DisplayEnv) | TypeDirectedConversionUsed.No -> () do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln None reqdTy actualTy return usesTDC @@ -2813,7 +2813,7 @@ and ArgsEquivOrConvert (csenv: ConstraintSolverEnv) ad ndeep trace cxsln isConst msg csenv.DisplayEnv | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _, _) -> do! WarnD(warn csenv.DisplayEnv) | TypeDirectedConversionUsed.No -> () if not (typeEquiv csenv.g calledArgTy callerArgTy) then return! ErrorD(Error(FSComp.SR.csArgumentTypesDoNotMatch(), m)) @@ -3225,7 +3225,11 @@ and GetMostApplicableOverload csenv ndeep candidates applicableMeths calledMethG if c <> 0 then c else // Prefer methods that need less type-directed conversion - let c = compare (match usesTDC1 with TypeDirectedConversionUsed.Yes(_, false) -> 1 | _ -> 0) (match usesTDC2 with TypeDirectedConversionUsed.Yes(_, false) -> 1 | _ -> 0) + let c = compare (match usesTDC1 with TypeDirectedConversionUsed.Yes(_, false, _) -> 1 | _ -> 0) (match usesTDC2 with TypeDirectedConversionUsed.Yes(_, false, _) -> 1 | _ -> 0) + if c <> 0 then c else + + // Prefer methods that only have nullable type-directed conversions + let c = compare (match usesTDC1 with TypeDirectedConversionUsed.Yes(_, _, true) -> 1 | _ -> 0) (match usesTDC2 with TypeDirectedConversionUsed.Yes(_, _, true) -> 1 | _ -> 0) if c <> 0 then c else // Prefer methods that don't give "this code is less generic" warnings diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index c524b1bd03f..d575e9e1f03 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -236,12 +236,16 @@ type TypeDirectedConversion = [] type TypeDirectedConversionUsed = - | Yes of (DisplayEnv -> exn) * isTwoStepConversion: bool + | Yes of (DisplayEnv -> exn) * isTwoStepConversion: bool * isNullable: bool | No static member Combine a b = match a, b with - | Yes(_,true), _ -> a - | _, Yes(_,true) -> b + // We want to know which candidates have one or more nullable conversions exclusively + // If one of the values is false we flow false for both. + | Yes(_, true, false), _ -> a + | _, Yes(_, true, false) -> b + | Yes(_, true, _), _ -> a + | _, Yes(_, true, _) -> b | Yes _, _ -> a | _, Yes _ -> b | No, No -> a @@ -282,25 +286,25 @@ let rec AdjustRequiredTypeForTypeDirectedConversions (infoReader: InfoReader) ad // Adhoc int32 --> int64 elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.int64_ty reqdTy && typeEquiv g g.int32_ty actualTy then - g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None + g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false, false), None // Adhoc int32 --> nativeint elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.nativeint_ty reqdTy && typeEquiv g g.int32_ty actualTy then - g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None + g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false, false), None // Adhoc int32 --> float64 elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.float_ty reqdTy && typeEquiv g g.int32_ty actualTy then - g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None + g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false, false), None elif g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop && isMethodArg && isNullableTy g reqdTy && not (isNullableTy g actualTy) then let underlyingTy = destNullableTy g reqdTy // shortcut if typeEquiv g underlyingTy actualTy then - actualTy, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None + actualTy, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false, true), None else let adjustedTy, _, _ = AdjustRequiredTypeForTypeDirectedConversions infoReader ad isMethodArg isConstraint underlyingTy actualTy m if typeEquiv g adjustedTy actualTy then - actualTy, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, true), None + actualTy, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, true, true), None else reqdTy, TypeDirectedConversionUsed.No, None @@ -308,7 +312,7 @@ let rec AdjustRequiredTypeForTypeDirectedConversions (infoReader: InfoReader) ad // eliminate articifical constrained type variables. elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions then match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with - | Some (minfo, _staticTy, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo), false), Some eqn + | Some (minfo, _staticTy, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo), false, false), Some eqn | None -> reqdTy, TypeDirectedConversionUsed.No, None else reqdTy, TypeDirectedConversionUsed.No, None diff --git a/src/Compiler/Checking/MethodCalls.fsi b/src/Compiler/Checking/MethodCalls.fsi index a70827d8fec..60a5ace7201 100644 --- a/src/Compiler/Checking/MethodCalls.fsi +++ b/src/Compiler/Checking/MethodCalls.fsi @@ -119,7 +119,7 @@ type CallerArgs<'T> = /// has been used in F# code [] type TypeDirectedConversionUsed = - | Yes of (DisplayEnv -> exn) * isTwoStepConversion: bool + | Yes of (DisplayEnv -> exn) * isTwoStepConversion: bool * isNullable: bool | No static member Combine: TypeDirectedConversionUsed -> TypeDirectedConversionUsed -> TypeDirectedConversionUsed diff --git a/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs b/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs index be31e72712e..9055740f2a1 100644 --- a/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs +++ b/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs @@ -303,7 +303,7 @@ let test(x: 'T) = (11, 5, 11, 11) """This construct causes code to be less generic than indicated by the type annotations. The type variable 'T has been constrained to be type 'int'.""" - [] + [] let ``Picking overload for typar fails when incompatible types are part of the candidate set``() = CompilerAssert.TypeCheckWithErrors """ @@ -440,3 +440,66 @@ let test() = if not (test().OtherArgs.Value.Name = "test") then failwith "Unexpected value was returned after setting Name" """ [] + + [] + let ``Prefer nullable conversion only candidate when multiple candidates require conversions``() = + CompilerAssert.RunScript + """ +type M() = + static member A(size: int64 array, dtype: System.Nullable) = 1 + static member A(size: System.ReadOnlySpan, dtype: System.Nullable) = 2 + +let test() = M.A([|10L|], 1) + +if test() <> 1 then failwith "Incorrect overload picked" + """ [] + + [] + let ``Prefer nullable conversion over numeric conversion``() = + CompilerAssert.RunScript + """ +type M() = + static member A(n: int64) = 1 + static member A(n: System.Nullable) = 2 + +let test() = M.A(0) + +if test() <> 2 then failwith "Incorrect overload picked" + """ [] + + [] + let ``Prefer nullable conversion over op_Implicit conversion``() = + + CompilerAssert.RunScript + """ +type M() = + static member A(n: System.DateTimeOffset) = 1 + static member A(n: System.Nullable) = 2 + +let test() = M.A(System.DateTime.UtcNow) + +if test() <> 2 then failwith "Incorrect overload picked" + """ [] + + + [] + let ``Picking overload for TDC candidate set fails as ambiguous while one candidate requires more conversions``() = + CompilerAssert.TypeCheckSingleError + """ +type M() = + static member A(m: int64 array, n: int64) = 1 + static member A(m: System.ReadOnlySpan, n: int64) = 2 + +let test() = M.A([|10L|], 1) + """ + FSharpDiagnosticSeverity.Error + 41 + (6, 14, 6, 29) + """A unique overload for method 'A' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known types of arguments: int64[] * int + +Candidates: + - static member M.A: m: System.ReadOnlySpan * n: int64 -> int + - static member M.A: m: System.ReadOnlySpan * n: int64 -> int + - static member M.A: m: int64 array * n: int64 -> int""" From 1617183a7e8094f29018245a466744f40acb5f57 Mon Sep 17 00:00:00 2001 From: Nino Floris Date: Tue, 15 Nov 2022 14:48:53 +0100 Subject: [PATCH 11/14] Replace ROSpan for DateTimeOffset as op_Implicit target, ROSpan is not defined on all test TFMs --- .../Language/TypeDirectedConversionTests.fs | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs b/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs index 9055740f2a1..054664224c9 100644 --- a/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs +++ b/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs @@ -446,10 +446,10 @@ if not (test().OtherArgs.Value.Name = "test") then failwith "Unexpected value wa CompilerAssert.RunScript """ type M() = - static member A(size: int64 array, dtype: System.Nullable) = 1 - static member A(size: System.ReadOnlySpan, dtype: System.Nullable) = 2 + static member A(size: System.DateTime, dtype: System.Nullable) = 1 + static member A(size: System.DateTimeOffset, dtype: System.Nullable) = 2 -let test() = M.A([|10L|], 1) +let test() = M.A(System.DateTime.UtcNow, 1) if test() <> 1 then failwith "Incorrect overload picked" """ [] @@ -487,19 +487,19 @@ if test() <> 2 then failwith "Incorrect overload picked" CompilerAssert.TypeCheckSingleError """ type M() = - static member A(m: int64 array, n: int64) = 1 - static member A(m: System.ReadOnlySpan, n: int64) = 2 + static member A(m: System.DateTime, n: int64) = 1 + static member A(m: System.DateTimeOffset, n: int64) = 2 -let test() = M.A([|10L|], 1) +let test() = M.A(System.DateTime.UtcNow, 1) """ FSharpDiagnosticSeverity.Error 41 - (6, 14, 6, 29) + (6, 14, 6, 44) """A unique overload for method 'A' could not be determined based on type information prior to this program point. A type annotation may be needed. -Known types of arguments: int64[] * int +Known types of arguments: System.DateTime * int Candidates: - - static member M.A: m: System.ReadOnlySpan * n: int64 -> int - - static member M.A: m: System.ReadOnlySpan * n: int64 -> int - - static member M.A: m: int64 array * n: int64 -> int""" + - static member M.A: m: System.DateTime * n: int64 -> int + - static member M.A: m: System.DateTimeOffset * n: int64 -> int + - static member M.A: m: System.DateTimeOffset * n: int64 -> int""" From 880802938dc62b96a9b2eb8bae019ad68d22d7dc Mon Sep 17 00:00:00 2001 From: Adam Boniecki <20281641+abonie@users.noreply.github.com> Date: Fri, 18 Nov 2022 09:50:12 +0100 Subject: [PATCH 12/14] Fix the issue (#14334) The problem was that we had some cached lexer state when reading new input during FSI session. If lexer threw an error on a very first token of new input, the cached lexer state would not get updated, so we would assosciate old lexer state with this new token that caused an error. Now we will invalidate that cached state at the begining of reading new input. Co-authored-by: Adam Boniecki --- src/Compiler/SyntaxTree/LexFilter.fs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Compiler/SyntaxTree/LexFilter.fs b/src/Compiler/SyntaxTree/LexFilter.fs index 88a743a6bf2..14a43332424 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fs +++ b/src/Compiler/SyntaxTree/LexFilter.fs @@ -699,6 +699,8 @@ type LexFilterImpl ( let mutable prevWasAtomicEnd = false let peekInitial() = + // Forget the lexbuf state we might have saved from previous input + haveLexbufState <- false let initialLookaheadTokenTup = popNextTokenTup() if debug then dprintf "first token: initialLookaheadTokenLexbufState = %a\n" outputPos (startPosOfTokenTup initialLookaheadTokenTup) From 4e7b3cb9bcfd752f2f8638d4fe0e8bae8385f4c7 Mon Sep 17 00:00:00 2001 From: "Kevin Ransom (msft)" Date: Fri, 18 Nov 2022 01:23:33 -0800 Subject: [PATCH 13/14] Caching (#14345) * Caching * fantomas --- .../FSharp.DependencyManager.Utilities.fs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs index 8a1b526837a..14f55dc6fb4 100644 --- a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs +++ b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs @@ -64,7 +64,6 @@ module internal Utilities = |> Array.filter (fun r -> not (String.IsNullOrEmpty(r.NugetPackageId) || String.IsNullOrEmpty(r.FullPath)) && not (equals r.IsNotImplementationReference "true") - && File.Exists(r.FullPath) && equals r.AssetType "runtime") |> Array.map (fun r -> r.FullPath) |> Array.distinct @@ -260,7 +259,12 @@ module internal Utilities = let resolutionsFile, resolutions, references, loads, includes = if success && File.Exists(outputFile) then let resolutions = getResolutionsFromFile outputFile - let references = (findReferencesFromResolutions resolutions) |> Array.toList + + let references = + (findReferencesFromResolutions resolutions) + |> Array.filter (File.Exists) + |> Array.toList + let loads = (findLoadsFromResolutions resolutions) |> Array.toList let includes = (findIncludesFromResolutions resolutions) |> Array.toList (Some outputFile), resolutions, references, loads, includes From 875dbcc695d1ffdb20e3e899ba9a006df76fe051 Mon Sep 17 00:00:00 2001 From: "Kevin Ransom (msft)" Date: Fri, 18 Nov 2022 10:26:01 -0800 Subject: [PATCH 14/14] Remove dependence on microsoft.build from FCS (#14341) * temp * remove msbuild dependence from fcs * remove temp diagnostic --- eng/Versions.props | 4 +- src/Compiler/FSComp.txt | 4 - src/Compiler/FSharp.Compiler.Service.fsproj | 5 - src/Compiler/FSharp.Compiler.Service.nuspec | 3 - src/Compiler/Facilities/ReferenceResolver.fs | 4 +- src/Compiler/Facilities/ReferenceResolver.fsi | 10 +- .../SimulatedMSBuildReferenceResolver.fs | 632 +++++++++--------- .../Legacy/LegacyMSBuildReferenceResolver.fs | 366 ---------- src/Compiler/xlf/FSComp.txt.cs.xlf | 20 - src/Compiler/xlf/FSComp.txt.de.xlf | 20 - src/Compiler/xlf/FSComp.txt.es.xlf | 20 - src/Compiler/xlf/FSComp.txt.fr.xlf | 20 - src/Compiler/xlf/FSComp.txt.it.xlf | 20 - src/Compiler/xlf/FSComp.txt.ja.xlf | 20 - src/Compiler/xlf/FSComp.txt.ko.xlf | 20 - src/Compiler/xlf/FSComp.txt.pl.xlf | 20 - src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 20 - src/Compiler/xlf/FSComp.txt.ru.xlf | 20 - src/Compiler/xlf/FSComp.txt.tr.xlf | 20 - src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 20 - src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 20 - .../LegacyMSBuildReferenceResolver.fs | 516 ++++++++++++++ .../LegacyMSBuildReferenceResolver.fsi | 0 src/LegacyMSBuildResolver/LegacyResolver.txt | 7 + .../xlf/LegacyResolver.txt.cs.xlf | 27 + .../xlf/LegacyResolver.txt.de.xlf | 27 + .../xlf/LegacyResolver.txt.es.xlf | 27 + .../xlf/LegacyResolver.txt.fr.xlf | 27 + .../xlf/LegacyResolver.txt.it.xlf | 27 + .../xlf/LegacyResolver.txt.ja.xlf | 27 + .../xlf/LegacyResolver.txt.ko.xlf | 27 + .../xlf/LegacyResolver.txt.pl.xlf | 27 + .../xlf/LegacyResolver.txt.pt-BR.xlf | 27 + .../xlf/LegacyResolver.txt.ru.xlf | 27 + .../xlf/LegacyResolver.txt.tr.xlf | 27 + .../xlf/LegacyResolver.txt.zh-Hans.xlf | 27 + .../xlf/LegacyResolver.txt.zh-Hant.xlf | 27 + src/fsc/fsc.targets | 8 + src/fsi/fsi.targets | 11 + ...erService.SurfaceArea.netstandard.expected | 49 +- .../HostedCompilerServer.fsproj | 11 + .../src/FSharp.Editor/FSharp.Editor.fsproj | 5 + 42 files changed, 1270 insertions(+), 976 deletions(-) delete mode 100644 src/Compiler/Legacy/LegacyMSBuildReferenceResolver.fs create mode 100644 src/LegacyMSBuildResolver/LegacyMSBuildReferenceResolver.fs rename src/{Compiler/Legacy => LegacyMSBuildResolver}/LegacyMSBuildReferenceResolver.fsi (100%) create mode 100644 src/LegacyMSBuildResolver/LegacyResolver.txt create mode 100644 src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.cs.xlf create mode 100644 src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.de.xlf create mode 100644 src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.es.xlf create mode 100644 src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.fr.xlf create mode 100644 src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.it.xlf create mode 100644 src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.ja.xlf create mode 100644 src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.ko.xlf create mode 100644 src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.pl.xlf create mode 100644 src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.pt-BR.xlf create mode 100644 src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.ru.xlf create mode 100644 src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.tr.xlf create mode 100644 src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.zh-Hans.xlf create mode 100644 src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.zh-Hant.xlf diff --git a/eng/Versions.props b/eng/Versions.props index 59553717f2f..979442cba5e 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -31,9 +31,9 @@ 6.0.0.0 - 42 + 43 7 - 100 + 102 $(FSRevisionVersion) $(FCSMajorVersion).$(FCSMinorVersion).$(FCSBuildVersion) $(FCSMajorVersion).$(FCSMinorVersion).$(FCSBuildVersion).$(FCSRevisionVersion) diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 53cfa341667..2fca7afeb60 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -962,10 +962,6 @@ typeInfoFromFirst,"from %s" typeInfoFromNext,"also from %s" typeInfoGeneratedProperty,"generated property" typeInfoGeneratedType,"generated type" -assemblyResolutionFoundByAssemblyFoldersKey,"Found by AssemblyFolders registry key" -assemblyResolutionFoundByAssemblyFoldersExKey,"Found by AssemblyFoldersEx registry key" -assemblyResolutionNetFramework,".NET Framework" -assemblyResolutionGAC,"Global Assembly Cache" 1089,recursiveClassHierarchy,"Recursive class hierarchy in type '%s'" 1090,InvalidRecursiveReferenceToAbstractSlot,"Invalid recursive reference to an abstract slot" 1091,eventHasNonStandardType,"The event '%s' has a non-standard type. If this event is declared in another CLI language, you may need to access this event using the explicit %s and %s methods for the event. If this event is declared in F#, make the type of the event an instantiation of either 'IDelegateEvent<_>' or 'IEvent<_,_>'." diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index e7468b34086..eedb771f0f3 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -461,8 +461,6 @@ - - @@ -492,9 +490,6 @@ - - - diff --git a/src/Compiler/FSharp.Compiler.Service.nuspec b/src/Compiler/FSharp.Compiler.Service.nuspec index c7b55ebb613..a60bdb81021 100644 --- a/src/Compiler/FSharp.Compiler.Service.nuspec +++ b/src/Compiler/FSharp.Compiler.Service.nuspec @@ -6,9 +6,6 @@ - - - diff --git a/src/Compiler/Facilities/ReferenceResolver.fs b/src/Compiler/Facilities/ReferenceResolver.fs index d4eeb29871d..7e825741942 100644 --- a/src/Compiler/Facilities/ReferenceResolver.fs +++ b/src/Compiler/Facilities/ReferenceResolver.fs @@ -2,7 +2,7 @@ namespace FSharp.Compiler.CodeAnalysis -exception internal LegacyResolutionFailure +exception LegacyResolutionFailure [] type LegacyResolutionEnvironment = @@ -28,7 +28,7 @@ type LegacyResolvedFile = sprintf "LegacyResolvedFile(%s)" this.itemSpec [] -type internal ILegacyReferenceResolver = +type ILegacyReferenceResolver = /// Get the "v4.5.1"-style moniker for the highest installed .NET Framework version. /// This is the value passed back to Resolve if no explicit "mscorlib" has been given. /// diff --git a/src/Compiler/Facilities/ReferenceResolver.fsi b/src/Compiler/Facilities/ReferenceResolver.fsi index 619c21d423c..8371775f956 100644 --- a/src/Compiler/Facilities/ReferenceResolver.fsi +++ b/src/Compiler/Facilities/ReferenceResolver.fsi @@ -4,17 +4,17 @@ namespace FSharp.Compiler.CodeAnalysis open System -exception internal LegacyResolutionFailure +exception LegacyResolutionFailure [] -type internal LegacyResolutionEnvironment = +type LegacyResolutionEnvironment = /// Indicates a script or source being edited or compiled. Uses reference assemblies (not implementation assemblies). | EditingOrCompilation of isEditing: bool /// Indicates a script or source being dynamically compiled and executed. Uses implementation assemblies. | CompilationAndEvaluation -type internal LegacyResolvedFile = +type LegacyResolvedFile = { /// Item specification. itemSpec: string @@ -27,7 +27,7 @@ type internal LegacyResolvedFile = } [] -type internal ILegacyReferenceResolver = +type ILegacyReferenceResolver = /// Get the "v4.5.1"-style moniker for the highest installed .NET Framework version. /// This is the value passed back to Resolve if no explicit "mscorlib" has been given. /// @@ -59,5 +59,5 @@ type internal ILegacyReferenceResolver = // outside FSharp.Compiler.Service [] type LegacyReferenceResolver = - internal new: impl: ILegacyReferenceResolver -> LegacyReferenceResolver + new: impl: ILegacyReferenceResolver -> LegacyReferenceResolver member internal Impl: ILegacyReferenceResolver diff --git a/src/Compiler/Facilities/SimulatedMSBuildReferenceResolver.fs b/src/Compiler/Facilities/SimulatedMSBuildReferenceResolver.fs index 21d3260c5c8..b3492cb81ac 100644 --- a/src/Compiler/Facilities/SimulatedMSBuildReferenceResolver.fs +++ b/src/Compiler/Facilities/SimulatedMSBuildReferenceResolver.fs @@ -2,340 +2,318 @@ module internal FSharp.Compiler.CodeAnalysis.SimulatedMSBuildReferenceResolver -open System -open System.IO -open System.Reflection -open Microsoft.Build.Utilities -open Internal.Utilities.Library -open FSharp.Compiler.IO - -// ATTENTION!: the following code needs to be updated every time we are switching to the new MSBuild version because new .NET framework version was released -// 1. List of frameworks -// 2. DeriveTargetFrameworkDirectoriesFor45Plus -// 3. HighestInstalledRefAssembliesOrDotNETFramework -// 4. GetPathToDotNetFrameworkImlpementationAssemblies -[] -let private Net45 = "v4.5" - -[] -let private Net451 = "v4.5.1" - -[] -let private Net452 = "v4.5.2" // not available in Dev15 MSBuild version - -[] -let private Net46 = "v4.6" - -[] -let private Net461 = "v4.6.1" - -[] -let private Net462 = "v4.6.2" - -[] -let private Net47 = "v4.7" - -[] -let private Net471 = "v4.7.1" - -[] -let private Net472 = "v4.7.2" - -[] -let private Net48 = "v4.8" - -let SupportedDesktopFrameworkVersions = - [ Net48; Net472; Net471; Net47; Net462; Net461; Net46; Net452; Net451; Net45 ] - -let private SimulatedMSBuildResolver = - - /// Get the path to the .NET Framework implementation assemblies by using ToolLocationHelper.GetPathToDotNetFramework - /// This is only used to specify the "last resort" path for assembly resolution. - let GetPathToDotNetFrameworkImlpementationAssemblies v = - let v = - match v with - | Net45 -> Some TargetDotNetFrameworkVersion.Version45 - | Net451 -> Some TargetDotNetFrameworkVersion.Version451 - | Net452 -> Some TargetDotNetFrameworkVersion.Version452 - | Net46 -> Some TargetDotNetFrameworkVersion.Version46 - | Net461 -> Some TargetDotNetFrameworkVersion.Version461 - | Net462 -> Some TargetDotNetFrameworkVersion.Version462 - | Net47 -> Some TargetDotNetFrameworkVersion.Version47 - | Net471 -> Some TargetDotNetFrameworkVersion.Version471 - | Net472 -> Some TargetDotNetFrameworkVersion.Version472 - | Net48 -> Some TargetDotNetFrameworkVersion.Version48 - | _ -> - assert false - None - - match v with - | Some v -> - match ToolLocationHelper.GetPathToDotNetFramework v with - | null -> [] - | x -> [ x ] - | _ -> [] - - let GetPathToDotNetFrameworkReferenceAssemblies version = -#if NETSTANDARD - ignore version - let r: string list = [] - r -#else - match Microsoft.Build.Utilities.ToolLocationHelper.GetPathToStandardLibraries(".NETFramework", version, "") with - | null - | "" -> [] - | x -> [ x ] -#endif - - { new ILegacyReferenceResolver with - member x.HighestInstalledNetFrameworkVersion() = - - let root = x.DotNetFrameworkReferenceAssembliesRootDirectory - - let fwOpt = - SupportedDesktopFrameworkVersions - |> Seq.tryFind (fun fw -> FileSystem.DirectoryExistsShim(Path.Combine(root, fw))) - - match fwOpt with - | Some fw -> fw - | None -> "v4.5" - - member _.DotNetFrameworkReferenceAssembliesRootDirectory = - if Environment.OSVersion.Platform = PlatformID.Win32NT then - let PF = - match Environment.GetEnvironmentVariable("ProgramFiles(x86)") with - | null -> Environment.GetEnvironmentVariable("ProgramFiles") // if PFx86 is null, then we are 32-bit and just get PF - | s -> s - - PF + @"\Reference Assemblies\Microsoft\Framework\.NETFramework" + open System + open System.IO + open System.Reflection + open Internal.Utilities.Library + open FSharp.Compiler.IO + + // ATTENTION!: the following code needs to be updated every time we are switching to the new MSBuild version because new .NET framework version was released + // 1. List of frameworks + // 2. DeriveTargetFrameworkDirectoriesFor45Plus + // 3. HighestInstalledRefAssembliesOrDotNETFramework + // 4. GetPathToDotNetFrameworkImlpementationAssemblies + [] + let private Net45 = "v4.5" + + [] + let private Net451 = "v4.5.1" + + [] + let private Net452 = "v4.5.2" // not available in Dev15 MSBuild version + + [] + let private Net46 = "v4.6" + + [] + let private Net461 = "v4.6.1" + + [] + let private Net462 = "v4.6.2" + + [] + let private Net47 = "v4.7" + + [] + let private Net471 = "v4.7.1" + + [] + let private Net472 = "v4.7.2" + + [] + let private Net48 = "v4.8" + + let SupportedDesktopFrameworkVersions = + [ Net48; Net472; Net471; Net47; Net462; Net461; Net46; Net452; Net451; Net45 ] + + let private SimulatedMSBuildResolver = + + /// Get the path to the .NET Framework implementation assemblies by using ToolLocationHelper.GetPathToDotNetFramework + /// This is only used to specify the "last resort" path for assembly resolution. + let GetPathToDotNetFrameworkImlpementationAssemblies _ = + let isDesktop = typeof.Assembly.GetName().Name = "mscorlib" + if isDesktop then + match System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() with + | null -> [] + | x -> [ x ] else - "" - - member _.Resolve - ( - resolutionEnvironment, - references, - targetFrameworkVersion, - targetFrameworkDirectories, - targetProcessorArchitecture, - fsharpCoreDir, - explicitIncludeDirs, - implicitIncludeDir, - logMessage, - logWarningOrError - ) = - - - let results = ResizeArray() - - let searchPaths = - [ - yield! targetFrameworkDirectories - yield! explicitIncludeDirs - yield fsharpCoreDir - yield implicitIncludeDir - yield! GetPathToDotNetFrameworkReferenceAssemblies targetFrameworkVersion - yield! GetPathToDotNetFrameworkImlpementationAssemblies targetFrameworkVersion - ] - - for r, baggage in references do - //printfn "resolving %s" r - let mutable found = false - - let success path = - if not found then - //printfn "resolved %s --> %s" r path - found <- true - - results.Add - { - itemSpec = path - prepareToolTip = snd - baggage = baggage - } - - try - if not found && FileSystem.IsPathRootedShim r then - if FileSystem.FileExistsShim r then success r - with e -> - logWarningOrError false "SR001" (e.ToString()) - - // For this one we need to get the version search exactly right, without doing a load - try - if not found - && r.StartsWithOrdinal("FSharp.Core, Version=") - && Environment.OSVersion.Platform = PlatformID.Win32NT then - let n = AssemblyName r - - let fscoreDir0 = - let PF = - match Environment.GetEnvironmentVariable("ProgramFiles(x86)") with - | null -> Environment.GetEnvironmentVariable("ProgramFiles") - | s -> s - - PF - + @"\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\" - + n.Version.ToString() - - let trialPath = Path.Combine(fscoreDir0, n.Name + ".dll") - - if FileSystem.FileExistsShim trialPath then - success trialPath - with e -> - logWarningOrError false "SR001" (e.ToString()) - - let isFileName = - r.EndsWith("dll", StringComparison.OrdinalIgnoreCase) - || r.EndsWith("exe", StringComparison.OrdinalIgnoreCase) - - let qual = - if isFileName then - r - else - try - AssemblyName(r).Name + ".dll" - with _ -> - r + ".dll" + [] + + let GetPathToDotNetFrameworkReferenceAssemblies version = + ignore version + let r: string list = [] + r + + { new ILegacyReferenceResolver with + member x.HighestInstalledNetFrameworkVersion() = + + let root = x.DotNetFrameworkReferenceAssembliesRootDirectory + + let fwOpt = + SupportedDesktopFrameworkVersions + |> Seq.tryFind (fun fw -> FileSystem.DirectoryExistsShim(Path.Combine(root, fw))) + + match fwOpt with + | Some fw -> fw + | None -> Net45 + + + member _.DotNetFrameworkReferenceAssembliesRootDirectory = + if Environment.OSVersion.Platform = PlatformID.Win32NT then + let PF = + match Environment.GetEnvironmentVariable("ProgramFiles(x86)") with + | null -> Environment.GetEnvironmentVariable("ProgramFiles") // if PFx86 is null, then we are 32-bit and just get PF + | s -> s + + PF + @"\Reference Assemblies\Microsoft\Framework\.NETFramework" + else + "" + + member _.Resolve + ( + resolutionEnvironment, + references, + targetFrameworkVersion, + targetFrameworkDirectories, + targetProcessorArchitecture, + fsharpCoreDir, + explicitIncludeDirs, + implicitIncludeDir, + logMessage, + logWarningOrError + ) = + + + let results = ResizeArray() + + let searchPaths = + [ + yield! targetFrameworkDirectories + yield! explicitIncludeDirs + yield fsharpCoreDir + yield implicitIncludeDir + yield! GetPathToDotNetFrameworkReferenceAssemblies targetFrameworkVersion + yield! GetPathToDotNetFrameworkImlpementationAssemblies targetFrameworkVersion + ] + + for r, baggage in references do + //printfn "resolving %s" r + let mutable found = false + + let success path = + if not found then + //printfn "resolved %s --> %s" r path + found <- true + + results.Add + { + itemSpec = path + prepareToolTip = snd + baggage = baggage + } - for searchPath in searchPaths do try - if not found then - let trialPath = Path.Combine(searchPath, qual) + if not found && FileSystem.IsPathRootedShim r then + if FileSystem.FileExistsShim r then success r + with e -> + logWarningOrError false "SR001" (e.ToString()) + + // For this one we need to get the version search exactly right, without doing a load + try + if not found + && r.StartsWithOrdinal("FSharp.Core, Version=") + && Environment.OSVersion.Platform = PlatformID.Win32NT then + let n = AssemblyName r + + let fscoreDir0 = + let PF = + match Environment.GetEnvironmentVariable("ProgramFiles(x86)") with + | null -> Environment.GetEnvironmentVariable("ProgramFiles") + | s -> s + + PF + + @"\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\" + + n.Version.ToString() + + let trialPath = Path.Combine(fscoreDir0, n.Name + ".dll") if FileSystem.FileExistsShim trialPath then success trialPath with e -> logWarningOrError false "SR001" (e.ToString()) - try - // Search the GAC on Windows - if not found - && not isFileName - && Environment.OSVersion.Platform = PlatformID.Win32NT then - let n = AssemblyName r - let netFx = System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() - - let gac = - Path.Combine(Path.GetDirectoryName(Path.GetDirectoryName(netFx.TrimEnd('\\'))), "assembly") - - match n.Version, n.GetPublicKeyToken() with - | null, _ - | _, null -> - let options = - [ - if FileSystem.DirectoryExistsShim gac then - for gacDir in FileSystem.EnumerateDirectoriesShim gac do - let assemblyDir = Path.Combine(gacDir, n.Name) - - if FileSystem.DirectoryExistsShim assemblyDir then - for tdir in FileSystem.EnumerateDirectoriesShim assemblyDir do - let trialPath = Path.Combine(tdir, qual) - if FileSystem.FileExistsShim trialPath then yield trialPath - ] - //printfn "sorting GAC paths: %A" options - options - |> List.sort // puts latest version last - |> List.tryLast - |> function - | None -> () - | Some p -> success p - - | v, tok -> - if FileSystem.DirectoryExistsShim gac then - for gacDir in Directory.EnumerateDirectories gac do - //printfn "searching GAC directory: %s" gacDir - let assemblyDir = Path.Combine(gacDir, n.Name) - - if FileSystem.DirectoryExistsShim assemblyDir then - //printfn "searching GAC directory: %s" assemblyDir - - let tokText = String.concat "" [| for b in tok -> sprintf "%02x" b |] - let verDir = Path.Combine(assemblyDir, "v4.0_" + v.ToString() + "__" + tokText) - //printfn "searching GAC directory: %s" verDir - - if FileSystem.DirectoryExistsShim verDir then - let trialPath = Path.Combine(verDir, qual) - //printfn "searching GAC: %s" trialPath - if FileSystem.FileExistsShim trialPath then - success trialPath - with e -> - logWarningOrError false "SR001" (e.ToString()) - - results.ToArray() - } - |> LegacyReferenceResolver - -let internal getResolver () = SimulatedMSBuildResolver - -#if INTERACTIVE -// Some manual testing -SimulatedMSBuildResolver.DotNetFrameworkReferenceAssembliesRootDirectory -SimulatedMSBuildResolver.HighestInstalledNetFrameworkVersion() - -let fscoreDir = - if System.Environment.OSVersion.Platform = System.PlatformID.Win32NT then // file references only valid on Windows - let PF = - match Environment.GetEnvironmentVariable("ProgramFiles(x86)") with - | null -> Environment.GetEnvironmentVariable("ProgramFiles") // if PFx86 is null, then we are 32-bit and just get PF - | s -> s - - PF + @"\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\4.4.0.0" - else - System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() - -let resolve s = - SimulatedMSBuildResolver.Resolve( - ResolutionEnvironment.EditingOrCompilation, - [| for a in s -> (a, "") |], - "v4.5.1", + let isFileName = + r.EndsWith("dll", StringComparison.OrdinalIgnoreCase) + || r.EndsWith("exe", StringComparison.OrdinalIgnoreCase) + + let qual = + if isFileName then + r + else + try + AssemblyName(r).Name + ".dll" + with _ -> + r + ".dll" + + for searchPath in searchPaths do + try + if not found then + let trialPath = Path.Combine(searchPath, qual) + + if FileSystem.FileExistsShim trialPath then + success trialPath + with e -> + logWarningOrError false "SR001" (e.ToString()) + + try + // Search the GAC on Windows + if not found + && not isFileName + && Environment.OSVersion.Platform = PlatformID.Win32NT then + let n = AssemblyName r + let netFx = System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() + + let gac = + Path.Combine(Path.GetDirectoryName(Path.GetDirectoryName(netFx.TrimEnd('\\'))), "assembly") + + match n.Version, n.GetPublicKeyToken() with + | null, _ + | _, null -> + let options = + [ + if FileSystem.DirectoryExistsShim gac then + for gacDir in FileSystem.EnumerateDirectoriesShim gac do + let assemblyDir = Path.Combine(gacDir, n.Name) + + if FileSystem.DirectoryExistsShim assemblyDir then + for tdir in FileSystem.EnumerateDirectoriesShim assemblyDir do + let trialPath = Path.Combine(tdir, qual) + if FileSystem.FileExistsShim trialPath then yield trialPath + ] + //printfn "sorting GAC paths: %A" options + options + |> List.sort // puts latest version last + |> List.tryLast + |> function + | None -> () + | Some p -> success p + + | v, tok -> + if FileSystem.DirectoryExistsShim gac then + for gacDir in Directory.EnumerateDirectories gac do + //printfn "searching GAC directory: %s" gacDir + let assemblyDir = Path.Combine(gacDir, n.Name) + + if FileSystem.DirectoryExistsShim assemblyDir then + //printfn "searching GAC directory: %s" assemblyDir + + let tokText = String.concat "" [| for b in tok -> sprintf "%02x" b |] + let verDir = Path.Combine(assemblyDir, "v4.0_" + v.ToString() + "__" + tokText) + //printfn "searching GAC directory: %s" verDir + + if FileSystem.DirectoryExistsShim verDir then + let trialPath = Path.Combine(verDir, qual) + //printfn "searching GAC: %s" trialPath + if FileSystem.FileExistsShim trialPath then + success trialPath + with e -> + logWarningOrError false "SR001" (e.ToString()) + + results.ToArray() + } + |> LegacyReferenceResolver + + let internal getResolver () = SimulatedMSBuildResolver + + #if INTERACTIVE + // Some manual testing + SimulatedMSBuildResolver.DotNetFrameworkReferenceAssembliesRootDirectory + SimulatedMSBuildResolver.HighestInstalledNetFrameworkVersion() + + let fscoreDir = + if System.Environment.OSVersion.Platform = System.PlatformID.Win32NT then // file references only valid on Windows + let PF = + match Environment.GetEnvironmentVariable("ProgramFiles(x86)") with + | null -> Environment.GetEnvironmentVariable("ProgramFiles") // if PFx86 is null, then we are 32-bit and just get PF + | s -> s + + PF + @"\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\4.4.0.0" + else + System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() + + let resolve s = + SimulatedMSBuildResolver.Resolve( + ResolutionEnvironment.EditingOrCompilation, + [| for a in s -> (a, "") |], + "v4.5.1", + [ + SimulatedMSBuildResolver.DotNetFrameworkReferenceAssembliesRootDirectory + + @"\v4.5.1" + ], + "", + "", + fscoreDir, + [], + __SOURCE_DIRECTORY__, + ignore, + (fun _ _ -> ()), + (fun _ _ -> ()) + ) + + // Resolve partial name to something on search path + resolve [ "FSharp.Core" ] + + // Resolve DLL name to something on search path + resolve [ "FSharp.Core.dll" ] + + // Resolve from reference assemblies + resolve [ "System"; "mscorlib"; "mscorlib.dll" ] + + // Resolve from Registry AssemblyFolders + resolve [ "Microsoft.SqlServer.Dmf.dll"; "Microsoft.SqlServer.Dmf" ] + + // Resolve exact version of FSharp.Core + resolve + [ + "FSharp.Core, Version=4.4.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" + ] + + // Resolve from GAC: + resolve + [ + "EventViewer, Version=6.3.0.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35" + ] + + // Resolve from GAC: + resolve [ "EventViewer" ] + + resolve + [ + "Microsoft.SharePoint.Client, Version=15.0.0.0, Culture=neutral, PublicKeyToken=71e9bce111e9429c" + ] + + resolve [ - SimulatedMSBuildResolver.DotNetFrameworkReferenceAssembliesRootDirectory - + @"\v4.5.1" - ], - "", - "", - fscoreDir, - [], - __SOURCE_DIRECTORY__, - ignore, - (fun _ _ -> ()), - (fun _ _ -> ()) - ) - -// Resolve partial name to something on search path -resolve [ "FSharp.Core" ] - -// Resolve DLL name to something on search path -resolve [ "FSharp.Core.dll" ] - -// Resolve from reference assemblies -resolve [ "System"; "mscorlib"; "mscorlib.dll" ] - -// Resolve from Registry AssemblyFolders -resolve [ "Microsoft.SqlServer.Dmf.dll"; "Microsoft.SqlServer.Dmf" ] - -// Resolve exact version of FSharp.Core -resolve - [ - "FSharp.Core, Version=4.4.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" - ] - -// Resolve from GAC: -resolve - [ - "EventViewer, Version=6.3.0.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35" - ] - -// Resolve from GAC: -resolve [ "EventViewer" ] - -resolve - [ - "Microsoft.SharePoint.Client, Version=15.0.0.0, Culture=neutral, PublicKeyToken=71e9bce111e9429c" - ] - -resolve - [ - "Microsoft.SharePoint.Client, Version=16.0.0.0, Culture=neutral, PublicKeyToken=71e9bce111e9429c" - ] -#endif + "Microsoft.SharePoint.Client, Version=16.0.0.0, Culture=neutral, PublicKeyToken=71e9bce111e9429c" + ] + #endif diff --git a/src/Compiler/Legacy/LegacyMSBuildReferenceResolver.fs b/src/Compiler/Legacy/LegacyMSBuildReferenceResolver.fs deleted file mode 100644 index 516695e7e18..00000000000 --- a/src/Compiler/Legacy/LegacyMSBuildReferenceResolver.fs +++ /dev/null @@ -1,366 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -module FSharp.Compiler.CodeAnalysis.LegacyMSBuildReferenceResolver - - open System - open System.IO - open System.Reflection - open Internal.Utilities.Library - open Microsoft.Build.Tasks - open Microsoft.Build.Utilities - open Microsoft.Build.Framework - open FSharp.Compiler.IO - - // Reflection wrapper for properties - type Object with - member this.GetPropertyValue(propName) = - this.GetType().GetProperty(propName, BindingFlags.Public).GetValue(this, null) - - /// Get the Reference Assemblies directory for the .NET Framework on Window. - let DotNetFrameworkReferenceAssembliesRootDirectory = - // ProgramFilesX86 is correct for both x86 and x64 architectures - // (the reference assemblies are always in the 32-bit location, which is PF(x86) on an x64 machine) - let PF = - match Environment.GetEnvironmentVariable("ProgramFiles(x86)") with - | Null -> Environment.GetEnvironmentVariable("ProgramFiles") // if PFx86 is null, then we are 32-bit and just get PF - | NonNull s -> s - PF + @"\Reference Assemblies\Microsoft\Framework\.NETFramework" - - /// When targeting .NET 2.0-3.5 on Windows, we expand the {WindowsFramework} and {ReferenceAssemblies} paths manually - let internal ReplaceVariablesForLegacyFxOnWindows(dirs: string list) = - let windowsFramework = Environment.GetEnvironmentVariable("windir")+ @"\Microsoft.NET\Framework" - let referenceAssemblies = DotNetFrameworkReferenceAssembliesRootDirectory - dirs |> List.map(fun d -> d.Replace("{WindowsFramework}",windowsFramework).Replace("{ReferenceAssemblies}",referenceAssemblies)) - - // ATTENTION!: the following code needs to be updated every time we are switching to the new MSBuild version because new .NET framework version was released - // 1. List of frameworks - // 2. DeriveTargetFrameworkDirectoriesFor45Plus - // 3. HighestInstalledRefAssembliesOrDotNETFramework - // 4. GetPathToDotNetFrameworkImlpementationAssemblies - [] - let private Net45 = "v4.5" - - [] - let private Net451 = "v4.5.1" - - [] - let private Net452 = "v4.5.2" // not available in Dev15 MSBuild version - - [] - let private Net46 = "v4.6" - - [] - let private Net461 = "v4.6.1" - - [] - let private Net462 = "v4.6.2" - - [] - let private Net47 = "v4.7" - - [] - let private Net471 = "v4.7.1" - - [] - let private Net472 = "v4.7.2" - - [] - let private Net48 = "v4.8" - - let SupportedDesktopFrameworkVersions = [ Net48; Net472; Net471; Net47; Net462; Net461; Net46; Net452; Net451; Net45 ] - - /// Get the path to the .NET Framework implementation assemblies by using ToolLocationHelper.GetPathToDotNetFramework - /// This is only used to specify the "last resort" path for assembly resolution. - let GetPathToDotNetFrameworkImlpementationAssemblies v : string list = - let v = - match v with - | Net45 -> Some TargetDotNetFrameworkVersion.Version45 - | Net451 -> Some TargetDotNetFrameworkVersion.Version451 - | Net452 -> Some TargetDotNetFrameworkVersion.Version452 - | Net46 -> Some TargetDotNetFrameworkVersion.Version46 - | Net461 -> Some TargetDotNetFrameworkVersion.Version461 - | Net462 -> Some TargetDotNetFrameworkVersion.Version462 - | Net47 -> Some TargetDotNetFrameworkVersion.Version47 - | Net471 -> Some TargetDotNetFrameworkVersion.Version471 - | Net472 -> Some TargetDotNetFrameworkVersion.Version472 - | Net48 -> Some TargetDotNetFrameworkVersion.Version48 - | _ -> assert false; None - match v with - | Some v -> - match ToolLocationHelper.GetPathToDotNetFramework v with - | Null -> [] - | NonNull x -> [x] - | _ -> [] - - let GetPathToDotNetFrameworkReferenceAssemblies version = -#if NETSTANDARD - ignore version - let r : string list = [] - r -#else - match Microsoft.Build.Utilities.ToolLocationHelper.GetPathToStandardLibraries(".NETFramework",version,"") with - | Null | "" -> [] - | NonNull x -> [x] -#endif - - /// Use MSBuild to determine the version of the highest installed set of reference assemblies, failing that grab the highest installed framework version - let HighestInstalledRefAssembliesOrDotNETFramework () = - let getHighestInstalledDotNETFramework () = - try - if box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version48)) <> null then Net48 - elif box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version472)) <> null then Net472 - elif box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version471)) <> null then Net471 - elif box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version47)) <> null then Net47 - elif box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version462)) <> null then Net462 - elif box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version461)) <> null then Net461 - elif box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version461)) <> null then Net461 - elif box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version46)) <> null then Net46 - elif box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version452)) <> null then Net452 - elif box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version451)) <> null then Net451 - elif box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version45)) <> null then Net45 - else Net45 // version is 4.5 assumed since this code is running. - with _ -> Net45 - - // 1. First look to see if we can find the highest installed set of dotnet reference assemblies, if yes then select that framework - // 2. Otherwise ask msbuild for the highestinstalled framework - let checkFrameworkForReferenceAssemblies (dotNetVersion:string) = - if not (String.IsNullOrEmpty(dotNetVersion)) then - try - let v = if dotNetVersion.StartsWith("v") then dotNetVersion.Substring(1) else dotNetVersion - let frameworkName = System.Runtime.Versioning.FrameworkName(".NETFramework", Version(v)) - match ToolLocationHelper.GetPathToReferenceAssemblies(frameworkName) |> Seq.tryHead with - | Some p -> FileSystem.DirectoryExistsShim(p) - | None -> false - with _ -> false - else false - match SupportedDesktopFrameworkVersions |> Seq.tryFind(fun v -> checkFrameworkForReferenceAssemblies v) with - | Some v -> v - | None -> getHighestInstalledDotNETFramework() - - /// Derive the target framework directories. - let DeriveTargetFrameworkDirectories (targetFrameworkVersion:string, logMessage) = - - let targetFrameworkVersion = - if not(targetFrameworkVersion.StartsWith("v",StringComparison.Ordinal)) then "v"+targetFrameworkVersion - else targetFrameworkVersion - - let result = GetPathToDotNetFrameworkReferenceAssemblies(targetFrameworkVersion) |> Array.ofList - logMessage (sprintf "Derived target framework directories for version %s are: %s" targetFrameworkVersion (String.Join(",", result))) - result - - /// Describes the location where the reference was found, used only for debug and tooltip output - type ResolvedFrom = - | AssemblyFolders - | AssemblyFoldersEx - | TargetFrameworkDirectory - | RawFileName - | GlobalAssemblyCache - | Path of string - | Unknown - - /// Decode the ResolvedFrom code from MSBuild. - let DecodeResolvedFrom(resolvedFrom:string) : ResolvedFrom = - match resolvedFrom with - | "{RawFileName}" -> RawFileName - | "{GAC}" -> GlobalAssemblyCache - | "{TargetFrameworkDirectory}" -> TargetFrameworkDirectory - | "{AssemblyFolders}" -> AssemblyFolders - | r when r.Length >= 10 && "{Registry:" = r.Substring(0,10) -> AssemblyFoldersEx - | r -> ResolvedFrom.Path r - - let TooltipForResolvedFrom(resolvedFrom, fusionName, redist) = - fun (originalReference,resolvedPath) -> - let originalReferenceName = originalReference - - let resolvedPath = // Don't show the resolved path if it is identical to what was referenced. - if originalReferenceName = resolvedPath then String.Empty - else resolvedPath - - let lineIfExists text = - if String.IsNullOrEmpty text then "" - else text.Trim(' ')+"\n" - - match resolvedFrom with - | AssemblyFolders -> - lineIfExists resolvedPath - + lineIfExists fusionName - + FSComp.SR.assemblyResolutionFoundByAssemblyFoldersKey() - | AssemblyFoldersEx -> - lineIfExists resolvedPath - + lineIfExists fusionName - + FSComp.SR.assemblyResolutionFoundByAssemblyFoldersExKey() - | TargetFrameworkDirectory -> - lineIfExists resolvedPath - + lineIfExists fusionName - + FSComp.SR.assemblyResolutionNetFramework() - | Unknown -> - // Unknown when resolved by plain directory search without help from MSBuild resolver. - lineIfExists resolvedPath - + lineIfExists fusionName - | RawFileName -> - lineIfExists fusionName - | GlobalAssemblyCache -> - lineIfExists fusionName - + lineIfExists (FSComp.SR.assemblyResolutionGAC()) - + lineIfExists redist - | Path _ -> - lineIfExists resolvedPath - + lineIfExists fusionName - - /// Perform assembly resolution by instantiating the ResolveAssembly task directly from the MSBuild SDK. - let ResolveCore(resolutionEnvironment: LegacyResolutionEnvironment, - references:(string*string)[], - targetFrameworkVersion: string, - targetFrameworkDirectories: string list, - targetProcessorArchitecture: string, - fsharpCoreDir: string, - explicitIncludeDirs: string list, - implicitIncludeDir: string, - allowRawFileName: bool, - logMessage: string -> unit, - logDiagnostic: bool -> string -> string -> unit) = - - let frameworkRegistryBase, assemblyFoldersSuffix, assemblyFoldersConditions = - "Software\Microsoft\.NetFramework", "AssemblyFoldersEx" , "" - if Array.isEmpty references then [| |] else - - let mutable backgroundException = false - - let protect f = - if not backgroundException then - try f() - with _ -> backgroundException <- true - - let engine = - { new IBuildEngine with - member _.BuildProjectFile(projectFileName, targetNames, globalProperties, targetOutputs) = true - member _.LogCustomEvent(e) = protect (fun () -> logMessage e.Message) - member _.LogErrorEvent(e) = protect (fun () -> logDiagnostic true e.Code e.Message) - member _.LogMessageEvent(e) = protect (fun () -> logMessage e.Message) - member _.LogWarningEvent(e) = protect (fun () -> logDiagnostic false e.Code e.Message) - member _.ColumnNumberOfTaskNode with get() = 1 - member _.LineNumberOfTaskNode with get() = 1 - member _.ContinueOnError with get() = true - member _.ProjectFileOfTaskNode with get() = "" } - - // Derive the target framework directory if none was supplied. - let targetFrameworkDirectories = - if targetFrameworkDirectories=[] then DeriveTargetFrameworkDirectories(targetFrameworkVersion, logMessage) - else targetFrameworkDirectories |> Array.ofList - - - // Filter for null and zero length - let references = references |> Array.filter(fst >> String.IsNullOrEmpty >> not) - - // Determine the set of search paths for the resolution - let searchPaths = - - let explicitIncludeDirs = explicitIncludeDirs |> List.filter(String.IsNullOrEmpty >> not) - - let registry = sprintf "{Registry:%s,%s,%s%s}" frameworkRegistryBase targetFrameworkVersion assemblyFoldersSuffix assemblyFoldersConditions - - [| // When compiling scripts using fsc.exe, for some reason we have always historically put TargetFrameworkDirectory first - // It is unclear why. This is the only place we look at the 'isdifference between ResolutionEnvironment.EditingOrCompilation and ResolutionEnvironment.EditingTime. - match resolutionEnvironment with - | LegacyResolutionEnvironment.EditingOrCompilation false -> yield "{TargetFrameworkDirectory}" - | LegacyResolutionEnvironment.EditingOrCompilation true - | LegacyResolutionEnvironment.CompilationAndEvaluation -> () - - // Quick-resolve straight to file name first - if allowRawFileName then - yield "{RawFileName}" - yield! explicitIncludeDirs // From -I, #I - yield fsharpCoreDir // Location of explicit reference to FSharp.Core, otherwise location of fsc.exe - yield implicitIncludeDir // Usually the project directory - - match resolutionEnvironment with - | LegacyResolutionEnvironment.EditingOrCompilation true - | LegacyResolutionEnvironment.CompilationAndEvaluation -> yield "{TargetFrameworkDirectory}" - | LegacyResolutionEnvironment.EditingOrCompilation false -> () - - yield registry - yield "{AssemblyFolders}" - yield "{GAC}" - // use path to implementation assemblies as the last resort - yield! GetPathToDotNetFrameworkImlpementationAssemblies targetFrameworkVersion - |] - - let assemblies = - [| for referenceName,baggage in references -> - let item = TaskItem(referenceName) :> ITaskItem - item.SetMetadata("Baggage", baggage) - item |] - let rar = - ResolveAssemblyReference(BuildEngine=engine, TargetFrameworkDirectories=targetFrameworkDirectories, - FindRelatedFiles=false, FindDependencies=false, FindSatellites=false, - FindSerializationAssemblies=false, Assemblies=assemblies, - SearchPaths=searchPaths, - AllowedAssemblyExtensions= [| ".dll" ; ".exe" |]) - rar.TargetProcessorArchitecture <- targetProcessorArchitecture - let targetedRuntimeVersionValue = typeof.Assembly.ImageRuntimeVersion - rar.TargetedRuntimeVersion <- targetedRuntimeVersionValue - rar.CopyLocalDependenciesWhenParentReferenceInGac <- true - - let succeeded = rar.Execute() - - if not succeeded then - raise LegacyResolutionFailure - - let resolvedFiles = - [| for p in rar.ResolvedFiles -> - let resolvedFrom = DecodeResolvedFrom(p.GetMetadata("ResolvedFrom")) - let fusionName = p.GetMetadata("FusionName") - let redist = p.GetMetadata("Redist") - { itemSpec = p.ItemSpec - prepareToolTip = TooltipForResolvedFrom(resolvedFrom, fusionName, redist) - baggage = p.GetMetadata("Baggage") } |] - - resolvedFiles - - let getResolver () = - { new ILegacyReferenceResolver with - member _.HighestInstalledNetFrameworkVersion() = HighestInstalledRefAssembliesOrDotNETFramework() - member _.DotNetFrameworkReferenceAssembliesRootDirectory = DotNetFrameworkReferenceAssembliesRootDirectory - - /// Perform the resolution on rooted and unrooted paths, and then combine the results. - member _.Resolve(resolutionEnvironment, references, targetFrameworkVersion, targetFrameworkDirectories, targetProcessorArchitecture, - fsharpCoreDir, explicitIncludeDirs, implicitIncludeDir, logMessage, logDiagnostic) = - - // The {RawFileName} target is 'dangerous', in the sense that is uses Directory.GetCurrentDirectory() to resolve unrooted file paths. - // It is unreliable to use this mutable global state inside Visual Studio. As a result, we partition all references into a "rooted" set - // (which contains e.g. C:\MyDir\MyAssem.dll) and "unrooted" (everything else). We only allow "rooted" to use {RawFileName}. Note that - // unrooted may still find 'local' assemblies by virtue of the fact that "implicitIncludeDir" is one of the places searched during - // assembly resolution. - let references = - [| for fileName, baggage as data in references -> - // However, MSBuild will not resolve 'relative' paths, even when e.g. implicitIncludeDir is part of the search. As a result, - // if we have an unrooted path + file name, we'll assume this is relative to the project directory and root it. - if FileSystem.IsPathRootedShim(fileName) then - data // fine, e.g. "C:\Dir\foo.dll" - elif not(fileName.Contains("\\") || fileName.Contains("/")) then - data // fine, e.g. "System.Transactions.dll" - else - // We have a 'relative path', e.g. "bin/Debug/foo.exe" or "..\Yadda\bar.dll" - // turn it into an absolute path based at implicitIncludeDir - (Path.Combine(implicitIncludeDir, fileName), baggage) |] - - let rooted, unrooted = references |> Array.partition (fst >> FileSystem.IsPathRootedShim) - - let rootedResults = - ResolveCore - (resolutionEnvironment, rooted, targetFrameworkVersion, - targetFrameworkDirectories, targetProcessorArchitecture, - fsharpCoreDir, explicitIncludeDirs, implicitIncludeDir, - true, logMessage, logDiagnostic) - - let unrootedResults = - ResolveCore - (resolutionEnvironment, unrooted, targetFrameworkVersion, - targetFrameworkDirectories, targetProcessorArchitecture, - fsharpCoreDir, explicitIncludeDirs, implicitIncludeDir, - false, logMessage, logDiagnostic) - - // now unify the two sets of results - Array.concat [| rootedResults; unrootedResults |] - } - |> LegacyReferenceResolver diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 2afccb1fd40..9f1b557acbe 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -5662,26 +5662,6 @@ generovaný typ - - Found by AssemblyFolders registry key - Nalezené klíčem registru AssemblyFolders - - - - Found by AssemblyFoldersEx registry key - Nalezené klíčem registru AssemblyFoldersEx - - - - .NET Framework - .NET Framework - - - - Global Assembly Cache - Globální mezipaměť sestavení - - Recursive class hierarchy in type '{0}' Rekurzivní hierarchie tříd u typu {0} diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index b0eec3044bc..fad70824e36 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -5662,26 +5662,6 @@ Generierter Typ - - Found by AssemblyFolders registry key - Von AssemblyFolders-Registrierungsschlüssel gefunden - - - - Found by AssemblyFoldersEx registry key - Von AssemblyFoldersEx-Registrierungsschlüssel gefunden - - - - .NET Framework - .NET Framework - - - - Global Assembly Cache - Globaler Assemblycache - - Recursive class hierarchy in type '{0}' Rekursive Klassenhierarchie in Typ "{0}". diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 89d57eacb65..5402a968afd 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -5662,26 +5662,6 @@ tipo generado - - Found by AssemblyFolders registry key - Encontrado por la clave del Registro AssemblyFolders. - - - - Found by AssemblyFoldersEx registry key - Encontrado por la clave del Registro AssemblyFoldersEx. - - - - .NET Framework - .NET Framework - - - - Global Assembly Cache - Caché global de ensamblados - - Recursive class hierarchy in type '{0}' Jerarquía de clases recursiva en el tipo '{0}'. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 2db2d58f88f..aadf83ade0e 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -5662,26 +5662,6 @@ type généré - - Found by AssemblyFolders registry key - Trouvée par la clé de Registre AssemblyFolders - - - - Found by AssemblyFoldersEx registry key - Trouvée par la clé de Registre AssemblyFoldersEx - - - - .NET Framework - .NET Framework - - - - Global Assembly Cache - Global Assembly Cache - - Recursive class hierarchy in type '{0}' Hiérarchie de classes récursive dans le type '{0}' diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 66011450a6b..8b681eb4a16 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -5662,26 +5662,6 @@ tipo generato - - Found by AssemblyFolders registry key - Trovata mediante la chiave del Registro di sistema AssemblyFolders - - - - Found by AssemblyFoldersEx registry key - Trovata mediante chiave del Registro di sistema AssemblyFoldersEx - - - - .NET Framework - .NET Framework - - - - Global Assembly Cache - Global Assembly Cache - - Recursive class hierarchy in type '{0}' Gerarchia di classi ricorsiva nel tipo '{0}' diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 0ba2173b8fc..4b6c944481a 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -5662,26 +5662,6 @@ 生成された型 - - Found by AssemblyFolders registry key - AssemblyFolders レジストリ キーによって検出されました - - - - Found by AssemblyFoldersEx registry key - AssemblyFoldersEx レジストリ キーによって検出されました - - - - .NET Framework - .NET Framework - - - - Global Assembly Cache - グローバル アセンブリ キャッシュ - - Recursive class hierarchy in type '{0}' 型 '{0}' の再帰的クラス階層 diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index e97d0cf2eb2..40973f9e1a9 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -5662,26 +5662,6 @@ 생성된 형식 - - Found by AssemblyFolders registry key - AssemblyFolders 레지스트리 키로 찾았습니다. - - - - Found by AssemblyFoldersEx registry key - AssemblyFoldersEx 레지스트리 키로 찾았습니다. - - - - .NET Framework - .NET Framework - - - - Global Assembly Cache - 전역 어셈블리 캐시 - - Recursive class hierarchy in type '{0}' '{0}' 형식에 재귀적 클래스 계층 구조가 있습니다. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index d39b72ca26f..9b4b9dab2eb 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -5662,26 +5662,6 @@ wygenerowany typ - - Found by AssemblyFolders registry key - Znalezione przez klucz rejestru AssemblyFolders - - - - Found by AssemblyFoldersEx registry key - Znalezione przez klucz rejestru AssemblyFoldersEx - - - - .NET Framework - .NET Framework - - - - Global Assembly Cache - Globalna pamięć podręczna zestawów - - Recursive class hierarchy in type '{0}' Cykliczna hierarchia klas w typie „{0}” diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 09d70721f8a..3307d01761c 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -5662,26 +5662,6 @@ tipo gerado - - Found by AssemblyFolders registry key - Localizada pela chave de registro AssemblyFolders - - - - Found by AssemblyFoldersEx registry key - Localizada pela chave de registro AssemblyFoldersEx - - - - .NET Framework - .NET Framework - - - - Global Assembly Cache - Cache de Assembly Global - - Recursive class hierarchy in type '{0}' Hierarquia de classe recursiva no tipo '{0}' diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 01249439e53..d9de5f772a1 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -5662,26 +5662,6 @@ созданный тип - - Found by AssemblyFolders registry key - Найдено по разделу реестра AssemblyFolders - - - - Found by AssemblyFoldersEx registry key - Найдено по разделу реестра AssemblyFoldersEx - - - - .NET Framework - .NET Framework - - - - Global Assembly Cache - Глобальный кэш сборок - - Recursive class hierarchy in type '{0}' Рекурсивная иерархия классов в типе "{0}" diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 113d6a42396..3cd9f827dc1 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -5662,26 +5662,6 @@ oluşturulan tür - - Found by AssemblyFolders registry key - AssemblyFolders kayıt defteri anahtarı ile bulunur - - - - Found by AssemblyFoldersEx registry key - AssemblyFoldersEx kayıt defteri anahtarı ile bulunur - - - - .NET Framework - .NET Framework - - - - Global Assembly Cache - Genel Bütünleştirilmiş Kod Önbelleği - - Recursive class hierarchy in type '{0}' '{0}' türünde özyinelemeli sınıf hiyerarşisi diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index b6a766f9cd5..d733d0c1038 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -5662,26 +5662,6 @@ 生成的类型 - - Found by AssemblyFolders registry key - 已由 AssemblyFolders 注册表项找到 - - - - Found by AssemblyFoldersEx registry key - 已由 AssemblyFoldersEx 注册表项找到 - - - - .NET Framework - .NET Framework - - - - Global Assembly Cache - 全局程序集缓存 - - Recursive class hierarchy in type '{0}' 类型“{0}”中的递归类层次结构 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index f404d766e1c..1d7aec7be9d 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -5662,26 +5662,6 @@ 產生的類型 - - Found by AssemblyFolders registry key - 依 AssemblyFolders 登錄機碼找到 - - - - Found by AssemblyFoldersEx registry key - 依 AssemblyFoldersEx 登錄機碼找到 - - - - .NET Framework - .NET Framework - - - - Global Assembly Cache - 全域組件快取 - - Recursive class hierarchy in type '{0}' 類型 '{0}' 中有遞迴的類別階層 diff --git a/src/LegacyMSBuildResolver/LegacyMSBuildReferenceResolver.fs b/src/LegacyMSBuildResolver/LegacyMSBuildReferenceResolver.fs new file mode 100644 index 00000000000..977372d675a --- /dev/null +++ b/src/LegacyMSBuildResolver/LegacyMSBuildReferenceResolver.fs @@ -0,0 +1,516 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module FSharp.Compiler.CodeAnalysis.LegacyMSBuildReferenceResolver + +open System +open System.IO +open System.Reflection +open Internal.Utilities.Library +open Microsoft.Build.Tasks +open Microsoft.Build.Utilities +open Microsoft.Build.Framework +open FSharp.Compiler.IO + +// Reflection wrapper for properties +type Object with + + member this.GetPropertyValue(propName) = + this.GetType().GetProperty(propName, BindingFlags.Public).GetValue(this, null) + +/// Match on the nullness of an argument. +let inline (|Null|NonNull|) (x: 'T) : Choice = + match x with + | null -> Null + | v -> NonNull v + +/// Get the Reference Assemblies directory for the .NET Framework on Window. +let DotNetFrameworkReferenceAssembliesRootDirectory = + // ProgramFilesX86 is correct for both x86 and x64 architectures + // (the reference assemblies are always in the 32-bit location, which is PF(x86) on an x64 machine) + let PF = + match Environment.GetEnvironmentVariable("ProgramFiles(x86)") with + | Null -> Environment.GetEnvironmentVariable("ProgramFiles") // if PFx86 is null, then we are 32-bit and just get PF + | NonNull s -> s + + PF + @"\Reference Assemblies\Microsoft\Framework\.NETFramework" + +/// When targeting .NET 2.0-3.5 on Windows, we expand the {WindowsFramework} and {ReferenceAssemblies} paths manually +let internal ReplaceVariablesForLegacyFxOnWindows (dirs: string list) = + let windowsFramework = + Environment.GetEnvironmentVariable("windir") + @"\Microsoft.NET\Framework" + + let referenceAssemblies = DotNetFrameworkReferenceAssembliesRootDirectory + + dirs + |> List.map (fun d -> + d + .Replace("{WindowsFramework}", windowsFramework) + .Replace("{ReferenceAssemblies}", referenceAssemblies)) + +// ATTENTION!: the following code needs to be updated every time we are switching to the new MSBuild version because new .NET framework version was released +// 1. List of frameworks +// 2. DeriveTargetFrameworkDirectoriesFor45Plus +// 3. HighestInstalledRefAssembliesOrDotNETFramework +// 4. GetPathToDotNetFrameworkImlpementationAssemblies +[] +let private Net45 = "v4.5" + +[] +let private Net451 = "v4.5.1" + +[] +let private Net452 = "v4.5.2" // not available in Dev15 MSBuild version + +[] +let private Net46 = "v4.6" + +[] +let private Net461 = "v4.6.1" + +[] +let private Net462 = "v4.6.2" + +[] +let private Net47 = "v4.7" + +[] +let private Net471 = "v4.7.1" + +[] +let private Net472 = "v4.7.2" + +[] +let private Net48 = "v4.8" + +let SupportedDesktopFrameworkVersions = + [ Net48; Net472; Net471; Net47; Net462; Net461; Net46; Net452; Net451; Net45 ] + +/// Get the path to the .NET Framework implementation assemblies by using ToolLocationHelper.GetPathToDotNetFramework +/// This is only used to specify the "last resort" path for assembly resolution. +let GetPathToDotNetFrameworkImlpementationAssemblies v : string list = + let v = + match v with + | Net45 -> Some TargetDotNetFrameworkVersion.Version45 + | Net451 -> Some TargetDotNetFrameworkVersion.Version451 + | Net452 -> Some TargetDotNetFrameworkVersion.Version452 + | Net46 -> Some TargetDotNetFrameworkVersion.Version46 + | Net461 -> Some TargetDotNetFrameworkVersion.Version461 + | Net462 -> Some TargetDotNetFrameworkVersion.Version462 + | Net47 -> Some TargetDotNetFrameworkVersion.Version47 + | Net471 -> Some TargetDotNetFrameworkVersion.Version471 + | Net472 -> Some TargetDotNetFrameworkVersion.Version472 + | Net48 -> Some TargetDotNetFrameworkVersion.Version48 + | _ -> + assert false + None + + match v with + | Some v -> + match ToolLocationHelper.GetPathToDotNetFramework v with + | Null -> [] + | NonNull x -> [ x ] + | _ -> [] + +let GetPathToDotNetFrameworkReferenceAssemblies version = +#if NETSTANDARD + ignore version + let r: string list = [] + r +#else + match Microsoft.Build.Utilities.ToolLocationHelper.GetPathToStandardLibraries(".NETFramework", version, "") with + | Null + | "" -> [] + | NonNull x -> [ x ] +#endif + +/// Use MSBuild to determine the version of the highest installed set of reference assemblies, failing that grab the highest installed framework version +let HighestInstalledRefAssembliesOrDotNETFramework () = + let getHighestInstalledDotNETFramework () = + try + if + box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version48)) + <> null + then + Net48 + elif + box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version472)) + <> null + then + Net472 + elif + box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version471)) + <> null + then + Net471 + elif + box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version47)) + <> null + then + Net47 + elif + box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version462)) + <> null + then + Net462 + elif + box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version461)) + <> null + then + Net461 + elif + box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version461)) + <> null + then + Net461 + elif + box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version46)) + <> null + then + Net46 + elif + box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version452)) + <> null + then + Net452 + elif + box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version451)) + <> null + then + Net451 + elif + box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version45)) + <> null + then + Net45 + else + Net45 // version is 4.5 assumed since this code is running. + with _ -> + Net45 + + // 1. First look to see if we can find the highest installed set of dotnet reference assemblies, if yes then select that framework + // 2. Otherwise ask msbuild for the highestinstalled framework + let checkFrameworkForReferenceAssemblies (dotNetVersion: string) = + if not (String.IsNullOrEmpty(dotNetVersion)) then + try + let v = + if dotNetVersion.StartsWith("v") then + dotNetVersion.Substring(1) + else + dotNetVersion + + let frameworkName = + System.Runtime.Versioning.FrameworkName(".NETFramework", Version(v)) + + match ToolLocationHelper.GetPathToReferenceAssemblies(frameworkName) |> Seq.tryHead with + | Some p -> FileSystem.DirectoryExistsShim(p) + | None -> false + with _ -> + false + else + false + + match + SupportedDesktopFrameworkVersions + |> Seq.tryFind (fun v -> checkFrameworkForReferenceAssemblies v) + with + | Some v -> v + | None -> getHighestInstalledDotNETFramework () + +/// Derive the target framework directories. +let DeriveTargetFrameworkDirectories (targetFrameworkVersion: string, logMessage) = + + let targetFrameworkVersion = + if not (targetFrameworkVersion.StartsWith("v", StringComparison.Ordinal)) then + "v" + targetFrameworkVersion + else + targetFrameworkVersion + + let result = + GetPathToDotNetFrameworkReferenceAssemblies(targetFrameworkVersion) + |> Array.ofList + + logMessage (sprintf "Derived target framework directories for version %s are: %s" targetFrameworkVersion (String.Join(",", result))) + result + +/// Describes the location where the reference was found, used only for debug and tooltip output +type ResolvedFrom = + | AssemblyFolders + | AssemblyFoldersEx + | TargetFrameworkDirectory + | RawFileName + | GlobalAssemblyCache + | Path of string + | Unknown + +/// Decode the ResolvedFrom code from MSBuild. +let DecodeResolvedFrom (resolvedFrom: string) : ResolvedFrom = + match resolvedFrom with + | "{RawFileName}" -> RawFileName + | "{GAC}" -> GlobalAssemblyCache + | "{TargetFrameworkDirectory}" -> TargetFrameworkDirectory + | "{AssemblyFolders}" -> AssemblyFolders + | r when r.Length >= 10 && "{Registry:" = r.Substring(0, 10) -> AssemblyFoldersEx + | r -> ResolvedFrom.Path r + +let TooltipForResolvedFrom (resolvedFrom, fusionName, redist) = + fun (originalReference, resolvedPath) -> + let originalReferenceName = originalReference + + let resolvedPath = // Don't show the resolved path if it is identical to what was referenced. + if originalReferenceName = resolvedPath then + String.Empty + else + resolvedPath + + let lineIfExists text = + if String.IsNullOrEmpty text then + "" + else + text.Trim(' ') + "\n" + + match resolvedFrom with + | AssemblyFolders -> + lineIfExists resolvedPath + + lineIfExists fusionName + + LegacyResolver.SR.assemblyResolutionFoundByAssemblyFoldersKey () + | AssemblyFoldersEx -> + lineIfExists resolvedPath + + lineIfExists fusionName + + LegacyResolver.SR.assemblyResolutionFoundByAssemblyFoldersExKey () + | TargetFrameworkDirectory -> + lineIfExists resolvedPath + + lineIfExists fusionName + + LegacyResolver.SR.assemblyResolutionNetFramework () + | Unknown -> + // Unknown when resolved by plain directory search without help from MSBuild resolver. + lineIfExists resolvedPath + lineIfExists fusionName + | RawFileName -> lineIfExists fusionName + | GlobalAssemblyCache -> + lineIfExists fusionName + + lineIfExists (LegacyResolver.SR.assemblyResolutionGAC ()) + + lineIfExists redist + | Path _ -> lineIfExists resolvedPath + lineIfExists fusionName + +/// Perform assembly resolution by instantiating the ResolveAssembly task directly from the MSBuild SDK. +let ResolveCore + ( + resolutionEnvironment: LegacyResolutionEnvironment, + references: (string * string)[], + targetFrameworkVersion: string, + targetFrameworkDirectories: string list, + targetProcessorArchitecture: string, + fsharpCoreDir: string, + explicitIncludeDirs: string list, + implicitIncludeDir: string, + allowRawFileName: bool, + logMessage: string -> unit, + logDiagnostic: bool -> string -> string -> unit + ) = + + let frameworkRegistryBase, assemblyFoldersSuffix, assemblyFoldersConditions = + "Software\Microsoft\.NetFramework", "AssemblyFoldersEx", "" + + if Array.isEmpty references then + [||] + else + + let mutable backgroundException = false + + let protect f = + if not backgroundException then + try + f () + with _ -> + backgroundException <- true + + let engine = + { new IBuildEngine with + member _.BuildProjectFile(projectFileName, targetNames, globalProperties, targetOutputs) = true + + member _.LogCustomEvent(e) = + protect (fun () -> logMessage e.Message) + + member _.LogErrorEvent(e) = + protect (fun () -> logDiagnostic true e.Code e.Message) + + member _.LogMessageEvent(e) = + protect (fun () -> logMessage e.Message) + + member _.LogWarningEvent(e) = + protect (fun () -> logDiagnostic false e.Code e.Message) + + member _.ColumnNumberOfTaskNode = 1 + member _.LineNumberOfTaskNode = 1 + member _.ContinueOnError = true + member _.ProjectFileOfTaskNode = "" + } + + // Derive the target framework directory if none was supplied. + let targetFrameworkDirectories = + if targetFrameworkDirectories = [] then + DeriveTargetFrameworkDirectories(targetFrameworkVersion, logMessage) + else + targetFrameworkDirectories |> Array.ofList + + // Filter for null and zero length + let references = references |> Array.filter (fst >> String.IsNullOrEmpty >> not) + + // Determine the set of search paths for the resolution + let searchPaths = + + let explicitIncludeDirs = + explicitIncludeDirs |> List.filter (String.IsNullOrEmpty >> not) + + let registry = + sprintf "{Registry:%s,%s,%s%s}" frameworkRegistryBase targetFrameworkVersion assemblyFoldersSuffix assemblyFoldersConditions + + [| // When compiling scripts using fsc.exe, for some reason we have always historically put TargetFrameworkDirectory first + // It is unclear why. This is the only place we look at the 'isdifference between ResolutionEnvironment.EditingOrCompilation and ResolutionEnvironment.EditingTime. + match resolutionEnvironment with + | LegacyResolutionEnvironment.EditingOrCompilation false -> yield "{TargetFrameworkDirectory}" + | LegacyResolutionEnvironment.EditingOrCompilation true + | LegacyResolutionEnvironment.CompilationAndEvaluation -> () + + // Quick-resolve straight to file name first + if allowRawFileName then + yield "{RawFileName}" + yield! explicitIncludeDirs // From -I, #I + yield fsharpCoreDir // Location of explicit reference to FSharp.Core, otherwise location of fsc.exe + yield implicitIncludeDir // Usually the project directory + + match resolutionEnvironment with + | LegacyResolutionEnvironment.EditingOrCompilation true + | LegacyResolutionEnvironment.CompilationAndEvaluation -> yield "{TargetFrameworkDirectory}" + | LegacyResolutionEnvironment.EditingOrCompilation false -> () + + yield registry + yield "{AssemblyFolders}" + yield "{GAC}" + // use path to implementation assemblies as the last resort + yield! GetPathToDotNetFrameworkImlpementationAssemblies targetFrameworkVersion + |] + + let assemblies = + [| + for referenceName, baggage in references -> + let item = TaskItem(referenceName) :> ITaskItem + item.SetMetadata("Baggage", baggage) + item + |] + + let rar = + ResolveAssemblyReference( + BuildEngine = engine, + TargetFrameworkDirectories = targetFrameworkDirectories, + FindRelatedFiles = false, + FindDependencies = false, + FindSatellites = false, + FindSerializationAssemblies = false, + Assemblies = assemblies, + SearchPaths = searchPaths, + AllowedAssemblyExtensions = [| ".dll"; ".exe" |] + ) + + rar.TargetProcessorArchitecture <- targetProcessorArchitecture + let targetedRuntimeVersionValue = typeof.Assembly.ImageRuntimeVersion + rar.TargetedRuntimeVersion <- targetedRuntimeVersionValue + rar.CopyLocalDependenciesWhenParentReferenceInGac <- true + + let succeeded = rar.Execute() + + if not succeeded then + raise LegacyResolutionFailure + + [| + for p in rar.ResolvedFiles -> + let resolvedFrom = DecodeResolvedFrom(p.GetMetadata("ResolvedFrom")) + let fusionName = p.GetMetadata("FusionName") + let redist = p.GetMetadata("Redist") + + { + itemSpec = p.ItemSpec + prepareToolTip = TooltipForResolvedFrom(resolvedFrom, fusionName, redist) + baggage = p.GetMetadata("Baggage") + } + |] + +let getResolver () = + { new ILegacyReferenceResolver with + member _.HighestInstalledNetFrameworkVersion() = + HighestInstalledRefAssembliesOrDotNETFramework() + + member _.DotNetFrameworkReferenceAssembliesRootDirectory = + DotNetFrameworkReferenceAssembliesRootDirectory + + /// Perform the resolution on rooted and unrooted paths, and then combine the results. + member _.Resolve + ( + resolutionEnvironment, + references, + targetFrameworkVersion, + targetFrameworkDirectories, + targetProcessorArchitecture, + fsharpCoreDir, + explicitIncludeDirs, + implicitIncludeDir, + logMessage, + logDiagnostic + ) = + + // The {RawFileName} target is 'dangerous', in the sense that is uses Directory.GetCurrentDirectory() to resolve unrooted file paths. + // It is unreliable to use this mutable global state inside Visual Studio. As a result, we partition all references into a "rooted" set + // (which contains e.g. C:\MyDir\MyAssem.dll) and "unrooted" (everything else). We only allow "rooted" to use {RawFileName}. Note that + // unrooted may still find 'local' assemblies by virtue of the fact that "implicitIncludeDir" is one of the places searched during + // assembly resolution. + let references = + [| + for fileName, baggage as data in references -> + // However, MSBuild will not resolve 'relative' paths, even when e.g. implicitIncludeDir is part of the search. As a result, + // if we have an unrooted path + file name, we'll assume this is relative to the project directory and root it. + if FileSystem.IsPathRootedShim(fileName) then + data // fine, e.g. "C:\Dir\foo.dll" + elif not (fileName.Contains("\\") || fileName.Contains("/")) then + data // fine, e.g. "System.Transactions.dll" + else + // We have a 'relative path', e.g. "bin/Debug/foo.exe" or "..\Yadda\bar.dll" + // turn it into an absolute path based at implicitIncludeDir + (Path.Combine(implicitIncludeDir, fileName), baggage) + |] + + let rooted, unrooted = + references |> Array.partition (fst >> FileSystem.IsPathRootedShim) + + let rootedResults = + ResolveCore( + resolutionEnvironment, + rooted, + targetFrameworkVersion, + targetFrameworkDirectories, + targetProcessorArchitecture, + fsharpCoreDir, + explicitIncludeDirs, + implicitIncludeDir, + true, + logMessage, + logDiagnostic + ) + + let unrootedResults = + ResolveCore( + resolutionEnvironment, + unrooted, + targetFrameworkVersion, + targetFrameworkDirectories, + targetProcessorArchitecture, + fsharpCoreDir, + explicitIncludeDirs, + implicitIncludeDir, + false, + logMessage, + logDiagnostic + ) + + // now unify the two sets of results + Array.concat [| rootedResults; unrootedResults |] + } + |> LegacyReferenceResolver diff --git a/src/Compiler/Legacy/LegacyMSBuildReferenceResolver.fsi b/src/LegacyMSBuildResolver/LegacyMSBuildReferenceResolver.fsi similarity index 100% rename from src/Compiler/Legacy/LegacyMSBuildReferenceResolver.fsi rename to src/LegacyMSBuildResolver/LegacyMSBuildReferenceResolver.fsi diff --git a/src/LegacyMSBuildResolver/LegacyResolver.txt b/src/LegacyMSBuildResolver/LegacyResolver.txt new file mode 100644 index 00000000000..1aac6347541 --- /dev/null +++ b/src/LegacyMSBuildResolver/LegacyResolver.txt @@ -0,0 +1,7 @@ +# ------------------------------------------------------------------------------- +# use a completely new error number and keep messages in their surrounding groups +# ------------------------------------------------------------------------------- +assemblyResolutionFoundByAssemblyFoldersKey,"Found by AssemblyFolders registry key" +assemblyResolutionFoundByAssemblyFoldersExKey,"Found by AssemblyFoldersEx registry key" +assemblyResolutionNetFramework,".NET Framework" +assemblyResolutionGAC,"Global Assembly Cache" \ No newline at end of file diff --git a/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.cs.xlf b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.cs.xlf new file mode 100644 index 00000000000..fe16dc84f65 --- /dev/null +++ b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.cs.xlf @@ -0,0 +1,27 @@ + + + + + + Found by AssemblyFoldersEx registry key + Found by AssemblyFoldersEx registry key + + + + Found by AssemblyFolders registry key + Found by AssemblyFolders registry key + + + + Global Assembly Cache + Global Assembly Cache + + + + .NET Framework + .NET Framework + + + + + \ No newline at end of file diff --git a/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.de.xlf b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.de.xlf new file mode 100644 index 00000000000..0980cec838a --- /dev/null +++ b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.de.xlf @@ -0,0 +1,27 @@ + + + + + + Found by AssemblyFoldersEx registry key + Found by AssemblyFoldersEx registry key + + + + Found by AssemblyFolders registry key + Found by AssemblyFolders registry key + + + + Global Assembly Cache + Global Assembly Cache + + + + .NET Framework + .NET Framework + + + + + \ No newline at end of file diff --git a/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.es.xlf b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.es.xlf new file mode 100644 index 00000000000..ae938d2cacd --- /dev/null +++ b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.es.xlf @@ -0,0 +1,27 @@ + + + + + + Found by AssemblyFoldersEx registry key + Found by AssemblyFoldersEx registry key + + + + Found by AssemblyFolders registry key + Found by AssemblyFolders registry key + + + + Global Assembly Cache + Global Assembly Cache + + + + .NET Framework + .NET Framework + + + + + \ No newline at end of file diff --git a/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.fr.xlf b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.fr.xlf new file mode 100644 index 00000000000..7fe41477230 --- /dev/null +++ b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.fr.xlf @@ -0,0 +1,27 @@ + + + + + + Found by AssemblyFoldersEx registry key + Found by AssemblyFoldersEx registry key + + + + Found by AssemblyFolders registry key + Found by AssemblyFolders registry key + + + + Global Assembly Cache + Global Assembly Cache + + + + .NET Framework + .NET Framework + + + + + \ No newline at end of file diff --git a/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.it.xlf b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.it.xlf new file mode 100644 index 00000000000..d20390cc87e --- /dev/null +++ b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.it.xlf @@ -0,0 +1,27 @@ + + + + + + Found by AssemblyFoldersEx registry key + Found by AssemblyFoldersEx registry key + + + + Found by AssemblyFolders registry key + Found by AssemblyFolders registry key + + + + Global Assembly Cache + Global Assembly Cache + + + + .NET Framework + .NET Framework + + + + + \ No newline at end of file diff --git a/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.ja.xlf b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.ja.xlf new file mode 100644 index 00000000000..2f2fbca84a3 --- /dev/null +++ b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.ja.xlf @@ -0,0 +1,27 @@ + + + + + + Found by AssemblyFoldersEx registry key + Found by AssemblyFoldersEx registry key + + + + Found by AssemblyFolders registry key + Found by AssemblyFolders registry key + + + + Global Assembly Cache + Global Assembly Cache + + + + .NET Framework + .NET Framework + + + + + \ No newline at end of file diff --git a/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.ko.xlf b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.ko.xlf new file mode 100644 index 00000000000..a57ff6c0dc3 --- /dev/null +++ b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.ko.xlf @@ -0,0 +1,27 @@ + + + + + + Found by AssemblyFoldersEx registry key + Found by AssemblyFoldersEx registry key + + + + Found by AssemblyFolders registry key + Found by AssemblyFolders registry key + + + + Global Assembly Cache + Global Assembly Cache + + + + .NET Framework + .NET Framework + + + + + \ No newline at end of file diff --git a/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.pl.xlf b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.pl.xlf new file mode 100644 index 00000000000..49133a8479c --- /dev/null +++ b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.pl.xlf @@ -0,0 +1,27 @@ + + + + + + Found by AssemblyFoldersEx registry key + Found by AssemblyFoldersEx registry key + + + + Found by AssemblyFolders registry key + Found by AssemblyFolders registry key + + + + Global Assembly Cache + Global Assembly Cache + + + + .NET Framework + .NET Framework + + + + + \ No newline at end of file diff --git a/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.pt-BR.xlf b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.pt-BR.xlf new file mode 100644 index 00000000000..fbfa95dbf16 --- /dev/null +++ b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.pt-BR.xlf @@ -0,0 +1,27 @@ + + + + + + Found by AssemblyFoldersEx registry key + Found by AssemblyFoldersEx registry key + + + + Found by AssemblyFolders registry key + Found by AssemblyFolders registry key + + + + Global Assembly Cache + Global Assembly Cache + + + + .NET Framework + .NET Framework + + + + + \ No newline at end of file diff --git a/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.ru.xlf b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.ru.xlf new file mode 100644 index 00000000000..c01f76a7296 --- /dev/null +++ b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.ru.xlf @@ -0,0 +1,27 @@ + + + + + + Found by AssemblyFoldersEx registry key + Found by AssemblyFoldersEx registry key + + + + Found by AssemblyFolders registry key + Found by AssemblyFolders registry key + + + + Global Assembly Cache + Global Assembly Cache + + + + .NET Framework + .NET Framework + + + + + \ No newline at end of file diff --git a/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.tr.xlf b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.tr.xlf new file mode 100644 index 00000000000..3131d7674af --- /dev/null +++ b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.tr.xlf @@ -0,0 +1,27 @@ + + + + + + Found by AssemblyFoldersEx registry key + Found by AssemblyFoldersEx registry key + + + + Found by AssemblyFolders registry key + Found by AssemblyFolders registry key + + + + Global Assembly Cache + Global Assembly Cache + + + + .NET Framework + .NET Framework + + + + + \ No newline at end of file diff --git a/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.zh-Hans.xlf b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.zh-Hans.xlf new file mode 100644 index 00000000000..7791accdff9 --- /dev/null +++ b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.zh-Hans.xlf @@ -0,0 +1,27 @@ + + + + + + Found by AssemblyFoldersEx registry key + Found by AssemblyFoldersEx registry key + + + + Found by AssemblyFolders registry key + Found by AssemblyFolders registry key + + + + Global Assembly Cache + Global Assembly Cache + + + + .NET Framework + .NET Framework + + + + + \ No newline at end of file diff --git a/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.zh-Hant.xlf b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.zh-Hant.xlf new file mode 100644 index 00000000000..52a305821cf --- /dev/null +++ b/src/LegacyMSBuildResolver/xlf/LegacyResolver.txt.zh-Hant.xlf @@ -0,0 +1,27 @@ + + + + + + Found by AssemblyFoldersEx registry key + Found by AssemblyFoldersEx registry key + + + + Found by AssemblyFolders registry key + Found by AssemblyFolders registry key + + + + Global Assembly Cache + Global Assembly Cache + + + + .NET Framework + .NET Framework + + + + + \ No newline at end of file diff --git a/src/fsc/fsc.targets b/src/fsc/fsc.targets index af1998e9bbe..6dccff1eae3 100644 --- a/src/fsc/fsc.targets +++ b/src/fsc/fsc.targets @@ -28,6 +28,11 @@ + + LegacyResolver.txt + + + {{FSCoreVersion}} @@ -46,6 +51,9 @@ + + + diff --git a/src/fsi/fsi.targets b/src/fsi/fsi.targets index 23ee6e76bfc..e553c55cf1c 100644 --- a/src/fsi/fsi.targets +++ b/src/fsi/fsi.targets @@ -32,6 +32,11 @@ + + LegacyResolver.txt + + + @@ -54,4 +59,10 @@ + + + + + + \ No newline at end of file diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected index 52360afde2a..5c85f5131fa 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -2191,9 +2191,54 @@ FSharp.Compiler.CodeAnalysis.FSharpUnresolvedReferencesSet: Boolean Equals(Syste FSharp.Compiler.CodeAnalysis.FSharpUnresolvedReferencesSet: Int32 GetHashCode() FSharp.Compiler.CodeAnalysis.FSharpUnresolvedReferencesSet: Int32 GetHashCode(System.Collections.IEqualityComparer) FSharp.Compiler.CodeAnalysis.FSharpUnresolvedReferencesSet: System.String ToString() -FSharp.Compiler.CodeAnalysis.LegacyMSBuildReferenceResolver -FSharp.Compiler.CodeAnalysis.LegacyMSBuildReferenceResolver: FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver getResolver() +FSharp.Compiler.CodeAnalysis.ILegacyReferenceResolver +FSharp.Compiler.CodeAnalysis.ILegacyReferenceResolver: FSharp.Compiler.CodeAnalysis.LegacyResolvedFile[] Resolve(FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment, System.Tuple`2[System.String,System.String][], System.String, Microsoft.FSharp.Collections.FSharpList`1[System.String], System.String, System.String, Microsoft.FSharp.Collections.FSharpList`1[System.String], System.String, Microsoft.FSharp.Core.FSharpFunc`2[System.String,Microsoft.FSharp.Core.Unit], Microsoft.FSharp.Core.FSharpFunc`2[System.Boolean,Microsoft.FSharp.Core.FSharpFunc`2[System.String,Microsoft.FSharp.Core.FSharpFunc`2[System.String,Microsoft.FSharp.Core.Unit]]]) +FSharp.Compiler.CodeAnalysis.ILegacyReferenceResolver: System.String DotNetFrameworkReferenceAssembliesRootDirectory +FSharp.Compiler.CodeAnalysis.ILegacyReferenceResolver: System.String HighestInstalledNetFrameworkVersion() +FSharp.Compiler.CodeAnalysis.ILegacyReferenceResolver: System.String get_DotNetFrameworkReferenceAssembliesRootDirectory() FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver +FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver: Void .ctor(FSharp.Compiler.CodeAnalysis.ILegacyReferenceResolver) +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment+EditingOrCompilation: Boolean get_isEditing() +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment+EditingOrCompilation: Boolean isEditing +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment+Tags: Int32 CompilationAndEvaluation +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment+Tags: Int32 EditingOrCompilation +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: Boolean Equals(FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment) +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: Boolean Equals(System.Object) +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: Boolean IsCompilationAndEvaluation +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: Boolean IsEditingOrCompilation +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: Boolean get_IsCompilationAndEvaluation() +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: Boolean get_IsEditingOrCompilation() +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment CompilationAndEvaluation +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment NewEditingOrCompilation(Boolean) +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment get_CompilationAndEvaluation() +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment+EditingOrCompilation +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment+Tags +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: Int32 CompareTo(FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment) +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: Int32 CompareTo(System.Object) +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: Int32 CompareTo(System.Object, System.Collections.IComparer) +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: Int32 GetHashCode() +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: Int32 GetHashCode(System.Collections.IEqualityComparer) +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: Int32 Tag +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: Int32 get_Tag() +FSharp.Compiler.CodeAnalysis.LegacyResolutionEnvironment: System.String ToString() +FSharp.Compiler.CodeAnalysis.LegacyResolutionFailure +FSharp.Compiler.CodeAnalysis.LegacyResolutionFailure: Boolean Equals(System.Object) +FSharp.Compiler.CodeAnalysis.LegacyResolutionFailure: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +FSharp.Compiler.CodeAnalysis.LegacyResolutionFailure: Int32 GetHashCode() +FSharp.Compiler.CodeAnalysis.LegacyResolutionFailure: Int32 GetHashCode(System.Collections.IEqualityComparer) +FSharp.Compiler.CodeAnalysis.LegacyResolutionFailure: System.String get_Message() +FSharp.Compiler.CodeAnalysis.LegacyResolutionFailure: Void .ctor() +FSharp.Compiler.CodeAnalysis.LegacyResolvedFile +FSharp.Compiler.CodeAnalysis.LegacyResolvedFile: Microsoft.FSharp.Core.FSharpFunc`2[System.Tuple`2[System.String,System.String],System.String] get_prepareToolTip() +FSharp.Compiler.CodeAnalysis.LegacyResolvedFile: Microsoft.FSharp.Core.FSharpFunc`2[System.Tuple`2[System.String,System.String],System.String] prepareToolTip +FSharp.Compiler.CodeAnalysis.LegacyResolvedFile: System.String ToString() +FSharp.Compiler.CodeAnalysis.LegacyResolvedFile: System.String baggage +FSharp.Compiler.CodeAnalysis.LegacyResolvedFile: System.String get_baggage() +FSharp.Compiler.CodeAnalysis.LegacyResolvedFile: System.String get_itemSpec() +FSharp.Compiler.CodeAnalysis.LegacyResolvedFile: System.String itemSpec +FSharp.Compiler.CodeAnalysis.LegacyResolvedFile: Void .ctor(System.String, Microsoft.FSharp.Core.FSharpFunc`2[System.Tuple`2[System.String,System.String],System.String], System.String) FSharp.Compiler.CompilerEnvironment FSharp.Compiler.CompilerEnvironment: Boolean IsCheckerSupportedSubcategory(System.String) FSharp.Compiler.CompilerEnvironment: Boolean IsCompilable(System.String) diff --git a/tests/fsharpqa/testenv/src/HostedCompilerServer/HostedCompilerServer.fsproj b/tests/fsharpqa/testenv/src/HostedCompilerServer/HostedCompilerServer.fsproj index a697caba11a..e417791c80d 100644 --- a/tests/fsharpqa/testenv/src/HostedCompilerServer/HostedCompilerServer.fsproj +++ b/tests/fsharpqa/testenv/src/HostedCompilerServer/HostedCompilerServer.fsproj @@ -15,6 +15,11 @@ + + LegacyResolver.txt + + + @@ -24,4 +29,10 @@ + + + + + + diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj index db217723e13..d27151bf5e5 100644 --- a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj @@ -22,6 +22,11 @@ true Microsoft.VisualStudio.FSharp.Editor.SR + + LegacyResolver.txt + + +