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/). diff --git a/eng/Versions.props b/eng/Versions.props index 334e324e6f6..971e0bc4049 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -31,7 +31,7 @@ 6.0.0.0 - 42 + 43 7 200 $(FSRevisionVersion) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 48fee010206..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 @@ -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/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/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 9c9da192081..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<_,_>'." @@ -1561,6 +1557,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/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/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/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/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) 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/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index a0bc2e214c7..7ad080d2aaf 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 @@ -5657,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 42a106317c2..fbb0a7bfb34 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. @@ -5657,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 932afaea4ff..7d8aca4e042 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 @@ -5657,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 01b2db7f5c4..bb507ae5dd8 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 @@ -5657,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 9e47f7b017f..e07ab4a3b59 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 @@ -5657,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 5262c515b26..1f0084d7541 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 属性を持つコンストラクトの非推奨アクセスでエラーが発生しました @@ -5657,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 232411cd146..42e39e8db3c 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 특성을 사용하여 사용되지 않는 구문 액세스에 대한 오류 제공 @@ -5657,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 0e97c468507..24ec9716810 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 @@ -5657,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 3da17e5abaf..7bbd44e0748 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 @@ -5657,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 0b55fec7ee5..dcec58500e5 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 @@ -5657,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 1643e114292..fe7389a0a37 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 @@ -5657,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 9eccaa3a848..a1f490de899 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 属性的构造进行弃用的访问时出错 @@ -5657,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 38bc273305f..00e26426d17 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 屬性的建構的已取代存取發出錯誤 @@ -5657,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/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 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.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/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/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 diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 240cf851b92..85239d5a3c0 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -187,6 +187,7 @@ + @@ -206,6 +207,7 @@ + @@ -222,6 +224,7 @@ + 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 [] 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.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/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/fsharp/Compiler/Language/TypeDirectedConversionTests.fs b/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs index be31e72712e..054664224c9 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: System.DateTime, dtype: System.Nullable) = 1 + static member A(size: System.DateTimeOffset, dtype: System.Nullable) = 2 + +let test() = M.A(System.DateTime.UtcNow, 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: System.DateTime, n: int64) = 1 + static member A(m: System.DateTimeOffset, n: int64) = 2 + +let test() = M.A(System.DateTime.UtcNow, 1) + """ + FSharpDiagnosticSeverity.Error + 41 + (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: System.DateTime * int + +Candidates: + - 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""" 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 e1ec4ad346d..c43b1aceabf 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" [] @@ -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 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 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 + + +