diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 37e6eb62d8..ee731140ff 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -525,6 +525,7 @@ let private transformObjExpr match baseCall.DeclaringEntity with | Some baseEnt when baseEnt.TryFullName <> Some Types.object -> let r = makeRangeFrom baseCallExpr + checkSelfConstructorBase com ctx r baseEnt let genArgs = genArgs1 @ genArgs2 return transformBaseConsCall com ctx r baseEnt baseCall genArgs baseArgs |> Some @@ -793,6 +794,124 @@ let rec private transformDecisionTargets } +// F# omits the `init@` field it adds for `new() as x` from the record expression of the constructor +let private withOmittedFieldDefaults (com: IFableCompiler) (ctx: Context) (fsType: FSharpType) (args: Fable.Expr list) = + let ent = fsType.TypeDefinition + + if hasCompilerGeneratedConstructor ent then + let genArgs = + getGenericArguments fsType |> Seq.map (makeType ctx.GenericArgs) |> List.ofSeq + + let genArgs = + Seq.zip ent.GenericParameters genArgs + |> Seq.map (fun (param, typ) -> genParamName param, typ) + |> Map.ofSeq + + let fields = + ent.FSharpFields |> Seq.filter (fun field -> not field.IsStatic) |> List.ofSeq + + let omitted = + List.skip (min args.Length fields.Length) fields + |> List.map (fun field -> makeType genArgs field.FieldType |> Replacements.Api.defaultof com ctx None) + + args @ omitted + else + args + +let private (|LoadSelf|_|) (e: FSharpExpr) = + match e with + | FSharpExprPatterns.ILAsm(("[I_ldarg 0us]" | "[I_ldarg 0]"), [], []) -> Some() + | _ -> None + +// FCS writes `init@` on self in every constructor of a class with a self identifier +let rec private loadsSelf skipInitWrite (e: FSharpExpr) = + match e with + | LoadSelf -> true + | FSharpExprPatterns.FSharpFieldSet(Some LoadSelf, _, field, value) when + skipInitWrite && field.Name.StartsWith("init@") + -> + loadsSelf skipInitWrite value + | e -> e.ImmediateSubExpressions |> List.exists (loadsSelf skipInitWrite) + +let private hasSelfConstructor (com: IFableCompiler) (ent: FSharpEntity) = + let constructors = + ent.MembersFunctionsAndValues |> Seq.filter (fun memb -> memb.IsConstructor) + + let hasPrimaryConstructor = + constructors |> Seq.exists (fun memb -> memb.IsImplicitConstructor) + + let hasExplicitConstructor = + constructors |> Seq.exists (fun memb -> not memb.IsImplicitConstructor) + + if + (FsEnt.Ref ent).SourcePath.IsNone + || isGlobalOrImportedFSharpEntity ent + || not hasExplicitConstructor + then + false + else + let file = Path.normalizePathAndEnsureFsExtension ent.DeclarationLocation.FileName + + let rec exists decls = + decls + |> List.exists ( + function + | FSharpImplementationFileDeclaration.Entity(_, sub) -> exists sub + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(memb, _, body) -> + memb.IsConstructor + && not memb.IsImplicitConstructor + && memb.DeclaringEntity + |> Option.exists (fun declaring -> declaring.TryFullName = ent.TryFullName) + && loadsSelf hasPrimaryConstructor body + | FSharpImplementationFileDeclaration.InitAction _ -> false + ) + + let decls = + try + Some(com.GetImplementationFile(file)) + with _ -> + None + + match decls with + | Some decls -> + com.AddWatchDependency(file) + exists decls + // Precompiled libraries keep the `init@` field of such a class, but not the constructor bodies + | None -> + ent.FSharpFields + |> Seq.exists (fun field -> not field.IsStatic && field.Name.StartsWith("init@")) + +let private checkSelfConstructorBase (com: IFableCompiler) (ctx: Context) r (baseEnt: FSharpEntity) = + if hasSelfConstructor com baseEnt then + $"%s{baseEnt.FullName} has a constructor with a self identifier (`new() as x`), which Fable does not support inheriting from." + |> addError com ctx.InlinePath r + +// F# emits `new() = { ... } then body` as sequences nested after the created object +let private (|ExplicitConstructorThen|_|) com (ctx: Context) (fsExpr: FSharpExpr) = + match ctx.EnclosingMember with + | Some m when + m.IsConstructor + && not m.IsImplicitConstructor + && supportsCompilerGeneratedBaseCall com + && m.DeclaringEntity + |> Option.exists (fun ent -> (tryGetBaseEntity ent).IsNone && not (isAttachMembersEntity com ent)) + -> + let isCreated (e: FSharpExpr) = + e.Type.HasTypeDefinition + && m.DeclaringEntity |> Option.exists (fun ent -> ent = e.Type.TypeDefinition) + + let rec split (e: FSharpExpr) = + match e with + | FSharpExprPatterns.Sequential(first, second) when isCreated first -> + let created, rest = split first + created, rest @ [ second ] + | _ -> e, [] + + match fsExpr with + | FSharpExprPatterns.Sequential(first, _) when isCreated fsExpr && isCreated first -> Some(split fsExpr) + | _ -> None + | _ -> None + let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fsExpr = trampoline { match fsExpr with @@ -987,6 +1106,17 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs | _, Some i -> identWithRange r i |> Fable.IdentExpr | _, None -> Fable.Value(makeType Map.empty typ |> Fable.ThisValue, r) + // The `x` of `new() as x` is read through an IL `this` load, printed `0us` by FCS on .NET and `0` by FCS on JS + | FSharpExprPatterns.ILAsm(("[I_ldarg 0us]" | "[I_ldarg 0]"), [], []) -> + let r = makeRangeFrom fsExpr + + return + match ctx.BoundConstructorThis with + | Some i -> identWithRange r i |> Fable.IdentExpr + | None -> + "This explicit constructor uses a self identifier (`new() as x`), which Fable only supports on JavaScript, TypeScript and Python, in a class with no base class and without []." + |> addErrorAndReturnNull com ctx.InlinePath r + | FSharpExprPatterns.Value var -> let r = makeRangeFrom fsExpr @@ -1640,6 +1770,15 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs return Fable.Let(baseIdent, baseValue, newRecord) + | ExplicitConstructorThen com ctx (created, rest) when ctx.BoundConstructorThis.IsNone -> + let! created = transformExpr com ctx [] created + let thisIdent = getIdentUniqueName com ctx "this" |> makeTypedIdent created.Type + + let! rest = + transformExprList com { ctx with BoundConstructorThis = Some thisIdent } rest + + return Fable.Let(thisIdent, created, Fable.Sequential(rest @ [ Fable.IdentExpr thisIdent ])) + | FSharpExprPatterns.Sequential(first, second) -> let exprs = match ctx.CaptureBaseConsCall with @@ -1666,7 +1805,10 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs | FSharpExprPatterns.NewRecord(fsType, argExprs) -> let r = makeRangeFrom fsExpr let! argExprs = transformExprList com ctx argExprs - let argExprs = withDefaultValueFields com ctx fsType argExprs + + let argExprs = + withDefaultValueFields com ctx fsType argExprs + |> withOmittedFieldDefaults com ctx fsType let genArgs = makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType) let entRef = FsEnt.Ref fsType.TypeDefinition @@ -2456,6 +2598,12 @@ let rec private transformDeclarations (com: FableCompiler) ctx fsDecls = checkInlinedTaggedUnionCases com ctx fsEnt warnDuplicateCompiledNames com ctx fsEnt + if not (isGlobalOrImportedFSharpEntity fsEnt) then + tryGetBaseEntity fsEnt + |> Option.iter (fun (baseEnt, _) -> + checkSelfConstructorBase com ctx (Some(makeRange fsEnt.DeclarationLocation)) baseEnt + ) + match sub with | [] when isIgnoredLeafEntity fsEnt -> [] | [] -> diff --git a/tests/Integration/Compiler/CompilerMessagesTests.fs b/tests/Integration/Compiler/CompilerMessagesTests.fs index c998d034b8..7fe26be375 100644 --- a/tests/Integration/Compiler/CompilerMessagesTests.fs +++ b/tests/Integration/Compiler/CompilerMessagesTests.fs @@ -21,6 +21,254 @@ let tests = |> Assert.Is.success |> ignore + testCase "Explicit constructor with a self identifier and no base compiles" <| fun _ -> + let source = + """ +type Base = + val mutable Count: int + new (a: int) as self = { Count = a } then self.Count <- self.Count + 1 +""" + compile source + |> Assert.Is.strictSuccess + |> ignore + + testCase "Explicit child of a class with a self identifier results in error" <| fun _ -> + let source = + """ +type Base = + val mutable Count: int + new (a: int) as self = { Count = a } then self.Count <- self.Count + 1 + +type Derived = + inherit Base + val X: int + new () = { inherit Base(1); X = 1 } +""" + compile source + |> Assert.Exists.errorWith "does not support inheriting from" + |> ignore + + testCase "Primary constructor child of a class with a self identifier results in error" <| fun _ -> + let source = + """ +type Base = + val mutable Count: int + new (a: int) as self = { Count = a } then self.Count <- self.Count + 1 + +type Derived() = + inherit Base(5) +""" + compile source + |> Assert.Exists.errorWith "does not support inheriting from" + |> ignore + + testCase "Object expression over a class with a self identifier results in error" <| fun _ -> + let source = + """ +type Base = + val mutable Count: int + new (a: int) as self = { Count = a } then self.Count <- self.Count + 1 + +let o = { new Base(5) with member _.ToString() = "o" } +""" + compile source + |> Assert.Exists.errorWith "does not support inheriting from" + |> ignore + + testCase "Child of a primary constructor class with a secondary self constructor results in error" <| fun _ -> + let source = + """ +type Base(a: int) = + member val V = a with get, set + new () as self = Base(1) then self.V <- self.V + 10 + +type Derived = + inherit Base + val E: int + new () = { inherit Base(); E = 1 } +""" + compile source + |> Assert.Exists.errorWith "does not support inheriting from" + |> ignore + + testCase "Self identifier with an explicit constructor base results in error" <| fun _ -> + let source = + """ +type Base = + val N: int + new (n: int) = { N = n } + +type Derived = + inherit Base + val mutable Y: int + new () as self = { inherit Base(1); Y = 0 } then self.Y <- self.N +""" + compile source + |> Assert.Exists.errorWith "uses a self identifier" + |> ignore + + testCase "Self identifier with a primary constructor base results in error" <| fun _ -> + let source = + """ +type Base(a: int) = + member _.A = a + +type Derived = + inherit Base + val mutable Y: int + new (a: int) as self = { inherit Base(a); Y = 0 } then self.Y <- self.A + 1 +""" + compile source + |> Assert.Exists.errorWith "uses a self identifier" + |> ignore + + testCase "Self identifier with a BCL base results in error" <| fun _ -> + let source = + """ +type Derived = + inherit System.Exception + val Code: int + new (m: string) as self = { inherit System.Exception(m); Code = 1 } +""" + compile source + |> Assert.Exists.errorWith "uses a self identifier" + |> ignore + + testCase "Self identifier with AttachMembers results in error" <| fun _ -> + let source = + """ +[] +type C = + val mutable V: int + new (v: int) as self = { V = v } then self.V <- self.V + 1 +""" + compile source + |> Assert.Exists.errorWith "uses a self identifier" + |> ignore + + testCase "Child of a primary constructor class with a self identifier compiles" <| fun _ -> + let source = + """ +type Base() as this = + let mutable n = 0 + do this.Set(1) + member _.Set(v: int) = n <- v + member _.N = n + +type Derived() = + inherit Base() +""" + compile source + |> Assert.Is.strictSuccess + |> ignore + + testCase "Child of a primary constructor class with a self identifier and a secondary constructor compiles" <| fun _ -> + let source = + """ +type Base(x: int) as this = + do this.Touch() + new () = Base(1) + member _.X = x + member _.Touch() = () + +type Derived() = + inherit Base(2) +""" + compile source + |> Assert.Is.strictSuccess + |> ignore + + testCase "Primary constructor child of a secondary constructor with a self identifier results in error" <| fun _ -> + let source = + """ +type Base(a: int) = + member val V = a with get, set + new () as self = Base(1) then self.V <- self.V + 10 + +type Derived() = + inherit Base() +""" + compile source + |> Assert.Exists.errorWith "does not support inheriting from" + |> ignore + + testCase "Child of an imported class with a self identifier compiles" <| fun _ -> + let source = + """ +[] +type Base = + val mutable X: int + new () as self = { X = 1 } then self.X <- 2 + +type Derived() = + inherit Base() +""" + compile source + |> Assert.Is.success + |> ignore + + testCase "Imported child of a class with a self identifier compiles" <| fun _ -> + let source = + """ +type Base = + val mutable X: int + new () as self = { X = 1 } then self.X <- 2 + +[] +type Child() = + inherit Base() +""" + compile source + |> Assert.Is.success + |> ignore + + testCase "Explicit child of a class without a self identifier compiles" <| fun _ -> + let source = + """ +type Base = + val N: int + new (n: int) = { N = n } + +type Derived = + inherit Base + val X: int + new () = { inherit Base(1); X = 1 } +""" + compile source + |> Assert.Is.strictSuccess + |> ignore + + testCase "Child of a self identifier class behind a signature file results in error" <| fun _ -> + let signature = + """ +module Library + +type Base = + val mutable N: int + new: n: int -> Base +""" + + let library = + """ +module Library + +type Base = + val mutable N: int + new (n: int) as self = { N = n } then self.N <- self.N + 1 +""" + + let source = + """ +type Derived = + inherit Library.Base + val X: int + new () = { inherit Library.Base(1); X = 1 } +""" + + compileWithSignedLibrary signature library source + |> Assert.Exists.errorWith "does not support inheriting from" + |> ignore + testCase "Compile printfn" <| fun _ -> let source = "printfn \"Hello %s\" \"World\"" compile source diff --git a/tests/Integration/Compiler/WatchDependencyTests.fs b/tests/Integration/Compiler/WatchDependencyTests.fs index d35d4bd846..b913e89aeb 100644 --- a/tests/Integration/Compiler/WatchDependencyTests.fs +++ b/tests/Integration/Compiler/WatchDependencyTests.fs @@ -47,6 +47,38 @@ let tests = logs |> Assert.Is.strictSuccess |> ignore deps |> Map.tryFind "Program.fs" |> Option.defaultValue [] |> equal [ "Library.fs" ] + testCase "A file that inherits a parameterless explicit constructor depends on the file of its body" <| fun _ -> + let signature = + """ +module Library + +type Base = + val N: int + new: unit -> Base +""" + + let library = + """ +module Library + +type Base = + val N: int + new () = { N = 1 } +""" + + let source = + """ +type Derived = + inherit Library.Base + val M: int + new () = { inherit Library.Base(); M = 2 } +""" + + let logs, deps = watchDependencies signature library source + + logs |> Assert.Is.strictSuccess |> ignore + deps |> Map.tryFind "Program.fs" |> Option.defaultValue [] |> equal [ "Library.fs" ] + testCase "Editing an inline function in a file with a signature recompiles the files that inlined it" <| fun _ -> Compiler.Cached.startWatchingSignedLibrary Compiler.Settings.standard signature (library 3) source waitForOutput "Program.fs" "2 * 3" diff --git a/tests/Integration/Integration/CompilationTests.fs b/tests/Integration/Integration/CompilationTests.fs index d1bc6070b4..180dfa25e3 100644 --- a/tests/Integration/Integration/CompilationTests.fs +++ b/tests/Integration/Integration/CompilationTests.fs @@ -56,6 +56,46 @@ let private checkBrowserInlineExprs (precompiledDir: string) = (Fable.BrowserInlineExprs.toString [| name, fromCompact |]) $"%s{name} differs between the two copies" +let private precompiledBaseTest name fixture shouldCompile = + testCaseAsync + name + (async { + let testCaseDir = Path.Combine(__SOURCE_DIRECTORY__, "precompiledBases", fixture) + let libraryProject = Path.Combine(testCaseDir, "library", "library.fsproj") + let project = Path.Combine(testCaseDir, fixture + ".fsproj") + let tempDir = Path.Combine(Path.GetTempPath(), Path.GetRandomFileName()) + let precompiledDir = Path.Combine(tempDir, "precompiled") + + try + let precompileExitCode = + Fable.Cli.Entry.main [| "precompile"; libraryProject; "--outDir"; precompiledDir; "--noCache" |] + + Expect.equal precompileExitCode 0 "Expected precompile exit code to be 0" + + let exitCode = + Fable.Cli.Entry.main + [| + project + "--cwd" + testCaseDir + "--outDir" + Path.Combine(tempDir, "out") + "--exclude" + "Fable.Core" + "--noCache" + "--precompiledLib" + precompiledDir + |] + + if shouldCompile then + Expect.equal exitCode 0 "Expected the compilation to succeed" + else + Expect.notEqual exitCode 0 "Expected the compilation to fail" + finally + if Directory.Exists tempDir then + Directory.Delete(tempDir, true) + }) + let tests = Directory.EnumerateDirectories(data) |> Seq.map (fun testCaseDir -> // @@ -129,4 +169,9 @@ let tests = })) |> Seq.toList + |> List.append + [ + precompiledBaseTest "Inheriting a precompiled class with a self identifier is an error" "selfBase" false + precompiledBaseTest "Inheriting a precompiled class with a static let binding compiles" "staticInit" true + ] |> testList "Compilation" diff --git a/tests/Integration/Integration/precompiledBases/selfBase/App.fs b/tests/Integration/Integration/precompiledBases/selfBase/App.fs new file mode 100644 index 0000000000..1b320a101b --- /dev/null +++ b/tests/Integration/Integration/precompiledBases/selfBase/App.fs @@ -0,0 +1,6 @@ +module App + +type Derived = + inherit Library.Base + val M: int + new () = { inherit Library.Base(1); M = 2 } diff --git a/tests/Integration/Integration/precompiledBases/selfBase/library/Library.fs b/tests/Integration/Integration/precompiledBases/selfBase/library/Library.fs new file mode 100644 index 0000000000..f520508840 --- /dev/null +++ b/tests/Integration/Integration/precompiledBases/selfBase/library/Library.fs @@ -0,0 +1,7 @@ +module Library + +let registered = ResizeArray() + +type Base = + val N: int + new (n: int) as self = { N = n } then registered.Add(box self) diff --git a/tests/Integration/Integration/precompiledBases/selfBase/library/library.fsproj b/tests/Integration/Integration/precompiledBases/selfBase/library/library.fsproj new file mode 100644 index 0000000000..6fc5f67a94 --- /dev/null +++ b/tests/Integration/Integration/precompiledBases/selfBase/library/library.fsproj @@ -0,0 +1,12 @@ + + + net10.0 + Major + + + + + + + + diff --git a/tests/Integration/Integration/precompiledBases/selfBase/selfBase.fsproj b/tests/Integration/Integration/precompiledBases/selfBase/selfBase.fsproj new file mode 100644 index 0000000000..912d3e71a2 --- /dev/null +++ b/tests/Integration/Integration/precompiledBases/selfBase/selfBase.fsproj @@ -0,0 +1,13 @@ + + + net10.0 + Major + + + + + + + + + diff --git a/tests/Integration/Integration/precompiledBases/staticInit/App.fs b/tests/Integration/Integration/precompiledBases/staticInit/App.fs new file mode 100644 index 0000000000..9a0033d8aa --- /dev/null +++ b/tests/Integration/Integration/precompiledBases/staticInit/App.fs @@ -0,0 +1,4 @@ +module App + +type Child() = + inherit Library.Counter(1) diff --git a/tests/Integration/Integration/precompiledBases/staticInit/library/Library.fs b/tests/Integration/Integration/precompiledBases/staticInit/library/Library.fs new file mode 100644 index 0000000000..7fa0cb4149 --- /dev/null +++ b/tests/Integration/Integration/precompiledBases/staticInit/library/Library.fs @@ -0,0 +1,6 @@ +module Library + +type Counter(n: int) = + static let zero = 0 + new () = Counter(zero) + member _.N = n diff --git a/tests/Integration/Integration/precompiledBases/staticInit/library/library.fsproj b/tests/Integration/Integration/precompiledBases/staticInit/library/library.fsproj new file mode 100644 index 0000000000..6fc5f67a94 --- /dev/null +++ b/tests/Integration/Integration/precompiledBases/staticInit/library/library.fsproj @@ -0,0 +1,12 @@ + + + net10.0 + Major + + + + + + + + diff --git a/tests/Integration/Integration/precompiledBases/staticInit/staticInit.fsproj b/tests/Integration/Integration/precompiledBases/staticInit/staticInit.fsproj new file mode 100644 index 0000000000..912d3e71a2 --- /dev/null +++ b/tests/Integration/Integration/precompiledBases/staticInit/staticInit.fsproj @@ -0,0 +1,13 @@ + + + net10.0 + Major + + + + + + + + + diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index 4f8b8e5bde..f646f7f8d5 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -975,6 +975,50 @@ type ValClassPairBox<'U> = val Count: int new (a: 'U, b: 'U) = { inherit ValClassGenericBase<'U * 'U>((a, b)); Count = 2 } +let mutable valClassThenCalls = 0 + +type ValClassThen = + val mutable Value: int + new () = { Value = 1 } then valClassThenCalls <- valClassThenCalls + 1 + +[] +type ValClassSequenceInit = + val Next: ValClassSequenceInit + val Id: int + val Boxed: obj + new (id: int) = { Next = null; Id = id; Boxed = null } + new (a: int, b: int) = { Next = (ValClassSequenceInit(a); ValClassSequenceInit(b)); Id = 0; Boxed = box (do ValClassSequenceInit(a)) } + new (a: int, b: int, c: int) as self = { Next = (ValClassSequenceInit(a); ValClassSequenceInit(b)); Id = c; Boxed = box (do ValClassSequenceInit(a)) } then self.Next.Id |> ignore + +type ValClassSelf = + val mutable Name: string + val mutable Count: int + new (name: string) as self = { Name = name; Count = 0 } then self.Count <- self.Name.Length + new () as self = ValClassSelf("ab") then self.Count <- self.Count * 10 + +type ValClassSelfOutOfOrder = + val Z: int + val mutable W: int + new () as self = { W = 2; Z = 3 } then self.W <- self.W + self.Z + +let valClassSelfSaved = ResizeArray() + +type ValClassSelfSaved = + val Id: int + new (id: int) as self = { Id = id } then valClassSelfSaved.Add(box self) + new () as self = ValClassSelfSaved(1) then valClassSelfSaved.Add(box self) + +type SelfPrimaryBase(x: int) as this = + let mutable touched = 0 + do this.Touch() + new () = SelfPrimaryBase(1) + member _.X = x + member _.Touched = touched + member _.Touch() = touched <- touched + 1 + +type SelfPrimaryChild() = + inherit SelfPrimaryBase(2) + let tests = testList "Types" [ @@ -1989,4 +2033,42 @@ let tests = let pairBox = ValClassPairBox("a", "b") pairBox.Value |> equal ("a", "b") pairBox.Count |> equal 2 + + testCase "Explicit constructor returns the object after its then block" <| fun () -> + let before = valClassThenCalls + let c = ValClassThen() + c.Value |> equal 1 + valClassThenCalls - before |> equal 1 + + testCase "Explicit constructor keeps sequences of its own constructor calls in field values" <| fun () -> + let c = ValClassSequenceInit(5, 6) + c.Next.Id |> equal 6 + isNull c.Boxed |> equal true + let d = ValClassSequenceInit(5, 6, 7) + (d.Next.Id, d.Id, isNull d.Boxed) |> equal (6, 7, true) + + testCase "Explicit constructor with a self identifier works" <| fun () -> // See #5166 + let a = ValClassSelf("abc") + a.Name |> equal "abc" + a.Count |> equal 3 + let b = ValClassSelf() + b.Name |> equal "ab" + b.Count |> equal 20 + let c = ValClassSelfOutOfOrder() + (c.Z, c.W) |> equal (3, 5) + + testCase "Primary constructor with a self identifier works with a secondary constructor" <| fun () -> + let a = SelfPrimaryBase() + (a.X, a.Touched) |> equal (1, 1) + let b = SelfPrimaryChild() + (b.X, b.Touched) |> equal (2, 1) + + testCase "Explicit constructor self identifier is the created object" <| fun () -> + valClassSelfSaved.Clear() + let a = ValClassSelfSaved(5) + obj.ReferenceEquals(valClassSelfSaved.[0], a) |> equal true + let b = ValClassSelfSaved() + valClassSelfSaved.Count |> equal 3 + obj.ReferenceEquals(valClassSelfSaved.[1], b) |> equal true + obj.ReferenceEquals(valClassSelfSaved.[2], b) |> equal true ] diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index a2eef539b1..ab9fc9476c 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2030,3 +2030,90 @@ let ``test explicit constructor resolves the generic arguments of the base class let pairBox = ValClassPairBox("a", "b") pairBox.Value |> equal ("a", "b") pairBox.Count |> equal 2 + +let mutable valClassThenCalls = 0 + +type ValClassThen = + val mutable Value: int + new () = { Value = 1 } then valClassThenCalls <- valClassThenCalls + 1 + +[] +type ValClassSequenceInit = + val Next: ValClassSequenceInit + val Id: int + val Boxed: obj + new (id: int) = { Next = null; Id = id; Boxed = null } + new (a: int, b: int) = { Next = (ValClassSequenceInit(a); ValClassSequenceInit(b)); Id = 0; Boxed = box (do ValClassSequenceInit(a)) } + new (a: int, b: int, c: int) as self = { Next = (ValClassSequenceInit(a); ValClassSequenceInit(b)); Id = c; Boxed = box (do ValClassSequenceInit(a)) } then self.Next.Id |> ignore + +type ValClassSelf = + val mutable Name: string + val mutable Count: int + new (name: string) as self = { Name = name; Count = 0 } then self.Count <- self.Name.Length + new () as self = ValClassSelf("ab") then self.Count <- self.Count * 10 + +type ValClassSelfOutOfOrder = + val Z: int + val mutable W: int + new () as self = { W = 2; Z = 3 } then self.W <- self.W + self.Z + +let valClassSelfSaved = ResizeArray() + +type ValClassSelfSaved = + val Id: int + new (id: int) as self = { Id = id } then valClassSelfSaved.Add(box self) + new () as self = ValClassSelfSaved(1) then valClassSelfSaved.Add(box self) + +type SelfPrimaryBase(x: int) as this = + let mutable touched = 0 + do this.Touch() + new () = SelfPrimaryBase(1) + member _.X = x + member _.Touched = touched + member _.Touch() = touched <- touched + 1 + +type SelfPrimaryChild() = + inherit SelfPrimaryBase(2) + +[] +let ``test explicit constructor returns the object after its then block`` () = + let before = valClassThenCalls + let c = ValClassThen() + c.Value |> equal 1 + valClassThenCalls - before |> equal 1 + +[] +let ``test explicit constructor keeps sequences of its own constructor calls in field values`` () = + let c = ValClassSequenceInit(5, 6) + c.Next.Id |> equal 6 + isNull c.Boxed |> equal true + let d = ValClassSequenceInit(5, 6, 7) + (d.Next.Id, d.Id, isNull d.Boxed) |> equal (6, 7, true) + +[] +let ``test explicit constructor with a self identifier works`` () = // See #5166 + let a = ValClassSelf("abc") + a.Name |> equal "abc" + a.Count |> equal 3 + let b = ValClassSelf() + b.Name |> equal "ab" + b.Count |> equal 20 + let c = ValClassSelfOutOfOrder() + (c.Z, c.W) |> equal (3, 5) + +[] +let ``test primary constructor with a self identifier works with a secondary constructor`` () = + let a = SelfPrimaryBase() + (a.X, a.Touched) |> equal (1, 1) + let b = SelfPrimaryChild() + (b.X, b.Touched) |> equal (2, 1) + +[] +let ``test explicit constructor self identifier is the created object`` () = + valClassSelfSaved.Clear() + let a = ValClassSelfSaved(5) + obj.ReferenceEquals(valClassSelfSaved.[0], a) |> equal true + let b = ValClassSelfSaved() + valClassSelfSaved.Count |> equal 3 + obj.ReferenceEquals(valClassSelfSaved.[1], b) |> equal true + obj.ReferenceEquals(valClassSelfSaved.[2], b) |> equal true