From e06da9dabf891a15c843bc1611d55187dd80bcc7 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Fri, 30 Oct 2026 23:56:22 +0100 Subject: [PATCH 01/16] fix(all): support explicit constructors with as and then --- src/Fable.Transforms/FSharp2Fable.fs | 149 ++++++++++++++++++++++----- tests/Js/Main/TypeTests.fs | 35 +++++++ tests/Python/TestType.fs | 37 +++++++ 3 files changed, 195 insertions(+), 26 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 37e6eb62d..c277347ce 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -792,6 +792,104 @@ let rec private transformDecisionTargets return! transformDecisionTargets com ctx ((idents, expr) :: acc) tail } +// 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 isBaseCallOfRecord com (ctx: Context) (baseCons: FSharpMemberOrFunctionOrValue) (fsType: FSharpType) = + ctx.CaptureBaseConsCall.IsNone + && supportsCompilerGeneratedBaseCall com + && fsType.HasTypeDefinition + && ( + match baseCons.DeclaringEntity, tryGetBaseEntity fsType.TypeDefinition with + | Some callee, Some(baseEnt, _) -> callee = baseEnt + | _ -> false + ) + && (tryGetCompilerGeneratedBases fsType.TypeDefinition + |> Option.exists (List.isEmpty >> not)) + +let private transformBaseCallAndRecord + (com: IFableCompiler) + (ctx: Context) + r + (baseCall: FSharpExpr) + (fsType: FSharpType) + (ownArgs: FSharpExpr list) + = + trampoline { + let! baseValue = transformExpr com ctx [] baseCall + let! ownArgs = transformExprList com ctx ownArgs + + let ownArgs = + withDefaultValueFields com ctx fsType ownArgs + |> withOmittedFieldDefaults com ctx fsType + + let baseIdent = getIdentUniqueName com ctx "base" |> makeTypedIdent baseValue.Type + + let inheritedArgs = + getInheritedValFields fsType.TypeDefinition ctx.GenericArgs + |> List.map (fun (field, typ) -> getFieldWith None typ (Fable.IdentExpr baseIdent) field.Name) + + let genArgs = makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType) + let entRef = FsEnt.Ref fsType.TypeDefinition + entRef.SourcePath |> Option.iter com.AddSignatureDependency + + let newRecord = + Fable.NewRecord(inheritedArgs @ ownArgs, entRef, genArgs) |> makeValue r + + return Fable.Let(baseIdent, baseValue, newRecord) + } + +// F# emits `new() = { ... } then body` as sequences nested after the created object, with any base call before it +let private (|ExplicitConstructorThen|_|) com (ctx: Context) (fsExpr: FSharpExpr) = + match ctx.EnclosingMember with + | Some m when m.IsConstructor && not m.IsImplicitConstructor -> + 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(ConstructorCall(baseCons, _, _) as baseCall, second) when + not (isCreated baseCall) + -> + match split second with + | FSharpExprPatterns.NewRecord(fsType, ownArgs), (_ :: _ as rest) when + isBaseCallOfRecord com ctx baseCons fsType + -> + Some(Choice2Of2(baseCall, fsType, ownArgs), rest) + | _ -> None + | FSharpExprPatterns.Sequential(first, _) when isCreated first -> + let created, rest = split fsExpr + Some(Choice1Of2 created, rest) + | _ -> None + | _ -> None let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fsExpr = trampoline { @@ -987,6 +1085,15 @@ 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) + // F# reads the `x` of an explicit `new() as x` through the IL instruction loading `this` + | FSharpExprPatterns.ILAsm("[I_ldarg 0us]", [], []) -> + let r = makeRangeFrom fsExpr + + return + match ctx.BoundConstructorThis with + | Some i -> identWithRange r i |> Fable.IdentExpr + | None -> Fable.Value(makeType ctx.GenericArgs fsExpr.Type |> Fable.ThisValue, r) + | FSharpExprPatterns.Value var -> let r = makeRangeFrom fsExpr @@ -1609,36 +1716,23 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs | FSharpExprPatterns.Sequential(ConstructorCall(baseCons, _, _) as first, FSharpExprPatterns.NewRecord(fsType, ownArgs)) when - ctx.CaptureBaseConsCall.IsNone - && supportsCompilerGeneratedBaseCall com - && fsType.HasTypeDefinition - && ( - match baseCons.DeclaringEntity, tryGetBaseEntity fsType.TypeDefinition with - | Some callee, Some(baseEnt, _) -> callee = baseEnt - | _ -> false - ) - && (tryGetCompilerGeneratedBases fsType.TypeDefinition - |> Option.exists (List.isEmpty >> not)) + isBaseCallOfRecord com ctx baseCons fsType -> - let r = makeRangeFrom fsExpr - let! baseValue = transformExpr com ctx [] first - let! ownArgs = transformExprList com ctx ownArgs - let ownArgs = withDefaultValueFields com ctx fsType ownArgs + return! transformBaseCallAndRecord com ctx (makeRangeFrom fsExpr) first fsType ownArgs - let baseIdent = getIdentUniqueName com ctx "base" |> makeTypedIdent baseValue.Type + | ExplicitConstructorThen com ctx (created, rest) when ctx.BoundConstructorThis.IsNone -> + let! created = + match created with + | Choice1Of2 created -> transformExpr com ctx [] created + | Choice2Of2(baseCall, fsType, ownArgs) -> + transformBaseCallAndRecord com ctx (makeRangeFrom fsExpr) baseCall fsType ownArgs - let inheritedArgs = - getInheritedValFields fsType.TypeDefinition ctx.GenericArgs - |> List.map (fun (field, typ) -> getFieldWith None typ (Fable.IdentExpr baseIdent) field.Name) + let thisIdent = getIdentUniqueName com ctx "this" |> makeTypedIdent created.Type - let genArgs = makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType) - let entRef = FsEnt.Ref fsType.TypeDefinition - entRef.SourcePath |> Option.iter com.AddSignatureDependency + let! rest = + transformExprList com { ctx with BoundConstructorThis = Some thisIdent } rest - let newRecord = - Fable.NewRecord(inheritedArgs @ ownArgs, entRef, genArgs) |> makeValue r - - return Fable.Let(baseIdent, baseValue, newRecord) + return Fable.Let(thisIdent, created, Fable.Sequential(rest @ [ Fable.IdentExpr thisIdent ])) | FSharpExprPatterns.Sequential(first, second) -> let exprs = @@ -1666,7 +1760,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 diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index 4f8b8e5bd..d4bfbf67d 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -975,6 +975,23 @@ 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 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 ValClassSelfChild = + inherit ValClassBase + val mutable Extra: float + new (id: int, extra: float) as this = { inherit ValClassBase(id); Extra = extra } then this.Extra <- this.Extra + float this.Id + let tests = testList "Types" [ @@ -1989,4 +2006,22 @@ 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 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 = ValClassSelfChild(3, 1.5) + c.Id |> equal 30 + c.Extra |> equal 31.5 + c.Describe() |> equal "base:30" ] diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index a2eef539b..418cece7d 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2030,3 +2030,40 @@ 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 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 ValClassSelfChild = + inherit ValClassBase + val mutable Extra: float + new (id: int, extra: float) as this = { inherit ValClassBase(id); Extra = extra } then this.Extra <- this.Extra + float this.Id + +[] +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 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 = ValClassSelfChild(3, 1.5) + c.Id |> equal 30 + c.Extra |> equal 31.5 + c.Describe() |> equal "base:30" From 9d40798b6f6e74c338516b5f417de690c2ec9676 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Sun, 1 Nov 2026 11:18:29 +0100 Subject: [PATCH 02/16] fix(all): match the self load printed by standalone FCS --- src/Fable.Transforms/FSharp2Fable.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index c277347ce..1d847472e 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -1085,8 +1085,8 @@ 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) - // F# reads the `x` of an explicit `new() as x` through the IL instruction loading `this` - | FSharpExprPatterns.ILAsm("[I_ldarg 0us]", [], []) -> + // 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 From 68c351b1dae7e2a136dea52a6224d5de94168c92 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Mon, 2 Nov 2026 08:10:38 +0100 Subject: [PATCH 03/16] fix(all): limit the then lowering to supported targets --- src/Fable.Transforms/FSharp2Fable.fs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 1d847472e..963176ac1 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -863,7 +863,11 @@ let private transformBaseCallAndRecord // F# emits `new() = { ... } then body` as sequences nested after the created object, with any base call before it let private (|ExplicitConstructorThen|_|) com (ctx: Context) (fsExpr: FSharpExpr) = match ctx.EnclosingMember with - | Some m when m.IsConstructor && not m.IsImplicitConstructor -> + | Some m when + m.IsConstructor + && not m.IsImplicitConstructor + && supportsCompilerGeneratedBaseCall com + -> let isCreated (e: FSharpExpr) = e.Type.HasTypeDefinition && m.DeclaringEntity |> Option.exists (fun ent -> ent = e.Type.TypeDefinition) @@ -876,6 +880,7 @@ let private (|ExplicitConstructorThen|_|) com (ctx: Context) (fsExpr: FSharpExpr | _ -> e, [] match fsExpr with + | _ when not (isCreated fsExpr) -> None | FSharpExprPatterns.Sequential(ConstructorCall(baseCons, _, _) as baseCall, second) when not (isCreated baseCall) -> From 953076c1e6234ac6b276b7cde656b5fd3d2919b4 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Mon, 2 Nov 2026 08:43:31 +0100 Subject: [PATCH 04/16] fix(js/ts): sanitize inherited field names in base calls --- src/Fable.Transforms/Babel/Fable2Babel.fs | 22 ++++++++++++++++++++-- tests/Js/Main/TypeTests.fs | 11 +++++++++++ tests/Python/TestType.fs | 12 ++++++++++++ 3 files changed, 43 insertions(+), 2 deletions(-) diff --git a/src/Fable.Transforms/Babel/Fable2Babel.fs b/src/Fable.Transforms/Babel/Fable2Babel.fs index 5582a9ae2..8e139dafa 100644 --- a/src/Fable.Transforms/Babel/Fable2Babel.fs +++ b/src/Fable.Transforms/Babel/Fable2Babel.fs @@ -4511,8 +4511,26 @@ but thanks to the optimisation done below we get ent.BaseType |> Option.map (fun d -> Fable.DeclaredType(d.Entity, d.GenericArgs)) - match extractSuperClassFromBaseCall com ctx baseType decl.BaseCall with - | Some(baseExpr, superArgs) -> Some baseExpr, superArgs, baseCallIdents decl.BaseCall + // Inherited fields are passed by their F# names, which can be compiler-generated like `init@5` + let baseCall = + decl.BaseCall + |> Option.map ( + function + | Fable.Call(callee, info, t, r) -> + let args = + info.Args + |> List.map ( + function + | Fable.IdentExpr id -> Fable.IdentExpr { id with Name = sanitizeName id.Name } + | arg -> arg + ) + + Fable.Call(callee, { info with Args = args }, t, r) + | baseCall -> baseCall + ) + + match extractSuperClassFromBaseCall com ctx baseType baseCall with + | Some(baseExpr, superArgs) -> Some baseExpr, superArgs, baseCallIdents baseCall | None -> None, [], [||] let body = diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index d4bfbf67d..68a26cbd8 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -987,6 +987,11 @@ type ValClassSelf = 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 ValClassSelfInherited = + inherit ValClassSelf + val Tag: string + new () = { inherit ValClassSelf("abcd"); Tag = "t" } + type ValClassSelfChild = inherit ValClassBase val mutable Extra: float @@ -2013,6 +2018,12 @@ let tests = c.Value |> equal 1 valClassThenCalls - before |> equal 1 + testCase "Explicit constructor inherits a base with a self identifier" <| fun () -> + let c = ValClassSelfInherited() + c.Name |> equal "abcd" + c.Count |> equal 4 + c.Tag |> equal "t" + testCase "Explicit constructor with a self identifier works" <| fun () -> // See #5166 let a = ValClassSelf("abc") a.Name |> equal "abc" diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index 418cece7d..e23cb8e17 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2043,6 +2043,11 @@ type ValClassSelf = 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 ValClassSelfInherited = + inherit ValClassSelf + val Tag: string + new () = { inherit ValClassSelf("abcd"); Tag = "t" } + type ValClassSelfChild = inherit ValClassBase val mutable Extra: float @@ -2067,3 +2072,10 @@ let ``test explicit constructor with a self identifier works`` () = // See #5166 c.Id |> equal 30 c.Extra |> equal 31.5 c.Describe() |> equal "base:30" + +[] +let ``test Explicit constructor inherits a base with a self identifier`` () = + let c = ValClassSelfInherited() + c.Name |> equal "abcd" + c.Count |> equal 4 + c.Tag |> equal "t" From 1dda7e375f747109631a60ec900e4c0249f78e22 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 18:58:04 +0100 Subject: [PATCH 05/16] fix(js/ts/python): error when a base then passes self on --- src/Fable.Transforms/FSharp2Fable.fs | 57 +++++++++++++++++++ .../Compiler/CompilerMessagesTests.fs | 52 +++++++++++++++++ 2 files changed, 109 insertions(+) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 963176ac1..369989553 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -828,6 +828,57 @@ let private isBaseCallOfRecord com (ctx: Context) (baseCons: FSharpMemberOrFunct && (tryGetCompilerGeneratedBases fsType.TypeDefinition |> Option.exists (List.isEmpty >> not)) +let rec private constructorLeaksSelf (com: IFableCompiler) (cons: FSharpMemberOrFunctionOrValue) = + let isSelfCell (e: FSharpExpr) = + match e with + | FSharpExprPatterns.FSharpFieldGet(Some(FSharpExprPatterns.ThisValue _), _, field) -> field.Name = "contents" + | _ -> false + + // F# reads the `x` of `new() as x` as `CheckThis(x.contents)` + let isSelf (e: FSharpExpr) = + match e with + | FSharpExprPatterns.Call(None, memb, _, _, [ arg ]) when memb.CompiledName = "CheckThis" -> isSelfCell arg + | e -> isSelfCell e + + // The base fields are copied to the derived instance after `then`, so field reads and writes on self stay correct + let rec leaksSelf (e: FSharpExpr) = + match e with + | FSharpExprPatterns.FSharpFieldSet(Some(FSharpExprPatterns.ThisValue _), _, field, FSharpExprPatterns.ILAsm _) when + field.Name = "contents" + -> + false + | FSharpExprPatterns.FSharpFieldSet(Some(FSharpExprPatterns.ILAsm _), _, _, value) -> leaksSelf value + | FSharpExprPatterns.FSharpFieldGet(Some target, _, _) when isSelf target -> false + | FSharpExprPatterns.FSharpFieldSet(Some target, _, _, value) when isSelf target -> leaksSelf value + | e when isSelf e -> true + | FSharpExprPatterns.ILAsm(("[I_ldarg 0us]" | "[I_ldarg 0]"), [], []) -> true + | ConstructorCall(other, _, _) when + other.DeclaringEntity = cons.DeclaringEntity + && other.DeclarationLocation <> cons.DeclarationLocation + -> + constructorLeaksSelf com other + | e -> e.ImmediateSubExpressions |> List.exists leaksSelf + + let rec tryFindBody decls = + decls + |> List.tryPick ( + function + | FSharpImplementationFileDeclaration.Entity(_, decls) -> tryFindBody decls + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(memb, _, body) when + memb.DeclarationLocation = cons.DeclarationLocation + -> + Some body + | _ -> None + ) + + let decls = + try + com.GetImplementationFile(cons.DeclarationLocation.FileName) + with _ -> + [] + + tryFindBody decls |> Option.exists leaksSelf + let private transformBaseCallAndRecord (com: IFableCompiler) (ctx: Context) @@ -836,6 +887,12 @@ let private transformBaseCallAndRecord (fsType: FSharpType) (ownArgs: FSharpExpr list) = + match baseCall with + | ConstructorCall(baseCons, _, _) when not baseCons.IsImplicitConstructor && constructorLeaksSelf com baseCons -> + $"%s{fsType.TypeDefinition.FullName} calls a constructor of %s{baseCons.DeclaringEntity.Value.FullName} whose `then` block uses its self identifier for more than reading or setting fields. Fable cannot run that block on the derived instance." + |> addError com ctx.InlinePath r + | _ -> () + trampoline { let! baseValue = transformExpr com ctx [] baseCall let! ownArgs = transformExprList com ctx ownArgs diff --git a/tests/Integration/Compiler/CompilerMessagesTests.fs b/tests/Integration/Compiler/CompilerMessagesTests.fs index c998d034b..20efb5d34 100644 --- a/tests/Integration/Compiler/CompilerMessagesTests.fs +++ b/tests/Integration/Compiler/CompilerMessagesTests.fs @@ -862,6 +862,58 @@ type AuthState = | One of string let one = AuthState.One "a" +""" + compile source + |> Assert.Is.strictSuccess + |> ignore + + testCase "Explicit constructor calling a base constructor that passes self on after then results in error" <| fun _ -> + let source = + """ +type Base = + val Name: string + new (name: string) as self = { Name = name } then printfn "%O" (box self) + +type Derived = + inherit Base + val X: int + new () = { inherit Base("d"); X = 1 } +""" + compile source + |> Assert.Exists.errorWith "Derived calls a constructor of" + |> ignore + + testCase "Explicit constructor calling a base constructor that chains to one passing self on results in error" <| fun _ -> + let source = + """ +type Base = + val Name: string + new (name: string) as self = { Name = name } then printfn "%O" (box self) + new () = Base("x") + +type Derived = + inherit Base + val X: int + new () = { inherit Base(); X = 1 } +""" + compile source + |> Assert.Exists.errorWith "uses its self identifier" + |> ignore + + testCase "Explicit constructor calling a base constructor that only sets fields on self compiles" <| fun _ -> + let source = + """ +type Base = + val Name: string + val mutable Count: int + new (name: string) as self = { Name = name; Count = 0 } then self.Count <- self.Name.Length + new () = { Name = "plain"; Count = 0 } then printfn "plain" + +type Derived = + inherit Base + val X: int + new () = { inherit Base("d"); X = 1 } + new (x: int) = { inherit Base(); X = x } """ compile source |> Assert.Is.strictSuccess From 25e86ac4d19045f4aae73b2d5e230a311e07ff1f Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 19:36:20 +0100 Subject: [PATCH 06/16] fix(js/ts/python): catch self captured by a base then --- src/Fable.Transforms/FSharp2Fable.fs | 27 +++++---- .../Compiler/CompilerMessagesTests.fs | 57 +++++++++++++++++++ 2 files changed, 74 insertions(+), 10 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 369989553..59dde6d50 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -828,36 +828,43 @@ let private isBaseCallOfRecord com (ctx: Context) (baseCons: FSharpMemberOrFunct && (tryGetCompilerGeneratedBases fsType.TypeDefinition |> Option.exists (List.isEmpty >> not)) -let rec private constructorLeaksSelf (com: IFableCompiler) (cons: FSharpMemberOrFunctionOrValue) = +let rec private constructorLeaksSelf (com: IFableCompiler) visited (cons: FSharpMemberOrFunctionOrValue) = let isSelfCell (e: FSharpExpr) = match e with | FSharpExprPatterns.FSharpFieldGet(Some(FSharpExprPatterns.ThisValue _), _, field) -> field.Name = "contents" | _ -> false // F# reads the `x` of `new() as x` as `CheckThis(x.contents)` - let isSelf (e: FSharpExpr) = + let rec isSelf (e: FSharpExpr) = match e with + | FSharpExprPatterns.Coerce(_, inner) -> isSelf inner | FSharpExprPatterns.Call(None, memb, _, _, [ arg ]) when memb.CompiledName = "CheckThis" -> isSelfCell arg | e -> isSelfCell e // The base fields are copied to the derived instance after `then`, so field reads and writes on self stay correct - let rec leaksSelf (e: FSharpExpr) = + // unless a closure performs them later + let rec leaksSelf inClosure (e: FSharpExpr) = match e with | FSharpExprPatterns.FSharpFieldSet(Some(FSharpExprPatterns.ThisValue _), _, field, FSharpExprPatterns.ILAsm _) when field.Name = "contents" -> false - | FSharpExprPatterns.FSharpFieldSet(Some(FSharpExprPatterns.ILAsm _), _, _, value) -> leaksSelf value - | FSharpExprPatterns.FSharpFieldGet(Some target, _, _) when isSelf target -> false - | FSharpExprPatterns.FSharpFieldSet(Some target, _, _, value) when isSelf target -> leaksSelf value + | FSharpExprPatterns.FSharpFieldSet(Some(FSharpExprPatterns.ILAsm _), _, _, value) -> leaksSelf inClosure value + | FSharpExprPatterns.FSharpFieldGet(Some target, _, _) when isSelf target -> inClosure + | FSharpExprPatterns.FSharpFieldSet(Some target, _, _, value) when isSelf target -> + inClosure || leaksSelf inClosure value | e when isSelf e -> true | FSharpExprPatterns.ILAsm(("[I_ldarg 0us]" | "[I_ldarg 0]"), [], []) -> true | ConstructorCall(other, _, _) when other.DeclaringEntity = cons.DeclaringEntity && other.DeclarationLocation <> cons.DeclarationLocation + && not (List.contains other.DeclarationLocation visited) -> - constructorLeaksSelf com other - | e -> e.ImmediateSubExpressions |> List.exists leaksSelf + constructorLeaksSelf com (cons.DeclarationLocation :: visited) other + | FSharpExprPatterns.Lambda _ + | FSharpExprPatterns.NewDelegate _ + | FSharpExprPatterns.ObjectExpr _ -> e.ImmediateSubExpressions |> List.exists (leaksSelf true) + | e -> e.ImmediateSubExpressions |> List.exists (leaksSelf inClosure) let rec tryFindBody decls = decls @@ -877,7 +884,7 @@ let rec private constructorLeaksSelf (com: IFableCompiler) (cons: FSharpMemberOr with _ -> [] - tryFindBody decls |> Option.exists leaksSelf + tryFindBody decls |> Option.exists (leaksSelf false) let private transformBaseCallAndRecord (com: IFableCompiler) @@ -888,7 +895,7 @@ let private transformBaseCallAndRecord (ownArgs: FSharpExpr list) = match baseCall with - | ConstructorCall(baseCons, _, _) when not baseCons.IsImplicitConstructor && constructorLeaksSelf com baseCons -> + | ConstructorCall(baseCons, _, _) when not baseCons.IsImplicitConstructor && constructorLeaksSelf com [] baseCons -> $"%s{fsType.TypeDefinition.FullName} calls a constructor of %s{baseCons.DeclaringEntity.Value.FullName} whose `then` block uses its self identifier for more than reading or setting fields. Fable cannot run that block on the derived instance." |> addError com ctx.InlinePath r | _ -> () diff --git a/tests/Integration/Compiler/CompilerMessagesTests.fs b/tests/Integration/Compiler/CompilerMessagesTests.fs index 20efb5d34..ddd7beb6c 100644 --- a/tests/Integration/Compiler/CompilerMessagesTests.fs +++ b/tests/Integration/Compiler/CompilerMessagesTests.fs @@ -900,6 +900,63 @@ type Derived = |> Assert.Exists.errorWith "uses its self identifier" |> ignore + testCase "Explicit constructor calling a base constructor that captures self in a closure results in error" <| fun _ -> + let source = + """ +let getters = ResizeArray int>() + +type Base = + val mutable Count: int + new (c: int) as self = { Count = c } then getters.Add(fun () -> self.Count) + +type Derived = + inherit Base + val X: int + new () = { inherit Base(5); X = 1 } +""" + compile source + |> Assert.Exists.errorWith "Derived calls a constructor of" + |> ignore + + testCase "Explicit constructor calling a base constructor that sets an inherited field on self compiles" <| fun _ -> + let source = + """ +type Root = + val mutable Id: int + new (id: int) = { Id = id } + +type Base = + inherit Root + val mutable Extra: int + new (id: int) as self = { inherit Root(id); Extra = 0 } then self.Id <- self.Id * 10 + +type Derived = + inherit Base + val X: int + new () = { inherit Base(3); X = 1 } +""" + compile source + |> Assert.Is.strictSuccess + |> ignore + + testCase "Explicit constructor calling mutually recursive base constructors compiles" <| fun _ -> + let source = + """ +type Base = + val V: int + new (x: int) = Base() + new () = Base(1) + new (x: string) = { V = 0 } + +type Derived = + inherit Base + val W: int + new () = { inherit Base(); W = 1 } +""" + compile source + |> Assert.Is.strictSuccess + |> ignore + testCase "Explicit constructor calling a base constructor that only sets fields on self compiles" <| fun _ -> let source = """ From e402602269be000cc5f3b2e501a0f10fbce5c706 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 19:36:22 +0100 Subject: [PATCH 07/16] test(js/ts/python): cover ctor sequences in field values --- tests/Js/Main/TypeTests.fs | 13 +++++++++++++ tests/Python/TestType.fs | 14 ++++++++++++++ 2 files changed, 27 insertions(+) diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index 68a26cbd8..86c327e9d 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -981,6 +981,14 @@ 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)) } + type ValClassSelf = val mutable Name: string val mutable Count: int @@ -2018,6 +2026,11 @@ let tests = 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 + testCase "Explicit constructor inherits a base with a self identifier" <| fun () -> let c = ValClassSelfInherited() c.Name |> equal "abcd" diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index e23cb8e17..0e84b2b07 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2037,6 +2037,14 @@ 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)) } + type ValClassSelf = val mutable Name: string val mutable Count: int @@ -2060,6 +2068,12 @@ let ``test explicit constructor returns the object after its then block`` () = 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 ``test explicit constructor with a self identifier works`` () = // See #5166 let a = ValClassSelf("abc") From ddd22cde8e230938ebf8649a355053aae8f5fd7a Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 19:55:08 +0100 Subject: [PATCH 08/16] fix(js/ts/python): handle for loops and fsi in self check --- src/Fable.Transforms/FSharp2Fable.fs | 18 +++++++++++++----- .../Compiler/CompilerMessagesTests.fs | 17 +++++++++++++++++ 2 files changed, 30 insertions(+), 5 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 59dde6d50..88654c06c 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -828,7 +828,12 @@ let private isBaseCallOfRecord com (ctx: Context) (baseCons: FSharpMemberOrFunct && (tryGetCompilerGeneratedBases fsType.TypeDefinition |> Option.exists (List.isEmpty >> not)) +let private implementationLocation (memb: FSharpMemberOrFunctionOrValue) = + memb.ImplementationLocation |> Option.defaultValue memb.DeclarationLocation + let rec private constructorLeaksSelf (com: IFableCompiler) visited (cons: FSharpMemberOrFunctionOrValue) = + let consLocation = implementationLocation cons + let isSelfCell (e: FSharpExpr) = match e with | FSharpExprPatterns.FSharpFieldGet(Some(FSharpExprPatterns.ThisValue _), _, field) -> field.Name = "contents" @@ -857,10 +862,13 @@ let rec private constructorLeaksSelf (com: IFableCompiler) visited (cons: FSharp | FSharpExprPatterns.ILAsm(("[I_ldarg 0us]" | "[I_ldarg 0]"), [], []) -> true | ConstructorCall(other, _, _) when other.DeclaringEntity = cons.DeclaringEntity - && other.DeclarationLocation <> cons.DeclarationLocation - && not (List.contains other.DeclarationLocation visited) + && implementationLocation other <> consLocation + && not (List.contains (implementationLocation other) visited) -> - constructorLeaksSelf com (cons.DeclarationLocation :: visited) other + constructorLeaksSelf com (consLocation :: visited) other + // FCS gives the body of an integer `for` loop as a lambda over the loop variable + | FSharpExprPatterns.FastIntegerForLoop(start, limit, FSharpExprPatterns.Lambda(_, body), _, _, _) -> + [ start; limit; body ] |> List.exists (leaksSelf inClosure) | FSharpExprPatterns.Lambda _ | FSharpExprPatterns.NewDelegate _ | FSharpExprPatterns.ObjectExpr _ -> e.ImmediateSubExpressions |> List.exists (leaksSelf true) @@ -872,7 +880,7 @@ let rec private constructorLeaksSelf (com: IFableCompiler) visited (cons: FSharp function | FSharpImplementationFileDeclaration.Entity(_, decls) -> tryFindBody decls | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(memb, _, body) when - memb.DeclarationLocation = cons.DeclarationLocation + implementationLocation memb = consLocation -> Some body | _ -> None @@ -880,7 +888,7 @@ let rec private constructorLeaksSelf (com: IFableCompiler) visited (cons: FSharp let decls = try - com.GetImplementationFile(cons.DeclarationLocation.FileName) + com.GetImplementationFile(consLocation.FileName) with _ -> [] diff --git a/tests/Integration/Compiler/CompilerMessagesTests.fs b/tests/Integration/Compiler/CompilerMessagesTests.fs index ddd7beb6c..ab18f9850 100644 --- a/tests/Integration/Compiler/CompilerMessagesTests.fs +++ b/tests/Integration/Compiler/CompilerMessagesTests.fs @@ -939,6 +939,23 @@ type Derived = |> Assert.Is.strictSuccess |> ignore + testCase "Explicit constructor calling a base constructor that sets fields on self in a for loop compiles" <| fun _ -> + let source = + """ +type Base = + val mutable Count: int + new (c: int) as self = { Count = c } then + for i = 1 to 3 do self.Count <- self.Count + i + +type Derived = + inherit Base + val X: int + new () = { inherit Base(5); X = 1 } +""" + compile source + |> Assert.Is.strictSuccess + |> ignore + testCase "Explicit constructor calling mutually recursive base constructors compiles" <| fun _ -> let source = """ From ca388e099c44848135cdff530f0057347d1afe65 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 20:03:31 +0100 Subject: [PATCH 09/16] fix(js/ts/python): follow only the chained base ctor --- src/Fable.Transforms/FSharp2Fable.fs | 26 +++++++++---- .../Compiler/CompilerMessagesTests.fs | 39 +++++++++++++++++++ 2 files changed, 58 insertions(+), 7 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 88654c06c..276d10325 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -860,12 +860,6 @@ let rec private constructorLeaksSelf (com: IFableCompiler) visited (cons: FSharp inClosure || leaksSelf inClosure value | e when isSelf e -> true | FSharpExprPatterns.ILAsm(("[I_ldarg 0us]" | "[I_ldarg 0]"), [], []) -> true - | ConstructorCall(other, _, _) when - other.DeclaringEntity = cons.DeclaringEntity - && implementationLocation other <> consLocation - && not (List.contains (implementationLocation other) visited) - -> - constructorLeaksSelf com (consLocation :: visited) other // FCS gives the body of an integer `for` loop as a lambda over the loop variable | FSharpExprPatterns.FastIntegerForLoop(start, limit, FSharpExprPatterns.Lambda(_, body), _, _, _) -> [ start; limit; body ] |> List.exists (leaksSelf inClosure) @@ -892,7 +886,25 @@ let rec private constructorLeaksSelf (com: IFableCompiler) visited (cons: FSharp with _ -> [] - tryFindBody decls |> Option.exists (leaksSelf false) + // The constructor this one chains to (`new() = C(1) then ...`) runs first, on the same object + let rec tryChainedConstructor (e: FSharpExpr) = + match e with + | FSharpExprPatterns.Let(_, body) -> tryChainedConstructor body + | FSharpExprPatterns.Sequential(first, _) -> tryChainedConstructor first + | ConstructorCall(other, _, _) when other.DeclaringEntity = cons.DeclaringEntity -> Some other + | _ -> None + + let chainedLeaksSelf body = + match tryChainedConstructor body with + | Some other when + implementationLocation other <> consLocation + && not (List.contains (implementationLocation other) visited) + -> + constructorLeaksSelf com (consLocation :: visited) other + | _ -> false + + tryFindBody decls + |> Option.exists (fun body -> leaksSelf false body || chainedLeaksSelf body) let private transformBaseCallAndRecord (com: IFableCompiler) diff --git a/tests/Integration/Compiler/CompilerMessagesTests.fs b/tests/Integration/Compiler/CompilerMessagesTests.fs index ab18f9850..5542000d1 100644 --- a/tests/Integration/Compiler/CompilerMessagesTests.fs +++ b/tests/Integration/Compiler/CompilerMessagesTests.fs @@ -956,6 +956,45 @@ type Derived = |> Assert.Is.strictSuccess |> ignore + testCase "Explicit constructor calling a base constructor that passes self to another constructor results in error" <| fun _ -> + let source = + """ +let registry = ResizeArray() + +type Base = + val V: int + val Parent: obj + new (o: obj) = { V = 1; Parent = o } + new () as self = { V = 0; Parent = null } then registry.Add(Base(box self)) + +type Derived = + inherit Base + val W: int + new () = { inherit Base(); W = 1 } +""" + compile source + |> Assert.Exists.errorWith "Derived calls a constructor of" + |> ignore + + testCase "Explicit constructor calling a base constructor that builds another instance of its type compiles" <| fun _ -> + let source = + """ +let registry = ResizeArray() + +type Base = + val V: int + new (x: int) as self = { V = x } then registry.Add(box self) + new () = { V = 0 } then Base(1) |> ignore + +type Derived = + inherit Base + val W: int + new () = { inherit Base(); W = 1 } +""" + compile source + |> Assert.Is.strictSuccess + |> ignore + testCase "Explicit constructor calling mutually recursive base constructors compiles" <| fun _ -> let source = """ From d021eed3a363c49c7de8e10890093b6eedfab91f Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Fri, 6 Nov 2026 21:28:49 +0100 Subject: [PATCH 10/16] fix(js/ts/python): reject unsupported self ctors --- src/Fable.Transforms/FSharp2Fable.fs | 183 +++++++++++++----- .../Compiler/CompilerMessagesTests.fs | 139 +++++++++++++ tests/Js/Main/TypeTests.fs | 18 ++ tests/Python/TestType.fs | 19 ++ 4 files changed, 312 insertions(+), 47 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 276d10325..57793cc79 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -21,6 +21,13 @@ let private transformExprList com ctx xs = let private transformExprOpt com ctx opt = trampolineOptionMap (transformExpr com ctx []) opt +let private unsupportedSelfConstructorMessage = + "This explicit constructor uses a self identifier (`new() as x`), which Fable only supports on JavaScript, TypeScript and Python, in a class without [] whose base class, if any, is an F# class without a primary constructor." + +let private addSelfBaseConstructorError (com: IFableCompiler) (ctx: Context) r (baseEnt: FSharpEntity) = + $"%s{baseEnt.FullName} has a constructor with a self identifier (`new() as x`), which Fable cannot run on a derived instance here." + |> addError com ctx.InlinePath r + let private transformBaseConsCall com ctx @@ -43,7 +50,10 @@ let private transformBaseConsCall makeCall r Fable.Unit callInfo baseRef | None -> if not baseCons.IsImplicitConstructor then - WarningCodes.nonPrimaryBaseConstructor |> addWarningWithCode com [] r + if constructorBindsSelf com baseCons then + addSelfBaseConstructorError com ctx r baseEnt + else + WarningCodes.nonPrimaryBaseConstructor |> addWarningWithCode com [] r match makeCallFrom com ctx r Fable.Unit genArgs None baseArgs baseCons with | Fable.Call(_baseExpr, info, t, r) when not (com.Options.Language = Rust) -> @@ -792,6 +802,14 @@ let rec private transformDecisionTargets return! transformDecisionTargets com ctx ((idents, expr) :: acc) tail } +// F# binds record fields written out of declaration order before creating the record +let rec private (|BoundNewRecord|_|) (e: FSharpExpr) = + match e with + | FSharpExprPatterns.NewRecord(fsType, args) -> Some([], fsType, args) + | FSharpExprPatterns.Let((var, value, _), BoundNewRecord(bindings, fsType, args)) -> + Some((var, value) :: bindings, fsType, args) + | _ -> None + // 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 @@ -831,9 +849,69 @@ let private isBaseCallOfRecord com (ctx: Context) (baseCons: FSharpMemberOrFunct let private implementationLocation (memb: FSharpMemberOrFunctionOrValue) = memb.ImplementationLocation |> Option.defaultValue memb.DeclarationLocation -let rec private constructorLeaksSelf (com: IFableCompiler) visited (cons: FSharpMemberOrFunctionOrValue) = +let private tryFindConstructorBody (com: IFableCompiler) (cons: FSharpMemberOrFunctionOrValue) = let consLocation = implementationLocation cons + let rec tryFindBody decls = + decls + |> List.tryPick ( + function + | FSharpImplementationFileDeclaration.Entity(_, decls) -> tryFindBody decls + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(memb, _, body) when + implementationLocation memb = consLocation + -> + Some body + | _ -> None + ) + + let decls = + try + com.GetImplementationFile(consLocation.FileName) + with _ -> + [] + + tryFindBody decls + +// The constructors this one chains to (`new() = C(1) then ...`) run first, on the same object +let rec private chainedConstructors (cons: FSharpMemberOrFunctionOrValue) (e: FSharpExpr) = + let isCreated (e: FSharpExpr) = + e.Type.HasTypeDefinition + && cons.DeclaringEntity |> Option.exists (fun ent -> ent = e.Type.TypeDefinition) + + match e with + | FSharpExprPatterns.Let(_, body) -> chainedConstructors cons body + | FSharpExprPatterns.Sequential(first, _) when isCreated first -> chainedConstructors cons first + | FSharpExprPatterns.Sequential(_, second) -> chainedConstructors cons second + | FSharpExprPatterns.IfThenElse(_, thenExpr, elseExpr) -> + chainedConstructors cons thenExpr @ chainedConstructors cons elseExpr + | FSharpExprPatterns.DecisionTree(_, targets) -> + targets |> List.collect (fun (_, target) -> chainedConstructors cons target) + | ConstructorCall(other, _, _) when other.DeclaringEntity = cons.DeclaringEntity -> [ other ] + | _ -> [] + +let rec private existsInConstructorChain com visited test (cons: FSharpMemberOrFunctionOrValue) = + let hasSource = + cons.DeclaringEntity + |> Option.exists (fun ent -> (FsEnt.Ref ent).SourcePath.IsSome) + + hasSource + && not (List.contains (implementationLocation cons) visited) + && tryFindConstructorBody com cons + |> Option.exists (fun body -> + test body + || chainedConstructors cons body + |> List.exists (existsInConstructorChain com (implementationLocation cons :: visited) test) + ) + +let rec private loadsSelf (e: FSharpExpr) = + match e with + | FSharpExprPatterns.ILAsm(("[I_ldarg 0us]" | "[I_ldarg 0]"), [], []) -> true + | e -> e.ImmediateSubExpressions |> List.exists loadsSelf + +let private constructorBindsSelf (com: IFableCompiler) (cons: FSharpMemberOrFunctionOrValue) = + existsInConstructorChain com [] loadsSelf cons + +let private constructorLeaksSelf (com: IFableCompiler) (cons: FSharpMemberOrFunctionOrValue) = let isSelfCell (e: FSharpExpr) = match e with | FSharpExprPatterns.FSharpFieldGet(Some(FSharpExprPatterns.ThisValue _), _, field) -> field.Name = "contents" @@ -868,60 +946,55 @@ let rec private constructorLeaksSelf (com: IFableCompiler) visited (cons: FSharp | FSharpExprPatterns.ObjectExpr _ -> e.ImmediateSubExpressions |> List.exists (leaksSelf true) | e -> e.ImmediateSubExpressions |> List.exists (leaksSelf inClosure) - let rec tryFindBody decls = - decls - |> List.tryPick ( - function - | FSharpImplementationFileDeclaration.Entity(_, decls) -> tryFindBody decls - | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(memb, _, body) when - implementationLocation memb = consLocation - -> - Some body - | _ -> None - ) - - let decls = - try - com.GetImplementationFile(consLocation.FileName) - with _ -> - [] - - // The constructor this one chains to (`new() = C(1) then ...`) runs first, on the same object - let rec tryChainedConstructor (e: FSharpExpr) = - match e with - | FSharpExprPatterns.Let(_, body) -> tryChainedConstructor body - | FSharpExprPatterns.Sequential(first, _) -> tryChainedConstructor first - | ConstructorCall(other, _, _) when other.DeclaringEntity = cons.DeclaringEntity -> Some other - | _ -> None + existsInConstructorChain com [] (leaksSelf false) cons - let chainedLeaksSelf body = - match tryChainedConstructor body with - | Some other when - implementationLocation other <> consLocation - && not (List.contains (implementationLocation other) visited) - -> - constructorLeaksSelf com (consLocation :: visited) other - | _ -> false +// A base call that reaches the general sequence case is dropped, so neither side can use self +let private checkDroppedBaseCall (com: IFableCompiler) (ctx: Context) (first: FSharpExpr) (second: FSharpExpr) = + match first, ctx.CaptureBaseConsCall, ctx.EnclosingMember with + | ConstructorCall(baseCons, _, _), None, Some m when + m.IsConstructor + && not m.IsImplicitConstructor + && supportsCompilerGeneratedBaseCall com + && ( + match m.DeclaringEntity |> Option.bind tryGetBaseEntity, baseCons.DeclaringEntity with + | Some(baseEnt, _), Some callee -> callee = baseEnt + | _ -> false + ) + -> + let r = makeRangeFrom first - tryFindBody decls - |> Option.exists (fun body -> leaksSelf false body || chainedLeaksSelf body) + if not baseCons.IsImplicitConstructor && constructorBindsSelf com baseCons then + addSelfBaseConstructorError com ctx r baseCons.DeclaringEntity.Value + elif loadsSelf second then + unsupportedSelfConstructorMessage |> addError com ctx.InlinePath r + | _ -> () let private transformBaseCallAndRecord (com: IFableCompiler) (ctx: Context) r (baseCall: FSharpExpr) + (bindings: (FSharpMemberOrFunctionOrValue * FSharpExpr) list) (fsType: FSharpType) (ownArgs: FSharpExpr list) = match baseCall with - | ConstructorCall(baseCons, _, _) when not baseCons.IsImplicitConstructor && constructorLeaksSelf com [] baseCons -> + | ConstructorCall(baseCons, _, _) when not baseCons.IsImplicitConstructor && constructorLeaksSelf com baseCons -> $"%s{fsType.TypeDefinition.FullName} calls a constructor of %s{baseCons.DeclaringEntity.Value.FullName} whose `then` block uses its self identifier for more than reading or setting fields. Fable cannot run that block on the derived instance." |> addError com ctx.InlinePath r | _ -> () trampoline { let! baseValue = transformExpr com ctx [] baseCall + + let ctx, bindings = + ((ctx, []), bindings) + ||> List.fold (fun (ctx, bindings) (var, value) -> + let value = transformExpr com ctx [] value |> run + let ctx, ident = putIdentInScope com ctx var (Some value) + ctx, (ident, value) :: bindings + ) + let! ownArgs = transformExprList com ctx ownArgs let ownArgs = @@ -941,7 +1014,11 @@ let private transformBaseCallAndRecord let newRecord = Fable.NewRecord(inheritedArgs @ ownArgs, entRef, genArgs) |> makeValue r - return Fable.Let(baseIdent, baseValue, newRecord) + let body = + (newRecord, bindings) + ||> List.fold (fun body (ident, value) -> Fable.Let(ident, value, body)) + + return Fable.Let(baseIdent, baseValue, body) } // F# emits `new() = { ... } then body` as sequences nested after the created object, with any base call before it @@ -951,6 +1028,7 @@ let private (|ExplicitConstructorThen|_|) com (ctx: Context) (fsExpr: FSharpExpr m.IsConstructor && not m.IsImplicitConstructor && supportsCompilerGeneratedBaseCall com + && m.DeclaringEntity |> Option.exists (isAttachMembersEntity com >> not) -> let isCreated (e: FSharpExpr) = e.Type.HasTypeDefinition @@ -963,16 +1041,25 @@ let private (|ExplicitConstructorThen|_|) com (ctx: Context) (fsExpr: FSharpExpr created, rest @ [ second ] | _ -> e, [] + let rec splitBound (e: FSharpExpr) = + match e with + | FSharpExprPatterns.Let((var, value, _), body) -> + let bindings, created, rest = splitBound body + (var, value) :: bindings, created, rest + | _ -> + let created, rest = split e + [], created, rest + match fsExpr with | _ when not (isCreated fsExpr) -> None | FSharpExprPatterns.Sequential(ConstructorCall(baseCons, _, _) as baseCall, second) when not (isCreated baseCall) -> - match split second with - | FSharpExprPatterns.NewRecord(fsType, ownArgs), (_ :: _ as rest) when + match splitBound second with + | bindings, FSharpExprPatterns.NewRecord(fsType, ownArgs), (_ :: _ as rest) when isBaseCallOfRecord com ctx baseCons fsType -> - Some(Choice2Of2(baseCall, fsType, ownArgs), rest) + Some(Choice2Of2(baseCall, bindings, fsType, ownArgs), rest) | _ -> None | FSharpExprPatterns.Sequential(first, _) when isCreated first -> let created, rest = split fsExpr @@ -1181,7 +1268,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs return match ctx.BoundConstructorThis with | Some i -> identWithRange r i |> Fable.IdentExpr - | None -> Fable.Value(makeType ctx.GenericArgs fsExpr.Type |> Fable.ThisValue, r) + | None -> unsupportedSelfConstructorMessage |> addErrorAndReturnNull com ctx.InlinePath r | FSharpExprPatterns.Value var -> let r = makeRangeFrom fsExpr @@ -1804,17 +1891,17 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs None args memb | FSharpExprPatterns.Sequential(ConstructorCall(baseCons, _, _) as first, - FSharpExprPatterns.NewRecord(fsType, ownArgs)) when + BoundNewRecord(bindings, fsType, ownArgs)) when isBaseCallOfRecord com ctx baseCons fsType -> - return! transformBaseCallAndRecord com ctx (makeRangeFrom fsExpr) first fsType ownArgs + return! transformBaseCallAndRecord com ctx (makeRangeFrom fsExpr) first bindings fsType ownArgs | ExplicitConstructorThen com ctx (created, rest) when ctx.BoundConstructorThis.IsNone -> let! created = match created with | Choice1Of2 created -> transformExpr com ctx [] created - | Choice2Of2(baseCall, fsType, ownArgs) -> - transformBaseCallAndRecord com ctx (makeRangeFrom fsExpr) baseCall fsType ownArgs + | Choice2Of2(baseCall, bindings, fsType, ownArgs) -> + transformBaseCallAndRecord com ctx (makeRangeFrom fsExpr) baseCall bindings fsType ownArgs let thisIdent = getIdentUniqueName com ctx "this" |> makeTypedIdent created.Type @@ -1824,6 +1911,8 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs return Fable.Let(thisIdent, created, Fable.Sequential(rest @ [ Fable.IdentExpr thisIdent ])) | FSharpExprPatterns.Sequential(first, second) -> + checkDroppedBaseCall com ctx first second + let exprs = match ctx.CaptureBaseConsCall with | Some(baseEnt, captureBaseCall) -> diff --git a/tests/Integration/Compiler/CompilerMessagesTests.fs b/tests/Integration/Compiler/CompilerMessagesTests.fs index 5542000d1..9af1fa979 100644 --- a/tests/Integration/Compiler/CompilerMessagesTests.fs +++ b/tests/Integration/Compiler/CompilerMessagesTests.fs @@ -918,6 +918,145 @@ type Derived = |> Assert.Exists.errorWith "Derived calls a constructor of" |> ignore + testCase "Explicit constructor calling a base constructor that chains to self after a statement results in error" <| fun _ -> + let source = + """ +let reg = ResizeArray() + +type Base = + val N: int + new (n: int) as self = { N = n } then reg.Add(box self) + new () = reg.Add(null); Base(1) + +type Derived = + inherit Base + val X: int + new () = { inherit Base(); X = 1 } +""" + compile source + |> Assert.Exists.errorWith "uses its self identifier" + |> ignore + + testCase "Explicit constructor calling a base constructor that chains to self behind if results in error" <| fun _ -> + let source = + """ +let reg = ResizeArray() + +type Base = + val N: int + new (n: int) as self = { N = n } then reg.Add(box self) + new (flag: bool) = if flag then Base(1) else Base(2) + +type Derived = + inherit Base + val X: int + new () = { inherit Base(true); X = 1 } +""" + compile source + |> Assert.Exists.errorWith "uses its self identifier" + |> ignore + + testCase "Explicit constructor with out of order fields passing self on from its base results in error" <| fun _ -> + let source = + """ +let reg = ResizeArray() + +type Base = + val N: int + new (n: int) as self = { N = n } then reg.Add(box self) + +type Derived = + inherit Base + val Z: int + val W: int + new () = { inherit Base(1); W = 2; Z = 3 } +""" + compile source + |> Assert.Exists.errorWith "uses its self identifier" + |> ignore + + testCase "Explicit constructor with a self identifier over 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 "Explicit constructor with a self identifier over 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 "Explicit constructor with a self identifier and 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 "Primary constructor calling a base constructor 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 "cannot run on a derived instance" + |> ignore + + testCase "Object expression calling a base constructor 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 "cannot run on a derived instance" + |> ignore + + testCase "Explicit constructor calling a secondary self constructor of a primary constructor base 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 "cannot run on a derived instance" + |> ignore + testCase "Explicit constructor calling a base constructor that sets an inherited field on self compiles" <| fun _ -> let source = """ diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index 86c327e9d..8269b11c8 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1005,6 +1005,18 @@ type ValClassSelfChild = val mutable Extra: float new (id: int, extra: float) as this = { inherit ValClassBase(id); Extra = extra } then this.Extra <- this.Extra + float this.Id +type ValClassOutOfOrder = + inherit ValClassBase + val Z: int + val W: int + new (id: int) = { inherit ValClassBase(id); W = 2; Z = 3 } + +type ValClassOutOfOrderSelf = + inherit ValClassBase + val Z: int + val mutable W: int + new (id: int) as self = { inherit ValClassBase(id); W = 2; Z = 3 } then self.W <- self.W + self.Z + self.Id + let tests = testList "Types" [ @@ -2037,6 +2049,12 @@ let tests = c.Count |> equal 4 c.Tag |> equal "t" + testCase "Explicit constructor with a base keeps out of order fields" <| fun () -> + let c = ValClassOutOfOrder(1) + (c.Id, c.Z, c.W) |> equal (10, 3, 2) + let s = ValClassOutOfOrderSelf(1) + (s.Id, s.Z, s.W) |> equal (10, 3, 15) + testCase "Explicit constructor with a self identifier works" <| fun () -> // See #5166 let a = ValClassSelf("abc") a.Name |> equal "abc" diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index 0e84b2b07..b09de0a4f 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2061,6 +2061,25 @@ type ValClassSelfChild = val mutable Extra: float new (id: int, extra: float) as this = { inherit ValClassBase(id); Extra = extra } then this.Extra <- this.Extra + float this.Id +type ValClassOutOfOrder = + inherit ValClassBase + val Z: int + val W: int + new (id: int) = { inherit ValClassBase(id); W = 2; Z = 3 } + +type ValClassOutOfOrderSelf = + inherit ValClassBase + val Z: int + val mutable W: int + new (id: int) as self = { inherit ValClassBase(id); W = 2; Z = 3 } then self.W <- self.W + self.Z + self.Id + +[] +let ``test explicit constructor with a base keeps out of order fields`` () = + let c = ValClassOutOfOrder(1) + (c.Id, c.Z, c.W) |> equal (10, 3, 2) + let s = ValClassOutOfOrderSelf(1) + (s.Id, s.Z, s.W) |> equal (10, 3, 15) + [] let ``test explicit constructor returns the object after its then block`` () = let before = valClassThenCalls From 66fcd4981da8840edd9d98111f4be12eaf289116 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Fri, 6 Nov 2026 21:51:55 +0100 Subject: [PATCH 11/16] fix(js/ts/python): allow base calls in ctor fields --- src/Fable.Transforms/FSharp2Fable.fs | 8 ++++++++ tests/Js/Main/TypeTests.fs | 19 +++++++++++++++++++ tests/Python/TestType.fs | 20 ++++++++++++++++++++ 3 files changed, 47 insertions(+) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 57793cc79..9a2163e16 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -948,6 +948,13 @@ let private constructorLeaksSelf (com: IFableCompiler) (cons: FSharpMemberOrFunc existsInConstructorChain com [] (leaksSelf false) cons +let rec private createsRecord (e: FSharpExpr) = + match e with + | FSharpExprPatterns.NewRecord _ -> true + | FSharpExprPatterns.Let(_, body) -> createsRecord body + | FSharpExprPatterns.Sequential(first, _) -> createsRecord first + | _ -> false + // A base call that reaches the general sequence case is dropped, so neither side can use self let private checkDroppedBaseCall (com: IFableCompiler) (ctx: Context) (first: FSharpExpr) (second: FSharpExpr) = match first, ctx.CaptureBaseConsCall, ctx.EnclosingMember with @@ -960,6 +967,7 @@ let private checkDroppedBaseCall (com: IFableCompiler) (ctx: Context) (first: FS | Some(baseEnt, _), Some callee -> callee = baseEnt | _ -> false ) + && createsRecord second -> let r = makeRangeFrom first diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index 8269b11c8..41da8a11f 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1005,6 +1005,19 @@ type ValClassSelfChild = val mutable Extra: float new (id: int, extra: float) as this = { inherit ValClassBase(id); Extra = extra } then this.Extra <- this.Extra + float this.Id +[] +type ValClassSequenceSelf = + val Next: ValClassSequenceSelf + val Id: int + new (id: int) = { Next = null; Id = id } + new (a: int, b: int, c: int) as self = { Next = (ValClassSequenceSelf(a); ValClassSequenceSelf(b)); Id = c } then self.Next.Id |> ignore + +type ValClassSequenceSelfChild = + inherit ValClassSequenceSelf + val Tail: ValClassSequenceSelf + val mutable Count: int + new (a: int, b: int) as self = { inherit ValClassSequenceSelf(1); Tail = (ValClassSequenceSelf(a); ValClassSequenceSelf(b)); Count = 0 } then self.Count <- self.Tail.Id + type ValClassOutOfOrder = inherit ValClassBase val Z: int @@ -2049,6 +2062,12 @@ let tests = c.Count |> equal 4 c.Tag |> equal "t" + testCase "Explicit constructor keeps sequences of base constructor calls in field values" <| fun () -> + let c = ValClassSequenceSelf(5, 6, 7) + (c.Next.Id, c.Id) |> equal (6, 7) + let d = ValClassSequenceSelfChild(5, 6) + (d.Tail.Id, d.Count, d.Id) |> equal (6, 6, 1) + testCase "Explicit constructor with a base keeps out of order fields" <| fun () -> let c = ValClassOutOfOrder(1) (c.Id, c.Z, c.W) |> equal (10, 3, 2) diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index b09de0a4f..bca28f759 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2061,6 +2061,19 @@ type ValClassSelfChild = val mutable Extra: float new (id: int, extra: float) as this = { inherit ValClassBase(id); Extra = extra } then this.Extra <- this.Extra + float this.Id +[] +type ValClassSequenceSelf = + val Next: ValClassSequenceSelf + val Id: int + new (id: int) = { Next = null; Id = id } + new (a: int, b: int, c: int) as self = { Next = (ValClassSequenceSelf(a); ValClassSequenceSelf(b)); Id = c } then self.Next.Id |> ignore + +type ValClassSequenceSelfChild = + inherit ValClassSequenceSelf + val Tail: ValClassSequenceSelf + val mutable Count: int + new (a: int, b: int) as self = { inherit ValClassSequenceSelf(1); Tail = (ValClassSequenceSelf(a); ValClassSequenceSelf(b)); Count = 0 } then self.Count <- self.Tail.Id + type ValClassOutOfOrder = inherit ValClassBase val Z: int @@ -2073,6 +2086,13 @@ type ValClassOutOfOrderSelf = val mutable W: int new (id: int) as self = { inherit ValClassBase(id); W = 2; Z = 3 } then self.W <- self.W + self.Z + self.Id +[] +let ``test explicit constructor keeps sequences of base constructor calls in field values`` () = + let c = ValClassSequenceSelf(5, 6, 7) + (c.Next.Id, c.Id) |> equal (6, 7) + let d = ValClassSequenceSelfChild(5, 6) + (d.Tail.Id, d.Count, d.Id) |> equal (6, 6, 1) + [] let ``test explicit constructor with a base keeps out of order fields`` () = let c = ValClassOutOfOrder(1) From 2a69b6a8fd61646a03a5d80d88e88ff5c3b18c9d Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Fri, 6 Nov 2026 22:22:30 +0100 Subject: [PATCH 12/16] fix(js/ts/python): catch more self ctor base calls --- src/Fable.Transforms/FSharp2Fable.fs | 21 +++++++--- .../Compiler/CompilerMessagesTests.fs | 21 ++++++++++ .../Compiler/WatchDependencyTests.fs | 32 ++++++++++++++++ .../Integration/CompilationTests.fs | 38 +++++++++++++++++++ .../Integration/data/precompiledLib/App.fs | 5 +++ .../data/precompiledLib/App.jsx.expected | 18 ++++++++- .../data/precompiledLib/library/Library.fs | 5 +++ .../precompiledErrors/selfBase/App.fs | 6 +++ .../selfBase/library/Library.fs | 7 ++++ .../selfBase/library/library.fsproj | 12 ++++++ .../selfBase/selfBase.fsproj | 13 +++++++ 11 files changed, 172 insertions(+), 6 deletions(-) create mode 100644 tests/Integration/Integration/precompiledErrors/selfBase/App.fs create mode 100644 tests/Integration/Integration/precompiledErrors/selfBase/library/Library.fs create mode 100644 tests/Integration/Integration/precompiledErrors/selfBase/library/library.fsproj create mode 100644 tests/Integration/Integration/precompiledErrors/selfBase/selfBase.fsproj diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 9a2163e16..fe2027f30 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -870,7 +870,12 @@ let private tryFindConstructorBody (com: IFableCompiler) (cons: FSharpMemberOrFu with _ -> [] - tryFindBody decls + let body = tryFindBody decls + + if body.IsSome then + com.AddWatchDependency(Path.normalizePathAndEnsureFsExtension consLocation.FileName) + + body // The constructors this one chains to (`new() = C(1) then ...`) run first, on the same object let rec private chainedConstructors (cons: FSharpMemberOrFunctionOrValue) (e: FSharpExpr) = @@ -879,7 +884,8 @@ let rec private chainedConstructors (cons: FSharpMemberOrFunctionOrValue) (e: FS && cons.DeclaringEntity |> Option.exists (fun ent -> ent = e.Type.TypeDefinition) match e with - | FSharpExprPatterns.Let(_, body) -> chainedConstructors cons body + | FSharpExprPatterns.Let(_, body) + | FSharpExprPatterns.LetRec(_, body) -> chainedConstructors cons body | FSharpExprPatterns.Sequential(first, _) when isCreated first -> chainedConstructors cons first | FSharpExprPatterns.Sequential(_, second) -> chainedConstructors cons second | FSharpExprPatterns.IfThenElse(_, thenExpr, elseExpr) -> @@ -894,14 +900,19 @@ let rec private existsInConstructorChain com visited test (cons: FSharpMemberOrF cons.DeclaringEntity |> Option.exists (fun ent -> (FsEnt.Ref ent).SourcePath.IsSome) + // Precompiled libraries keep the `init@` field of a class with a self identifier, but not the constructor body + let mayUseSelf () = + cons.DeclaringEntity + |> Option.exists (fun ent -> ent.FSharpFields |> Seq.exists (fun field -> field.Name.StartsWith("init@"))) + hasSource && not (List.contains (implementationLocation cons) visited) - && tryFindConstructorBody com cons - |> Option.exists (fun body -> + && match tryFindConstructorBody com cons with + | Some body -> test body || chainedConstructors cons body |> List.exists (existsInConstructorChain com (implementationLocation cons :: visited) test) - ) + | None -> mayUseSelf () let rec private loadsSelf (e: FSharpExpr) = match e with diff --git a/tests/Integration/Compiler/CompilerMessagesTests.fs b/tests/Integration/Compiler/CompilerMessagesTests.fs index 9af1fa979..b58a22699 100644 --- a/tests/Integration/Compiler/CompilerMessagesTests.fs +++ b/tests/Integration/Compiler/CompilerMessagesTests.fs @@ -956,6 +956,27 @@ type Derived = |> Assert.Exists.errorWith "uses its self identifier" |> ignore + testCase "Explicit constructor calling a base constructor that chains to self behind let rec results in error" <| fun _ -> + let source = + """ +let reg = ResizeArray() + +type Base = + val N: int + new (n: int) as self = { N = n } then reg.Add(box self) + new () = + let rec f x = if x > 0 then f (x - 1) else 1 + Base(f 1) + +type Derived = + inherit Base + val X: int + new () = { inherit Base(); X = 1 } +""" + compile source + |> Assert.Exists.errorWith "uses its self identifier" + |> ignore + testCase "Explicit constructor with out of order fields passing self on from its base results in error" <| fun _ -> let source = """ diff --git a/tests/Integration/Compiler/WatchDependencyTests.fs b/tests/Integration/Compiler/WatchDependencyTests.fs index d35d4bd84..b913e89ae 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 d1bc6070b..1f3249575 100644 --- a/tests/Integration/Integration/CompilationTests.fs +++ b/tests/Integration/Integration/CompilationTests.fs @@ -56,6 +56,43 @@ let private checkBrowserInlineExprs (precompiledDir: string) = (Fable.BrowserInlineExprs.toString [| name, fromCompact |]) $"%s{name} differs between the two copies" +let private precompiledSelfBaseTest = + testCaseAsync + "Inheriting a precompiled constructor with a self identifier is an error" + (async { + let testCaseDir = Path.Combine(__SOURCE_DIRECTORY__, "precompiledErrors", "selfBase") + let libraryProject = Path.Combine(testCaseDir, "library", "library.fsproj") + let project = Path.Combine(testCaseDir, "selfBase.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 + |] + + 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 +166,5 @@ let tests = })) |> Seq.toList + |> List.append [ precompiledSelfBaseTest ] |> testList "Compilation" diff --git a/tests/Integration/Integration/data/precompiledLib/App.fs b/tests/Integration/Integration/data/precompiledLib/App.fs index a5fbc031f..fddc10570 100644 --- a/tests/Integration/Integration/data/precompiledLib/App.fs +++ b/tests/Integration/Integration/data/precompiledLib/App.fs @@ -4,3 +4,8 @@ let greeting = Library.greeting "world" let doubled = Library.double 21 let plain = Library.plain 1 let circles = Library.circles [ Library.Circle 1.0; Library.Square 2.0 ] + +type PlainValChild = + inherit Library.PlainVal + val M: int + new () = { inherit Library.PlainVal(1); M = 2 } diff --git a/tests/Integration/Integration/data/precompiledLib/App.jsx.expected b/tests/Integration/Integration/data/precompiledLib/App.jsx.expected index 48ca2adfd..77c69e24e 100644 --- a/tests/Integration/Integration/data/precompiledLib/App.jsx.expected +++ b/tests/Integration/Integration/data/precompiledLib/App.jsx.expected @@ -1,6 +1,7 @@ -import { Shape, circles as circles_1, plain as plain_1 } from "./precompiled/Library.js"; +import { PlainVal_$ctor_Z524259A4, PlainVal_$reflection, PlainVal, Shape, circles as circles_1, plain as plain_1 } from "./precompiled/Library.js"; import { ofArray } from "./precompiled/fable_modules/fable-library-js.5.21.0/List.js"; +import { class_type } from "./precompiled/fable_modules/fable-library-js.5.21.0/Reflection.js"; export const greeting = { Greet(helpers) { @@ -14,3 +15,18 @@ export const plain = plain_1(1); export const circles = circles_1(ofArray([new Shape(/* Circle */ 0, [1]), new Shape(/* Square */ 1, [2])])); +export class PlainValChild extends PlainVal { + constructor(N, M) { + super(N); + this.M = (M | 0); + } +} + +export function PlainValChild_$reflection() { + return class_type("App.PlainValChild", undefined, PlainValChild, PlainVal_$reflection()); +} + +export function PlainValChild_$ctor() { + const base = PlainVal_$ctor_Z524259A4(1); + return new PlainValChild(base.N, 2); +} diff --git a/tests/Integration/Integration/data/precompiledLib/library/Library.fs b/tests/Integration/Integration/data/precompiledLib/library/Library.fs index fbada775b..b63ee57ca 100644 --- a/tests/Integration/Integration/data/precompiledLib/library/Library.fs +++ b/tests/Integration/Integration/data/precompiledLib/library/Library.fs @@ -22,3 +22,8 @@ type Shape = /// Regression shape: F# 9 union case testers, which the F# compiler emits as IL helpers let circles (shapes: Shape list) = shapes |> List.filter (fun shape -> shape.IsCircle) + +/// Regression shape: a class without a self identifier stays inheritable when its constructor body is precompiled +type PlainVal = + val N: int + new (n: int) = { N = n } diff --git a/tests/Integration/Integration/precompiledErrors/selfBase/App.fs b/tests/Integration/Integration/precompiledErrors/selfBase/App.fs new file mode 100644 index 000000000..1b320a101 --- /dev/null +++ b/tests/Integration/Integration/precompiledErrors/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/precompiledErrors/selfBase/library/Library.fs b/tests/Integration/Integration/precompiledErrors/selfBase/library/Library.fs new file mode 100644 index 000000000..f52050884 --- /dev/null +++ b/tests/Integration/Integration/precompiledErrors/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/precompiledErrors/selfBase/library/library.fsproj b/tests/Integration/Integration/precompiledErrors/selfBase/library/library.fsproj new file mode 100644 index 000000000..6fc5f67a9 --- /dev/null +++ b/tests/Integration/Integration/precompiledErrors/selfBase/library/library.fsproj @@ -0,0 +1,12 @@ + + + net10.0 + Major + + + + + + + + diff --git a/tests/Integration/Integration/precompiledErrors/selfBase/selfBase.fsproj b/tests/Integration/Integration/precompiledErrors/selfBase/selfBase.fsproj new file mode 100644 index 000000000..912d3e71a --- /dev/null +++ b/tests/Integration/Integration/precompiledErrors/selfBase/selfBase.fsproj @@ -0,0 +1,13 @@ + + + net10.0 + Major + + + + + + + + + From 76a1db7deef964192cf33df1cd761f9b4a5a885d Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Sat, 7 Nov 2026 00:00:06 +0100 Subject: [PATCH 13/16] fix(js/ts/python): limit self ctors to no base --- src/Fable.Transforms/Babel/Fable2Babel.fs | 22 +- src/Fable.Transforms/FSharp2Fable.fs | 329 +++-------- .../Compiler/CompilerMessagesTests.fs | 513 +++++++----------- .../Integration/CompilationTests.fs | 2 +- .../Integration/data/precompiledLib/App.fs | 5 - .../data/precompiledLib/App.jsx.expected | 18 +- .../data/precompiledLib/library/Library.fs | 5 - tests/Js/Main/TypeTests.fs | 61 +-- tests/Python/TestType.fs | 64 +-- 9 files changed, 286 insertions(+), 733 deletions(-) diff --git a/src/Fable.Transforms/Babel/Fable2Babel.fs b/src/Fable.Transforms/Babel/Fable2Babel.fs index 8e139dafa..5582a9ae2 100644 --- a/src/Fable.Transforms/Babel/Fable2Babel.fs +++ b/src/Fable.Transforms/Babel/Fable2Babel.fs @@ -4511,26 +4511,8 @@ but thanks to the optimisation done below we get ent.BaseType |> Option.map (fun d -> Fable.DeclaredType(d.Entity, d.GenericArgs)) - // Inherited fields are passed by their F# names, which can be compiler-generated like `init@5` - let baseCall = - decl.BaseCall - |> Option.map ( - function - | Fable.Call(callee, info, t, r) -> - let args = - info.Args - |> List.map ( - function - | Fable.IdentExpr id -> Fable.IdentExpr { id with Name = sanitizeName id.Name } - | arg -> arg - ) - - Fable.Call(callee, { info with Args = args }, t, r) - | baseCall -> baseCall - ) - - match extractSuperClassFromBaseCall com ctx baseType baseCall with - | Some(baseExpr, superArgs) -> Some baseExpr, superArgs, baseCallIdents baseCall + match extractSuperClassFromBaseCall com ctx baseType decl.BaseCall with + | Some(baseExpr, superArgs) -> Some baseExpr, superArgs, baseCallIdents decl.BaseCall | None -> None, [], [||] let body = diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index fe2027f30..ab1fe9cf2 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -21,13 +21,6 @@ let private transformExprList com ctx xs = let private transformExprOpt com ctx opt = trampolineOptionMap (transformExpr com ctx []) opt -let private unsupportedSelfConstructorMessage = - "This explicit constructor uses a self identifier (`new() as x`), which Fable only supports on JavaScript, TypeScript and Python, in a class without [] whose base class, if any, is an F# class without a primary constructor." - -let private addSelfBaseConstructorError (com: IFableCompiler) (ctx: Context) r (baseEnt: FSharpEntity) = - $"%s{baseEnt.FullName} has a constructor with a self identifier (`new() as x`), which Fable cannot run on a derived instance here." - |> addError com ctx.InlinePath r - let private transformBaseConsCall com ctx @@ -50,10 +43,7 @@ let private transformBaseConsCall makeCall r Fable.Unit callInfo baseRef | None -> if not baseCons.IsImplicitConstructor then - if constructorBindsSelf com baseCons then - addSelfBaseConstructorError com ctx r baseEnt - else - WarningCodes.nonPrimaryBaseConstructor |> addWarningWithCode com [] r + WarningCodes.nonPrimaryBaseConstructor |> addWarningWithCode com [] r match makeCallFrom com ctx r Fable.Unit genArgs None baseArgs baseCons with | Fable.Call(_baseExpr, info, t, r) when not (com.Options.Language = Rust) -> @@ -535,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 @@ -802,13 +793,6 @@ let rec private transformDecisionTargets return! transformDecisionTargets com ctx ((idents, expr) :: acc) tail } -// F# binds record fields written out of declaration order before creating the record -let rec private (|BoundNewRecord|_|) (e: FSharpExpr) = - match e with - | FSharpExprPatterns.NewRecord(fsType, args) -> Some([], fsType, args) - | FSharpExprPatterns.Let((var, value, _), BoundNewRecord(bindings, fsType, args)) -> - Some((var, value) :: bindings, fsType, args) - | _ -> None // 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) = @@ -834,220 +818,61 @@ let private withOmittedFieldDefaults (com: IFableCompiler) (ctx: Context) (fsTyp else args -let private isBaseCallOfRecord com (ctx: Context) (baseCons: FSharpMemberOrFunctionOrValue) (fsType: FSharpType) = - ctx.CaptureBaseConsCall.IsNone - && supportsCompilerGeneratedBaseCall com - && fsType.HasTypeDefinition - && ( - match baseCons.DeclaringEntity, tryGetBaseEntity fsType.TypeDefinition with - | Some callee, Some(baseEnt, _) -> callee = baseEnt - | _ -> false - ) - && (tryGetCompilerGeneratedBases fsType.TypeDefinition - |> Option.exists (List.isEmpty >> not)) - -let private implementationLocation (memb: FSharpMemberOrFunctionOrValue) = - memb.ImplementationLocation |> Option.defaultValue memb.DeclarationLocation - -let private tryFindConstructorBody (com: IFableCompiler) (cons: FSharpMemberOrFunctionOrValue) = - let consLocation = implementationLocation cons - - let rec tryFindBody decls = - decls - |> List.tryPick ( - function - | FSharpImplementationFileDeclaration.Entity(_, decls) -> tryFindBody decls - | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(memb, _, body) when - implementationLocation memb = consLocation - -> - Some body - | _ -> None - ) - - let decls = - try - com.GetImplementationFile(consLocation.FileName) - with _ -> - [] - - let body = tryFindBody decls - - if body.IsSome then - com.AddWatchDependency(Path.normalizePathAndEnsureFsExtension consLocation.FileName) - - body - -// The constructors this one chains to (`new() = C(1) then ...`) run first, on the same object -let rec private chainedConstructors (cons: FSharpMemberOrFunctionOrValue) (e: FSharpExpr) = - let isCreated (e: FSharpExpr) = - e.Type.HasTypeDefinition - && cons.DeclaringEntity |> Option.exists (fun ent -> ent = e.Type.TypeDefinition) - - match e with - | FSharpExprPatterns.Let(_, body) - | FSharpExprPatterns.LetRec(_, body) -> chainedConstructors cons body - | FSharpExprPatterns.Sequential(first, _) when isCreated first -> chainedConstructors cons first - | FSharpExprPatterns.Sequential(_, second) -> chainedConstructors cons second - | FSharpExprPatterns.IfThenElse(_, thenExpr, elseExpr) -> - chainedConstructors cons thenExpr @ chainedConstructors cons elseExpr - | FSharpExprPatterns.DecisionTree(_, targets) -> - targets |> List.collect (fun (_, target) -> chainedConstructors cons target) - | ConstructorCall(other, _, _) when other.DeclaringEntity = cons.DeclaringEntity -> [ other ] - | _ -> [] - -let rec private existsInConstructorChain com visited test (cons: FSharpMemberOrFunctionOrValue) = - let hasSource = - cons.DeclaringEntity - |> Option.exists (fun ent -> (FsEnt.Ref ent).SourcePath.IsSome) - - // Precompiled libraries keep the `init@` field of a class with a self identifier, but not the constructor body - let mayUseSelf () = - cons.DeclaringEntity - |> Option.exists (fun ent -> ent.FSharpFields |> Seq.exists (fun field -> field.Name.StartsWith("init@"))) - - hasSource - && not (List.contains (implementationLocation cons) visited) - && match tryFindConstructorBody com cons with - | Some body -> - test body - || chainedConstructors cons body - |> List.exists (existsInConstructorChain com (implementationLocation cons :: visited) test) - | None -> mayUseSelf () - let rec private loadsSelf (e: FSharpExpr) = match e with | FSharpExprPatterns.ILAsm(("[I_ldarg 0us]" | "[I_ldarg 0]"), [], []) -> true | e -> e.ImmediateSubExpressions |> List.exists loadsSelf -let private constructorBindsSelf (com: IFableCompiler) (cons: FSharpMemberOrFunctionOrValue) = - existsInConstructorChain com [] loadsSelf cons - -let private constructorLeaksSelf (com: IFableCompiler) (cons: FSharpMemberOrFunctionOrValue) = - let isSelfCell (e: FSharpExpr) = - match e with - | FSharpExprPatterns.FSharpFieldGet(Some(FSharpExprPatterns.ThisValue _), _, field) -> field.Name = "contents" - | _ -> false - - // F# reads the `x` of `new() as x` as `CheckThis(x.contents)` - let rec isSelf (e: FSharpExpr) = - match e with - | FSharpExprPatterns.Coerce(_, inner) -> isSelf inner - | FSharpExprPatterns.Call(None, memb, _, _, [ arg ]) when memb.CompiledName = "CheckThis" -> isSelfCell arg - | e -> isSelfCell e - - // The base fields are copied to the derived instance after `then`, so field reads and writes on self stay correct - // unless a closure performs them later - let rec leaksSelf inClosure (e: FSharpExpr) = - match e with - | FSharpExprPatterns.FSharpFieldSet(Some(FSharpExprPatterns.ThisValue _), _, field, FSharpExprPatterns.ILAsm _) when - field.Name = "contents" - -> - false - | FSharpExprPatterns.FSharpFieldSet(Some(FSharpExprPatterns.ILAsm _), _, _, value) -> leaksSelf inClosure value - | FSharpExprPatterns.FSharpFieldGet(Some target, _, _) when isSelf target -> inClosure - | FSharpExprPatterns.FSharpFieldSet(Some target, _, _, value) when isSelf target -> - inClosure || leaksSelf inClosure value - | e when isSelf e -> true - | FSharpExprPatterns.ILAsm(("[I_ldarg 0us]" | "[I_ldarg 0]"), [], []) -> true - // FCS gives the body of an integer `for` loop as a lambda over the loop variable - | FSharpExprPatterns.FastIntegerForLoop(start, limit, FSharpExprPatterns.Lambda(_, body), _, _, _) -> - [ start; limit; body ] |> List.exists (leaksSelf inClosure) - | FSharpExprPatterns.Lambda _ - | FSharpExprPatterns.NewDelegate _ - | FSharpExprPatterns.ObjectExpr _ -> e.ImmediateSubExpressions |> List.exists (leaksSelf true) - | e -> e.ImmediateSubExpressions |> List.exists (leaksSelf inClosure) - - existsInConstructorChain com [] (leaksSelf false) cons - -let rec private createsRecord (e: FSharpExpr) = - match e with - | FSharpExprPatterns.NewRecord _ -> true - | FSharpExprPatterns.Let(_, body) -> createsRecord body - | FSharpExprPatterns.Sequential(first, _) -> createsRecord first - | _ -> false - -// A base call that reaches the general sequence case is dropped, so neither side can use self -let private checkDroppedBaseCall (com: IFableCompiler) (ctx: Context) (first: FSharpExpr) (second: FSharpExpr) = - match first, ctx.CaptureBaseConsCall, ctx.EnclosingMember with - | ConstructorCall(baseCons, _, _), None, Some m when - m.IsConstructor - && not m.IsImplicitConstructor - && supportsCompilerGeneratedBaseCall com - && ( - match m.DeclaringEntity |> Option.bind tryGetBaseEntity, baseCons.DeclaringEntity with - | Some(baseEnt, _), Some callee -> callee = baseEnt - | _ -> false - ) - && createsRecord second - -> - let r = makeRangeFrom first - - if not baseCons.IsImplicitConstructor && constructorBindsSelf com baseCons then - addSelfBaseConstructorError com ctx r baseCons.DeclaringEntity.Value - elif loadsSelf second then - unsupportedSelfConstructorMessage |> addError com ctx.InlinePath r - | _ -> () - -let private transformBaseCallAndRecord - (com: IFableCompiler) - (ctx: Context) - r - (baseCall: FSharpExpr) - (bindings: (FSharpMemberOrFunctionOrValue * FSharpExpr) list) - (fsType: FSharpType) - (ownArgs: FSharpExpr list) - = - match baseCall with - | ConstructorCall(baseCons, _, _) when not baseCons.IsImplicitConstructor && constructorLeaksSelf com baseCons -> - $"%s{fsType.TypeDefinition.FullName} calls a constructor of %s{baseCons.DeclaringEntity.Value.FullName} whose `then` block uses its self identifier for more than reading or setting fields. Fable cannot run that block on the derived instance." - |> addError com ctx.InlinePath r - | _ -> () +let private hasSelfConstructor (com: IFableCompiler) (ent: FSharpEntity) = + let hasExplicitConstructor = + ent.MembersFunctionsAndValues + |> Seq.exists (fun memb -> memb.IsConstructor && not memb.IsImplicitConstructor) - trampoline { - let! baseValue = transformExpr com ctx [] baseCall - - let ctx, bindings = - ((ctx, []), bindings) - ||> List.fold (fun (ctx, bindings) (var, value) -> - let value = transformExpr com ctx [] value |> run - let ctx, ident = putIdentInScope com ctx var (Some value) - ctx, (ident, value) :: bindings + if (FsEnt.Ref ent).SourcePath.IsNone || 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 + && memb.DeclaringEntity + |> Option.exists (fun declaring -> declaring.TryFullName = ent.TryFullName) + && loadsSelf body + | FSharpImplementationFileDeclaration.InitAction _ -> false ) - let! ownArgs = transformExprList com ctx ownArgs - - let ownArgs = - withDefaultValueFields com ctx fsType ownArgs - |> withOmittedFieldDefaults com ctx fsType - - let baseIdent = getIdentUniqueName com ctx "base" |> makeTypedIdent baseValue.Type - - let inheritedArgs = - getInheritedValFields fsType.TypeDefinition ctx.GenericArgs - |> List.map (fun (field, typ) -> getFieldWith None typ (Fable.IdentExpr baseIdent) field.Name) - - let genArgs = makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType) - let entRef = FsEnt.Ref fsType.TypeDefinition - entRef.SourcePath |> Option.iter com.AddSignatureDependency - - let newRecord = - Fable.NewRecord(inheritedArgs @ ownArgs, entRef, genArgs) |> makeValue r + let decls = + try + Some(com.GetImplementationFile(file)) + with _ -> + None - let body = - (newRecord, bindings) - ||> List.fold (fun body (ident, value) -> Fable.Let(ident, value, body)) + 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 -> field.Name.StartsWith("init@")) - return Fable.Let(baseIdent, baseValue, body) - } +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, with any base call before it +// 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 (isAttachMembersEntity com >> not) + && m.DeclaringEntity + |> Option.exists (fun ent -> (tryGetBaseEntity ent).IsNone && not (isAttachMembersEntity com ent)) -> let isCreated (e: FSharpExpr) = e.Type.HasTypeDefinition @@ -1060,29 +885,8 @@ let private (|ExplicitConstructorThen|_|) com (ctx: Context) (fsExpr: FSharpExpr created, rest @ [ second ] | _ -> e, [] - let rec splitBound (e: FSharpExpr) = - match e with - | FSharpExprPatterns.Let((var, value, _), body) -> - let bindings, created, rest = splitBound body - (var, value) :: bindings, created, rest - | _ -> - let created, rest = split e - [], created, rest - match fsExpr with - | _ when not (isCreated fsExpr) -> None - | FSharpExprPatterns.Sequential(ConstructorCall(baseCons, _, _) as baseCall, second) when - not (isCreated baseCall) - -> - match splitBound second with - | bindings, FSharpExprPatterns.NewRecord(fsType, ownArgs), (_ :: _ as rest) when - isBaseCallOfRecord com ctx baseCons fsType - -> - Some(Choice2Of2(baseCall, bindings, fsType, ownArgs), rest) - | _ -> None - | FSharpExprPatterns.Sequential(first, _) when isCreated first -> - let created, rest = split fsExpr - Some(Choice1Of2 created, rest) + | FSharpExprPatterns.Sequential(first, _) when isCreated fsExpr && isCreated first -> Some(split fsExpr) | _ -> None | _ -> None @@ -1287,7 +1091,9 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs return match ctx.BoundConstructorThis with | Some i -> identWithRange r i |> Fable.IdentExpr - | None -> unsupportedSelfConstructorMessage |> addErrorAndReturnNull com ctx.InlinePath r + | 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 @@ -1910,18 +1716,40 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs None args memb | FSharpExprPatterns.Sequential(ConstructorCall(baseCons, _, _) as first, - BoundNewRecord(bindings, fsType, ownArgs)) when - isBaseCallOfRecord com ctx baseCons fsType + FSharpExprPatterns.NewRecord(fsType, ownArgs)) when + ctx.CaptureBaseConsCall.IsNone + && supportsCompilerGeneratedBaseCall com + && fsType.HasTypeDefinition + && ( + match baseCons.DeclaringEntity, tryGetBaseEntity fsType.TypeDefinition with + | Some callee, Some(baseEnt, _) -> callee = baseEnt + | _ -> false + ) + && (tryGetCompilerGeneratedBases fsType.TypeDefinition + |> Option.exists (List.isEmpty >> not)) -> - return! transformBaseCallAndRecord com ctx (makeRangeFrom fsExpr) first bindings fsType ownArgs + let r = makeRangeFrom fsExpr + let! baseValue = transformExpr com ctx [] first + let! ownArgs = transformExprList com ctx ownArgs + let ownArgs = withDefaultValueFields com ctx fsType ownArgs - | ExplicitConstructorThen com ctx (created, rest) when ctx.BoundConstructorThis.IsNone -> - let! created = - match created with - | Choice1Of2 created -> transformExpr com ctx [] created - | Choice2Of2(baseCall, bindings, fsType, ownArgs) -> - transformBaseCallAndRecord com ctx (makeRangeFrom fsExpr) baseCall bindings fsType ownArgs + let baseIdent = getIdentUniqueName com ctx "base" |> makeTypedIdent baseValue.Type + + let inheritedArgs = + getInheritedValFields fsType.TypeDefinition ctx.GenericArgs + |> List.map (fun (field, typ) -> getFieldWith None typ (Fable.IdentExpr baseIdent) field.Name) + let genArgs = makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType) + let entRef = FsEnt.Ref fsType.TypeDefinition + entRef.SourcePath |> Option.iter com.AddSignatureDependency + + let newRecord = + Fable.NewRecord(inheritedArgs @ ownArgs, entRef, genArgs) |> makeValue r + + 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 = @@ -1930,8 +1758,6 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs return Fable.Let(thisIdent, created, Fable.Sequential(rest @ [ Fable.IdentExpr thisIdent ])) | FSharpExprPatterns.Sequential(first, second) -> - checkDroppedBaseCall com ctx first second - let exprs = match ctx.CaptureBaseConsCall with | Some(baseEnt, captureBaseCall) -> @@ -2750,6 +2576,11 @@ let rec private transformDeclarations (com: FableCompiler) ctx fsDecls = checkInlinedTaggedUnionCases com ctx fsEnt warnDuplicateCompiledNames com ctx fsEnt + 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 b58a22699..e781a7502 100644 --- a/tests/Integration/Compiler/CompilerMessagesTests.fs +++ b/tests/Integration/Compiler/CompilerMessagesTests.fs @@ -21,6 +21,194 @@ 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 "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 @@ -862,331 +1050,6 @@ type AuthState = | One of string let one = AuthState.One "a" -""" - compile source - |> Assert.Is.strictSuccess - |> ignore - - testCase "Explicit constructor calling a base constructor that passes self on after then results in error" <| fun _ -> - let source = - """ -type Base = - val Name: string - new (name: string) as self = { Name = name } then printfn "%O" (box self) - -type Derived = - inherit Base - val X: int - new () = { inherit Base("d"); X = 1 } -""" - compile source - |> Assert.Exists.errorWith "Derived calls a constructor of" - |> ignore - - testCase "Explicit constructor calling a base constructor that chains to one passing self on results in error" <| fun _ -> - let source = - """ -type Base = - val Name: string - new (name: string) as self = { Name = name } then printfn "%O" (box self) - new () = Base("x") - -type Derived = - inherit Base - val X: int - new () = { inherit Base(); X = 1 } -""" - compile source - |> Assert.Exists.errorWith "uses its self identifier" - |> ignore - - testCase "Explicit constructor calling a base constructor that captures self in a closure results in error" <| fun _ -> - let source = - """ -let getters = ResizeArray int>() - -type Base = - val mutable Count: int - new (c: int) as self = { Count = c } then getters.Add(fun () -> self.Count) - -type Derived = - inherit Base - val X: int - new () = { inherit Base(5); X = 1 } -""" - compile source - |> Assert.Exists.errorWith "Derived calls a constructor of" - |> ignore - - testCase "Explicit constructor calling a base constructor that chains to self after a statement results in error" <| fun _ -> - let source = - """ -let reg = ResizeArray() - -type Base = - val N: int - new (n: int) as self = { N = n } then reg.Add(box self) - new () = reg.Add(null); Base(1) - -type Derived = - inherit Base - val X: int - new () = { inherit Base(); X = 1 } -""" - compile source - |> Assert.Exists.errorWith "uses its self identifier" - |> ignore - - testCase "Explicit constructor calling a base constructor that chains to self behind if results in error" <| fun _ -> - let source = - """ -let reg = ResizeArray() - -type Base = - val N: int - new (n: int) as self = { N = n } then reg.Add(box self) - new (flag: bool) = if flag then Base(1) else Base(2) - -type Derived = - inherit Base - val X: int - new () = { inherit Base(true); X = 1 } -""" - compile source - |> Assert.Exists.errorWith "uses its self identifier" - |> ignore - - testCase "Explicit constructor calling a base constructor that chains to self behind let rec results in error" <| fun _ -> - let source = - """ -let reg = ResizeArray() - -type Base = - val N: int - new (n: int) as self = { N = n } then reg.Add(box self) - new () = - let rec f x = if x > 0 then f (x - 1) else 1 - Base(f 1) - -type Derived = - inherit Base - val X: int - new () = { inherit Base(); X = 1 } -""" - compile source - |> Assert.Exists.errorWith "uses its self identifier" - |> ignore - - testCase "Explicit constructor with out of order fields passing self on from its base results in error" <| fun _ -> - let source = - """ -let reg = ResizeArray() - -type Base = - val N: int - new (n: int) as self = { N = n } then reg.Add(box self) - -type Derived = - inherit Base - val Z: int - val W: int - new () = { inherit Base(1); W = 2; Z = 3 } -""" - compile source - |> Assert.Exists.errorWith "uses its self identifier" - |> ignore - - testCase "Explicit constructor with a self identifier over 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 "Explicit constructor with a self identifier over 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 "Explicit constructor with a self identifier and 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 "Primary constructor calling a base constructor 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 "cannot run on a derived instance" - |> ignore - - testCase "Object expression calling a base constructor 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 "cannot run on a derived instance" - |> ignore - - testCase "Explicit constructor calling a secondary self constructor of a primary constructor base 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 "cannot run on a derived instance" - |> ignore - - testCase "Explicit constructor calling a base constructor that sets an inherited field on self compiles" <| fun _ -> - let source = - """ -type Root = - val mutable Id: int - new (id: int) = { Id = id } - -type Base = - inherit Root - val mutable Extra: int - new (id: int) as self = { inherit Root(id); Extra = 0 } then self.Id <- self.Id * 10 - -type Derived = - inherit Base - val X: int - new () = { inherit Base(3); X = 1 } -""" - compile source - |> Assert.Is.strictSuccess - |> ignore - - testCase "Explicit constructor calling a base constructor that sets fields on self in a for loop compiles" <| fun _ -> - let source = - """ -type Base = - val mutable Count: int - new (c: int) as self = { Count = c } then - for i = 1 to 3 do self.Count <- self.Count + i - -type Derived = - inherit Base - val X: int - new () = { inherit Base(5); X = 1 } -""" - compile source - |> Assert.Is.strictSuccess - |> ignore - - testCase "Explicit constructor calling a base constructor that passes self to another constructor results in error" <| fun _ -> - let source = - """ -let registry = ResizeArray() - -type Base = - val V: int - val Parent: obj - new (o: obj) = { V = 1; Parent = o } - new () as self = { V = 0; Parent = null } then registry.Add(Base(box self)) - -type Derived = - inherit Base - val W: int - new () = { inherit Base(); W = 1 } -""" - compile source - |> Assert.Exists.errorWith "Derived calls a constructor of" - |> ignore - - testCase "Explicit constructor calling a base constructor that builds another instance of its type compiles" <| fun _ -> - let source = - """ -let registry = ResizeArray() - -type Base = - val V: int - new (x: int) as self = { V = x } then registry.Add(box self) - new () = { V = 0 } then Base(1) |> ignore - -type Derived = - inherit Base - val W: int - new () = { inherit Base(); W = 1 } -""" - compile source - |> Assert.Is.strictSuccess - |> ignore - - testCase "Explicit constructor calling mutually recursive base constructors compiles" <| fun _ -> - let source = - """ -type Base = - val V: int - new (x: int) = Base() - new () = Base(1) - new (x: string) = { V = 0 } - -type Derived = - inherit Base - val W: int - new () = { inherit Base(); W = 1 } -""" - compile source - |> Assert.Is.strictSuccess - |> ignore - - testCase "Explicit constructor calling a base constructor that only sets fields on self compiles" <| fun _ -> - let source = - """ -type Base = - val Name: string - val mutable Count: int - new (name: string) as self = { Name = name; Count = 0 } then self.Count <- self.Name.Length - new () = { Name = "plain"; Count = 0 } then printfn "plain" - -type Derived = - inherit Base - val X: int - new () = { inherit Base("d"); X = 1 } - new (x: int) = { inherit Base(); X = x } """ compile source |> Assert.Is.strictSuccess diff --git a/tests/Integration/Integration/CompilationTests.fs b/tests/Integration/Integration/CompilationTests.fs index 1f3249575..813096844 100644 --- a/tests/Integration/Integration/CompilationTests.fs +++ b/tests/Integration/Integration/CompilationTests.fs @@ -58,7 +58,7 @@ let private checkBrowserInlineExprs (precompiledDir: string) = let private precompiledSelfBaseTest = testCaseAsync - "Inheriting a precompiled constructor with a self identifier is an error" + "Inheriting a precompiled class with a self identifier is an error" (async { let testCaseDir = Path.Combine(__SOURCE_DIRECTORY__, "precompiledErrors", "selfBase") let libraryProject = Path.Combine(testCaseDir, "library", "library.fsproj") diff --git a/tests/Integration/Integration/data/precompiledLib/App.fs b/tests/Integration/Integration/data/precompiledLib/App.fs index fddc10570..a5fbc031f 100644 --- a/tests/Integration/Integration/data/precompiledLib/App.fs +++ b/tests/Integration/Integration/data/precompiledLib/App.fs @@ -4,8 +4,3 @@ let greeting = Library.greeting "world" let doubled = Library.double 21 let plain = Library.plain 1 let circles = Library.circles [ Library.Circle 1.0; Library.Square 2.0 ] - -type PlainValChild = - inherit Library.PlainVal - val M: int - new () = { inherit Library.PlainVal(1); M = 2 } diff --git a/tests/Integration/Integration/data/precompiledLib/App.jsx.expected b/tests/Integration/Integration/data/precompiledLib/App.jsx.expected index 77c69e24e..48ca2adfd 100644 --- a/tests/Integration/Integration/data/precompiledLib/App.jsx.expected +++ b/tests/Integration/Integration/data/precompiledLib/App.jsx.expected @@ -1,7 +1,6 @@ -import { PlainVal_$ctor_Z524259A4, PlainVal_$reflection, PlainVal, Shape, circles as circles_1, plain as plain_1 } from "./precompiled/Library.js"; +import { Shape, circles as circles_1, plain as plain_1 } from "./precompiled/Library.js"; import { ofArray } from "./precompiled/fable_modules/fable-library-js.5.21.0/List.js"; -import { class_type } from "./precompiled/fable_modules/fable-library-js.5.21.0/Reflection.js"; export const greeting = { Greet(helpers) { @@ -15,18 +14,3 @@ export const plain = plain_1(1); export const circles = circles_1(ofArray([new Shape(/* Circle */ 0, [1]), new Shape(/* Square */ 1, [2])])); -export class PlainValChild extends PlainVal { - constructor(N, M) { - super(N); - this.M = (M | 0); - } -} - -export function PlainValChild_$reflection() { - return class_type("App.PlainValChild", undefined, PlainValChild, PlainVal_$reflection()); -} - -export function PlainValChild_$ctor() { - const base = PlainVal_$ctor_Z524259A4(1); - return new PlainValChild(base.N, 2); -} diff --git a/tests/Integration/Integration/data/precompiledLib/library/Library.fs b/tests/Integration/Integration/data/precompiledLib/library/Library.fs index b63ee57ca..fbada775b 100644 --- a/tests/Integration/Integration/data/precompiledLib/library/Library.fs +++ b/tests/Integration/Integration/data/precompiledLib/library/Library.fs @@ -22,8 +22,3 @@ type Shape = /// Regression shape: F# 9 union case testers, which the F# compiler emits as IL helpers let circles (shapes: Shape list) = shapes |> List.filter (fun shape -> shape.IsCircle) - -/// Regression shape: a class without a self identifier stays inheritable when its constructor body is precompiled -type PlainVal = - val N: int - new (n: int) = { N = n } diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index 41da8a11f..c713ce63b 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -988,6 +988,7 @@ type ValClassSequenceInit = 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 @@ -995,40 +996,10 @@ type ValClassSelf = 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 ValClassSelfInherited = - inherit ValClassSelf - val Tag: string - new () = { inherit ValClassSelf("abcd"); Tag = "t" } - -type ValClassSelfChild = - inherit ValClassBase - val mutable Extra: float - new (id: int, extra: float) as this = { inherit ValClassBase(id); Extra = extra } then this.Extra <- this.Extra + float this.Id - -[] -type ValClassSequenceSelf = - val Next: ValClassSequenceSelf - val Id: int - new (id: int) = { Next = null; Id = id } - new (a: int, b: int, c: int) as self = { Next = (ValClassSequenceSelf(a); ValClassSequenceSelf(b)); Id = c } then self.Next.Id |> ignore - -type ValClassSequenceSelfChild = - inherit ValClassSequenceSelf - val Tail: ValClassSequenceSelf - val mutable Count: int - new (a: int, b: int) as self = { inherit ValClassSequenceSelf(1); Tail = (ValClassSequenceSelf(a); ValClassSequenceSelf(b)); Count = 0 } then self.Count <- self.Tail.Id - -type ValClassOutOfOrder = - inherit ValClassBase - val Z: int - val W: int - new (id: int) = { inherit ValClassBase(id); W = 2; Z = 3 } - -type ValClassOutOfOrderSelf = - inherit ValClassBase +type ValClassSelfOutOfOrder = val Z: int val mutable W: int - new (id: int) as self = { inherit ValClassBase(id); W = 2; Z = 3 } then self.W <- self.W + self.Z + self.Id + new () as self = { W = 2; Z = 3 } then self.W <- self.W + self.Z let tests = testList "Types" [ @@ -2055,24 +2026,8 @@ let tests = let c = ValClassSequenceInit(5, 6) c.Next.Id |> equal 6 isNull c.Boxed |> equal true - - testCase "Explicit constructor inherits a base with a self identifier" <| fun () -> - let c = ValClassSelfInherited() - c.Name |> equal "abcd" - c.Count |> equal 4 - c.Tag |> equal "t" - - testCase "Explicit constructor keeps sequences of base constructor calls in field values" <| fun () -> - let c = ValClassSequenceSelf(5, 6, 7) - (c.Next.Id, c.Id) |> equal (6, 7) - let d = ValClassSequenceSelfChild(5, 6) - (d.Tail.Id, d.Count, d.Id) |> equal (6, 6, 1) - - testCase "Explicit constructor with a base keeps out of order fields" <| fun () -> - let c = ValClassOutOfOrder(1) - (c.Id, c.Z, c.W) |> equal (10, 3, 2) - let s = ValClassOutOfOrderSelf(1) - (s.Id, s.Z, s.W) |> equal (10, 3, 15) + 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") @@ -2081,8 +2036,6 @@ let tests = let b = ValClassSelf() b.Name |> equal "ab" b.Count |> equal 20 - let c = ValClassSelfChild(3, 1.5) - c.Id |> equal 30 - c.Extra |> equal 31.5 - c.Describe() |> equal "base:30" + let c = ValClassSelfOutOfOrder() + (c.Z, c.W) |> equal (3, 5) ] diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index bca28f759..b8c9ee4c4 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2044,6 +2044,7 @@ type ValClassSequenceInit = 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 @@ -2051,54 +2052,10 @@ type ValClassSelf = 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 ValClassSelfInherited = - inherit ValClassSelf - val Tag: string - new () = { inherit ValClassSelf("abcd"); Tag = "t" } - -type ValClassSelfChild = - inherit ValClassBase - val mutable Extra: float - new (id: int, extra: float) as this = { inherit ValClassBase(id); Extra = extra } then this.Extra <- this.Extra + float this.Id - -[] -type ValClassSequenceSelf = - val Next: ValClassSequenceSelf - val Id: int - new (id: int) = { Next = null; Id = id } - new (a: int, b: int, c: int) as self = { Next = (ValClassSequenceSelf(a); ValClassSequenceSelf(b)); Id = c } then self.Next.Id |> ignore - -type ValClassSequenceSelfChild = - inherit ValClassSequenceSelf - val Tail: ValClassSequenceSelf - val mutable Count: int - new (a: int, b: int) as self = { inherit ValClassSequenceSelf(1); Tail = (ValClassSequenceSelf(a); ValClassSequenceSelf(b)); Count = 0 } then self.Count <- self.Tail.Id - -type ValClassOutOfOrder = - inherit ValClassBase - val Z: int - val W: int - new (id: int) = { inherit ValClassBase(id); W = 2; Z = 3 } - -type ValClassOutOfOrderSelf = - inherit ValClassBase +type ValClassSelfOutOfOrder = val Z: int val mutable W: int - new (id: int) as self = { inherit ValClassBase(id); W = 2; Z = 3 } then self.W <- self.W + self.Z + self.Id - -[] -let ``test explicit constructor keeps sequences of base constructor calls in field values`` () = - let c = ValClassSequenceSelf(5, 6, 7) - (c.Next.Id, c.Id) |> equal (6, 7) - let d = ValClassSequenceSelfChild(5, 6) - (d.Tail.Id, d.Count, d.Id) |> equal (6, 6, 1) - -[] -let ``test explicit constructor with a base keeps out of order fields`` () = - let c = ValClassOutOfOrder(1) - (c.Id, c.Z, c.W) |> equal (10, 3, 2) - let s = ValClassOutOfOrderSelf(1) - (s.Id, s.Z, s.W) |> equal (10, 3, 15) + new () as self = { W = 2; Z = 3 } then self.W <- self.W + self.Z [] let ``test explicit constructor returns the object after its then block`` () = @@ -2112,6 +2069,8 @@ let ``test explicit constructor keeps sequences of its own constructor calls in 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 @@ -2121,14 +2080,5 @@ let ``test explicit constructor with a self identifier works`` () = // See #5166 let b = ValClassSelf() b.Name |> equal "ab" b.Count |> equal 20 - let c = ValClassSelfChild(3, 1.5) - c.Id |> equal 30 - c.Extra |> equal 31.5 - c.Describe() |> equal "base:30" - -[] -let ``test Explicit constructor inherits a base with a self identifier`` () = - let c = ValClassSelfInherited() - c.Name |> equal "abcd" - c.Count |> equal 4 - c.Tag |> equal "t" + let c = ValClassSelfOutOfOrder() + (c.Z, c.W) |> equal (3, 5) From e08e6e35318525ed791f7ba51c70e41405b31eb6 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Sat, 7 Nov 2026 10:10:49 +0100 Subject: [PATCH 14/16] fix(js/ts/python): narrow self ctor base check --- src/Fable.Transforms/FSharp2Fable.fs | 38 ++++++++++++---- .../Compiler/CompilerMessagesTests.fs | 45 +++++++++++++++++++ .../Integration/CompilationTests.fs | 19 +++++--- .../selfBase/App.fs | 0 .../selfBase/library/Library.fs | 0 .../selfBase/library/library.fsproj | 0 .../selfBase/selfBase.fsproj | 0 .../precompiledBases/staticInit/App.fs | 4 ++ .../staticInit/library/Library.fs | 6 +++ .../staticInit/library/library.fsproj | 12 +++++ .../staticInit/staticInit.fsproj | 13 ++++++ tests/Js/Main/TypeTests.fs | 17 +++++++ tests/Python/TestType.fs | 18 ++++++++ 13 files changed, 158 insertions(+), 14 deletions(-) rename tests/Integration/Integration/{precompiledErrors => precompiledBases}/selfBase/App.fs (100%) rename tests/Integration/Integration/{precompiledErrors => precompiledBases}/selfBase/library/Library.fs (100%) rename tests/Integration/Integration/{precompiledErrors => precompiledBases}/selfBase/library/library.fsproj (100%) rename tests/Integration/Integration/{precompiledErrors => precompiledBases}/selfBase/selfBase.fsproj (100%) create mode 100644 tests/Integration/Integration/precompiledBases/staticInit/App.fs create mode 100644 tests/Integration/Integration/precompiledBases/staticInit/library/Library.fs create mode 100644 tests/Integration/Integration/precompiledBases/staticInit/library/library.fsproj create mode 100644 tests/Integration/Integration/precompiledBases/staticInit/staticInit.fsproj diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index ab1fe9cf2..e564ecc5c 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -818,17 +818,36 @@ let private withOmittedFieldDefaults (com: IFableCompiler) (ctx: Context) (fsTyp else args -let rec private loadsSelf (e: FSharpExpr) = +let private (|LoadSelf|_|) (e: FSharpExpr) = match e with - | FSharpExprPatterns.ILAsm(("[I_ldarg 0us]" | "[I_ldarg 0]"), [], []) -> true - | e -> e.ImmediateSubExpressions |> List.exists loadsSelf + | 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 = - ent.MembersFunctionsAndValues - |> Seq.exists (fun memb -> memb.IsConstructor && not memb.IsImplicitConstructor) + constructors |> Seq.exists (fun memb -> not memb.IsImplicitConstructor) - if (FsEnt.Ref ent).SourcePath.IsNone || not hasExplicitConstructor then + if + (FsEnt.Ref ent).SourcePath.IsNone + || isGlobalOrImportedFSharpEntity ent + || not hasExplicitConstructor + then false else let file = Path.normalizePathAndEnsureFsExtension ent.DeclarationLocation.FileName @@ -840,9 +859,10 @@ let private hasSelfConstructor (com: IFableCompiler) (ent: FSharpEntity) = | 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 body + && loadsSelf hasPrimaryConstructor body | FSharpImplementationFileDeclaration.InitAction _ -> false ) @@ -857,7 +877,9 @@ let private hasSelfConstructor (com: IFableCompiler) (ent: FSharpEntity) = 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 -> field.Name.StartsWith("init@")) + | 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 diff --git a/tests/Integration/Compiler/CompilerMessagesTests.fs b/tests/Integration/Compiler/CompilerMessagesTests.fs index e781a7502..6f76a7c7c 100644 --- a/tests/Integration/Compiler/CompilerMessagesTests.fs +++ b/tests/Integration/Compiler/CompilerMessagesTests.fs @@ -162,6 +162,51 @@ type Derived() = |> 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 "Explicit child of a class without a self identifier compiles" <| fun _ -> let source = """ diff --git a/tests/Integration/Integration/CompilationTests.fs b/tests/Integration/Integration/CompilationTests.fs index 813096844..180dfa25e 100644 --- a/tests/Integration/Integration/CompilationTests.fs +++ b/tests/Integration/Integration/CompilationTests.fs @@ -56,13 +56,13 @@ let private checkBrowserInlineExprs (precompiledDir: string) = (Fable.BrowserInlineExprs.toString [| name, fromCompact |]) $"%s{name} differs between the two copies" -let private precompiledSelfBaseTest = +let private precompiledBaseTest name fixture shouldCompile = testCaseAsync - "Inheriting a precompiled class with a self identifier is an error" + name (async { - let testCaseDir = Path.Combine(__SOURCE_DIRECTORY__, "precompiledErrors", "selfBase") + let testCaseDir = Path.Combine(__SOURCE_DIRECTORY__, "precompiledBases", fixture) let libraryProject = Path.Combine(testCaseDir, "library", "library.fsproj") - let project = Path.Combine(testCaseDir, "selfBase.fsproj") + let project = Path.Combine(testCaseDir, fixture + ".fsproj") let tempDir = Path.Combine(Path.GetTempPath(), Path.GetRandomFileName()) let precompiledDir = Path.Combine(tempDir, "precompiled") @@ -87,7 +87,10 @@ let private precompiledSelfBaseTest = precompiledDir |] - Expect.notEqual exitCode 0 "Expected the compilation to fail" + 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) @@ -166,5 +169,9 @@ let tests = })) |> Seq.toList - |> List.append [ precompiledSelfBaseTest ] + |> 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/precompiledErrors/selfBase/App.fs b/tests/Integration/Integration/precompiledBases/selfBase/App.fs similarity index 100% rename from tests/Integration/Integration/precompiledErrors/selfBase/App.fs rename to tests/Integration/Integration/precompiledBases/selfBase/App.fs diff --git a/tests/Integration/Integration/precompiledErrors/selfBase/library/Library.fs b/tests/Integration/Integration/precompiledBases/selfBase/library/Library.fs similarity index 100% rename from tests/Integration/Integration/precompiledErrors/selfBase/library/Library.fs rename to tests/Integration/Integration/precompiledBases/selfBase/library/Library.fs diff --git a/tests/Integration/Integration/precompiledErrors/selfBase/library/library.fsproj b/tests/Integration/Integration/precompiledBases/selfBase/library/library.fsproj similarity index 100% rename from tests/Integration/Integration/precompiledErrors/selfBase/library/library.fsproj rename to tests/Integration/Integration/precompiledBases/selfBase/library/library.fsproj diff --git a/tests/Integration/Integration/precompiledErrors/selfBase/selfBase.fsproj b/tests/Integration/Integration/precompiledBases/selfBase/selfBase.fsproj similarity index 100% rename from tests/Integration/Integration/precompiledErrors/selfBase/selfBase.fsproj rename to tests/Integration/Integration/precompiledBases/selfBase/selfBase.fsproj diff --git a/tests/Integration/Integration/precompiledBases/staticInit/App.fs b/tests/Integration/Integration/precompiledBases/staticInit/App.fs new file mode 100644 index 000000000..9a0033d8a --- /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 000000000..7fa0cb414 --- /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 000000000..6fc5f67a9 --- /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 000000000..912d3e71a --- /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 c713ce63b..1a665e3f8 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1001,6 +1001,17 @@ type ValClassSelfOutOfOrder = val mutable W: int new () as self = { W = 2; Z = 3 } then self.W <- self.W + self.Z +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" [ @@ -2038,4 +2049,10 @@ let tests = 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) ] diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index b8c9ee4c4..facb7dee3 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2057,6 +2057,17 @@ type ValClassSelfOutOfOrder = val mutable W: int new () as self = { W = 2; Z = 3 } then self.W <- self.W + self.Z +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 @@ -2082,3 +2093,10 @@ let ``test explicit constructor with a self identifier works`` () = // See #5166 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) From 48dbe2c353615a6e87beb735e0b52b3441c0f8b9 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Sat, 7 Nov 2026 11:01:43 +0100 Subject: [PATCH 15/16] fix(js/ts/python): skip self ctor check for imports --- src/Fable.Transforms/FSharp2Fable.fs | 9 +++++---- .../Integration/Compiler/CompilerMessagesTests.fs | 15 +++++++++++++++ 2 files changed, 20 insertions(+), 4 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index e564ecc5c..ee731140f 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -2598,10 +2598,11 @@ let rec private transformDeclarations (com: FableCompiler) ctx fsDecls = checkInlinedTaggedUnionCases com ctx fsEnt warnDuplicateCompiledNames com ctx fsEnt - tryGetBaseEntity fsEnt - |> Option.iter (fun (baseEnt, _) -> - checkSelfConstructorBase com ctx (Some(makeRange fsEnt.DeclarationLocation)) baseEnt - ) + 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 6f76a7c7c..7fe26be37 100644 --- a/tests/Integration/Compiler/CompilerMessagesTests.fs +++ b/tests/Integration/Compiler/CompilerMessagesTests.fs @@ -207,6 +207,21 @@ type Derived() = |> 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 = """ From 0d3452fc0d4a3f6031dc5e41031e3b4fe2382764 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Sat, 7 Nov 2026 11:28:48 +0100 Subject: [PATCH 16/16] test(js/ts/python): check self ctor identity --- tests/Js/Main/TypeTests.fs | 16 ++++++++++++++++ tests/Python/TestType.fs | 17 +++++++++++++++++ 2 files changed, 33 insertions(+) diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index 1a665e3f8..f646f7f8d 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1001,6 +1001,13 @@ type ValClassSelfOutOfOrder = 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() @@ -2055,4 +2062,13 @@ let tests = (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 facb7dee3..ab9fc9476 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2057,6 +2057,13 @@ type ValClassSelfOutOfOrder = 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() @@ -2100,3 +2107,13 @@ let ``test primary constructor with a self identifier works with a secondary con (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