From 55454508a628b8cc43b510a2ce8d5a03963eb80d Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Mon, 2 Nov 2026 08:58:11 +0100 Subject: [PATCH 01/16] fix(js/ts/python): pass explicit ctor args to primary base --- src/Fable.Transforms/FSharp2Fable.Util.fs | 57 ++++++++++++++++++- src/Fable.Transforms/FSharp2Fable.fs | 26 +++++++++ tests/Js/Main/TypeTests.fs | 64 +++++++++++++++++++++ tests/Python/TestType.fs | 68 +++++++++++++++++++++++ 4 files changed, 214 insertions(+), 1 deletion(-) diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index b9ff3043a9..8000d9aa59 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -2497,6 +2497,46 @@ module Util = collect ent genArgs [] + let tryGetPrimaryConstructorBase (ent: FSharpEntity) = + match tryGetBaseEntity ent with + | Some(baseEnt, baseGenArgs) when + baseEnt.IsClass + && not (isGlobalOrImportedFSharpEntity baseEnt) + && (FsEnt.Ref baseEnt).SourcePath.IsSome + -> + baseEnt.MembersFunctionsAndValues + |> Seq.tryFind _.IsImplicitConstructor + |> Option.map (fun cons -> baseEnt, baseGenArgs, cons) + | _ -> None + + let getPrimaryConstructorBaseArgs + (ent: FSharpEntity) + (baseEnt: FSharpEntity) + (baseGenArgs: IList) + (cons: FSharpMemberOrFunctionOrValue) + = + let genArgs = + Seq.zip baseEnt.GenericParameters baseGenArgs + |> Seq.map (fun (param, typ) -> genParamName param, makeType Map.empty typ) + |> Map.ofSeq + + let fieldNames = ent.FSharpFields |> Seq.map _.Name.ToLowerInvariant() |> Set.ofSeq + + let rec uniqueName (name: string) = + if fieldNames.Contains(name.ToLowerInvariant()) then + uniqueName (name + "_") + else + name + + match List.ofSeq (Seq.concat cons.CurriedParameterGroups) with + | [ param ] when isUnit param.Type && param.Name.IsNone -> [] + | parameters -> + parameters + |> List.mapi (fun i param -> + let name = param.Name |> Option.defaultValue $"arg%d{i}" |> uniqueName + makeTypedIdentExpr (makeType genArgs param.Type) name + ) + /// We can add a suffix to the entity name for special methods, like reflection declaration let entityIdentWithSuffix (com: Compiler) (ent: Fable.EntityRef) suffix = let error msg = @@ -2532,7 +2572,22 @@ module Util = | None -> FsEnt.Ref baseEnt |> entityIdent com Some(Fable.Call(baseExpr, Fable.CallInfo.Create(args = args), Fable.Unit, None)) - | _ -> None + | Some _ -> None + | None -> + match tryGetPrimaryConstructorBase ent, tryGetBaseEntity ent with + | Some(baseEnt, baseGenArgs, cons), _ -> + let args = getPrimaryConstructorBaseArgs ent baseEnt baseGenArgs cons + let baseExpr = FsEnt.Ref baseEnt |> entityIdent com + Some(Fable.Call(baseExpr, Fable.CallInfo.Create(args = args), Fable.Unit, None)) + | None, Some(baseEnt, _) when + hasCompilerGeneratedConstructor baseEnt + && ent.MembersFunctionsAndValues |> Seq.exists _.IsConstructor + -> + $"%s{ent.FullName} has no primary constructor and inherits %s{baseEnt.FullName}, which has no primary constructor either but inherits a class that has one. Fable cannot compile this inheritance chain." + |> addError com [] (makeRange ent.DeclarationLocation |> Some) + + None + | _ -> None else None diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index ee731140ff..d3d28d7da5 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -1737,6 +1737,32 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs None args memb + | FSharpExprPatterns.Sequential(ConstructorCall(baseCons, baseGenArgs, baseArgs), + FSharpExprPatterns.NewRecord(fsType, ownArgs)) when + ctx.CaptureBaseConsCall.IsNone + && supportsCompilerGeneratedBaseCall com + && fsType.HasTypeDefinition + && hasCompilerGeneratedConstructor fsType.TypeDefinition + && ( + match baseCons.DeclaringEntity, tryGetPrimaryConstructorBase fsType.TypeDefinition with + | Some callee, Some(baseEnt, _, _) -> callee = baseEnt + | _ -> false + ) + -> + let r = makeRangeFrom fsExpr + + let baseArgs = + match transformBaseConsCall com ctx r baseCons.DeclaringEntity.Value baseCons baseGenArgs baseArgs with + | Fable.Call(_, info, _, _) -> dropUnitCallArg com info.Args info.SignatureArgTypes info.MemberRef + | _ -> [] + + let! ownArgs = transformExprList com ctx ownArgs + let genArgs = makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType) + let entRef = FsEnt.Ref fsType.TypeDefinition + entRef.SourcePath |> Option.iter com.AddSignatureDependency + + return Fable.NewRecord(baseArgs @ ownArgs, entRef, genArgs) |> makeValue r + | FSharpExprPatterns.Sequential(ConstructorCall(baseCons, _, _) as first, FSharpExprPatterns.NewRecord(fsType, ownArgs)) when ctx.CaptureBaseConsCall.IsNone diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index f646f7f8d5..d7f1393c7f 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1019,6 +1019,42 @@ type SelfPrimaryBase(x: int) as this = type SelfPrimaryChild() = inherit SelfPrimaryBase(2) +type PrimaryCtorBase(x: int) = + member _.X = x + member val Tag = "base" with get, set + member this.Describe() = this.Tag + ":" + string x + +type PrimaryCtorValChild = + inherit PrimaryCtorBase + val Label: string + new (x: int, label: string) = { inherit PrimaryCtorBase(x); Label = label } + new (label: string) = { inherit PrimaryCtorBase(label.Length); Label = label } + +type PrimaryCtorUnitBase() = + member val Greeting = "hi" + +type PrimaryCtorUnitChild = + inherit PrimaryCtorUnitBase + val Count: int + new (count: int) = { inherit PrimaryCtorUnitBase(); Count = count } + +type PrimaryCtorGenericBase<'T>(value: 'T, size: int) = + member _.Value = value + member _.Size = size + +type PrimaryCtorGenericChild<'T> = + inherit PrimaryCtorGenericBase<'T list> + val Item: 'T + new (item: 'T) = { inherit PrimaryCtorGenericBase<'T list>([ item; item ], 2); Item = item } + +type PrimaryCtorNamedBase(label: string) = + member _.BaseLabel = label + +type PrimaryCtorSameNameChild = + inherit PrimaryCtorNamedBase + val label: string + new (a: string, b: string) = { inherit PrimaryCtorNamedBase(a); label = b } + let tests = testList "Types" [ @@ -2071,4 +2107,32 @@ let tests = valClassSelfSaved.Count |> equal 3 obj.ReferenceEquals(valClassSelfSaved.[1], b) |> equal true obj.ReferenceEquals(valClassSelfSaved.[2], b) |> equal true + + testCase "Explicit constructor calls a base primary constructor" <| fun () -> + let child = PrimaryCtorValChild(3, "origin") + child.X |> equal 3 + child.Label |> equal "origin" + child.Tag |> equal "base" + child.Describe() |> equal "base:3" + (box child :? PrimaryCtorBase) |> equal true + let other = PrimaryCtorValChild("abcd") + other.X |> equal 4 + other.Label |> equal "abcd" + + testCase "Explicit constructor calls a parameterless base primary constructor" <| fun () -> + let child = PrimaryCtorUnitChild(4) + child.Greeting |> equal "hi" + child.Count |> equal 4 + (box child :? PrimaryCtorUnitBase) |> equal true + + testCase "Explicit constructor resolves the generic arguments of a base primary constructor" <| fun () -> + let child = PrimaryCtorGenericChild(7) + child.Value |> equal [ 7; 7 ] + child.Size |> equal 2 + child.Item |> equal 7 + + testCase "Explicit constructor keeps base primary constructor arguments apart from fields of the same name" <| fun () -> + let child = PrimaryCtorSameNameChild("a", "b") + child.BaseLabel |> equal "a" + child.label |> equal "b" ] diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index ab9fc9476c..fddf3f00a0 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2117,3 +2117,71 @@ let ``test explicit constructor self identifier is the created object`` () = valClassSelfSaved.Count |> equal 3 obj.ReferenceEquals(valClassSelfSaved.[1], b) |> equal true obj.ReferenceEquals(valClassSelfSaved.[2], b) |> equal true + +type PrimaryCtorBase(x: int) = + member _.X = x + member val Tag = "base" with get, set + member this.Describe() = this.Tag + ":" + string x + +type PrimaryCtorValChild = + inherit PrimaryCtorBase + val Label: string + new (x: int, label: string) = { inherit PrimaryCtorBase(x); Label = label } + new (label: string) = { inherit PrimaryCtorBase(label.Length); Label = label } + +type PrimaryCtorUnitBase() = + member val Greeting = "hi" + +type PrimaryCtorUnitChild = + inherit PrimaryCtorUnitBase + val Count: int + new (count: int) = { inherit PrimaryCtorUnitBase(); Count = count } + +type PrimaryCtorGenericBase<'T>(value: 'T, size: int) = + member _.Value = value + member _.Size = size + +type PrimaryCtorGenericChild<'T> = + inherit PrimaryCtorGenericBase<'T list> + val Item: 'T + new (item: 'T) = { inherit PrimaryCtorGenericBase<'T list>([ item; item ], 2); Item = item } + +type PrimaryCtorNamedBase(label: string) = + member _.BaseLabel = label + +type PrimaryCtorSameNameChild = + inherit PrimaryCtorNamedBase + val label: string + new (a: string, b: string) = { inherit PrimaryCtorNamedBase(a); label = b } + +[] +let ``test explicit constructor calls a base primary constructor`` () = + let child = PrimaryCtorValChild(3, "origin") + child.X |> equal 3 + child.Label |> equal "origin" + child.Tag |> equal "base" + child.Describe() |> equal "base:3" + (box child :? PrimaryCtorBase) |> equal true + let other = PrimaryCtorValChild("abcd") + other.X |> equal 4 + other.Label |> equal "abcd" + +[] +let ``test explicit constructor calls a parameterless base primary constructor`` () = + let child = PrimaryCtorUnitChild(4) + child.Greeting |> equal "hi" + child.Count |> equal 4 + (box child :? PrimaryCtorUnitBase) |> equal true + +[] +let ``test explicit constructor resolves the generic arguments of a base primary constructor`` () = + let child = PrimaryCtorGenericChild(7) + child.Value |> equal [ 7; 7 ] + child.Size |> equal 2 + child.Item |> equal 7 + +[] +let ``test explicit constructor keeps base primary constructor arguments apart from fields of the same name`` () = + let child = PrimaryCtorSameNameChild("a", "b") + child.BaseLabel |> equal "a" + child.label |> equal "b" From 74b4a51a10826b4d2e0a32b6789b7408967cd09d Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Tue, 3 Nov 2026 09:35:24 +0100 Subject: [PATCH 02/16] fix(js/ts/python): pass optional and ParamArray base args --- src/Fable.Transforms/Babel/Fable2Babel.fs | 12 +++- src/Fable.Transforms/FSharp2Fable.Util.fs | 75 ++++++++++++----------- src/Fable.Transforms/FSharp2Fable.fs | 17 +++++ tests/Js/Main/TypeTests.fs | 46 ++++++++++++++ tests/Python/TestType.fs | 48 +++++++++++++++ 5 files changed, 161 insertions(+), 37 deletions(-) diff --git a/src/Fable.Transforms/Babel/Fable2Babel.fs b/src/Fable.Transforms/Babel/Fable2Babel.fs index 5582a9ae22..5e4efff870 100644 --- a/src/Fable.Transforms/Babel/Fable2Babel.fs +++ b/src/Fable.Transforms/Babel/Fable2Babel.fs @@ -4822,7 +4822,17 @@ but thanks to the optimisation done below we get let classMembers = Array.append abstractClassMembers classMembers let exposedCons = - let argExprs = consArgs |> Array.map (fun p -> Expression.identifier (p.Name)) + let argExprs = + consArgs + |> Array.mapi (fun i p -> + let arg = Expression.identifier (p.Name) + + if consInfo.HasSpread && i = consArgs.Length - 1 then + Expression.spreadElement arg + else + arg + ) + let exposedConsBody = Expression.newExpression (classIdent, argExprs) makeFunctionExpression None (consArgs, exposedConsBody, returnType, typeParamDecl) diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 8000d9aa59..aa2498aecf 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -2555,42 +2555,6 @@ module Util = let entityIdent (com: Compiler) (ent: Fable.EntityRef) = entityIdentWithSuffix com ent "" - /// Compiler-generated constructors of derived classes receive the inherited fields and pass them to the base - let tryMakeCompilerGeneratedBaseCall (com: Compiler) (ent: FSharpEntity) = - if supportsCompilerGeneratedBaseCall com && hasCompilerGeneratedConstructor ent then - match tryGetCompilerGeneratedBases ent with - | Some(_ :: _ as bases) -> - let baseEnt = List.last bases - - let args = - getInheritedValFields ent Map.empty - |> List.map (fun (field, typ) -> makeTypedIdentExpr typ field.Name) - - let baseExpr = - match tryGlobalOrImportedFSharpEntity com baseEnt with - | Some baseExpr -> baseExpr - | None -> FsEnt.Ref baseEnt |> entityIdent com - - Some(Fable.Call(baseExpr, Fable.CallInfo.Create(args = args), Fable.Unit, None)) - | Some _ -> None - | None -> - match tryGetPrimaryConstructorBase ent, tryGetBaseEntity ent with - | Some(baseEnt, baseGenArgs, cons), _ -> - let args = getPrimaryConstructorBaseArgs ent baseEnt baseGenArgs cons - let baseExpr = FsEnt.Ref baseEnt |> entityIdent com - Some(Fable.Call(baseExpr, Fable.CallInfo.Create(args = args), Fable.Unit, None)) - | None, Some(baseEnt, _) when - hasCompilerGeneratedConstructor baseEnt - && ent.MembersFunctionsAndValues |> Seq.exists _.IsConstructor - -> - $"%s{ent.FullName} has no primary constructor and inherits %s{baseEnt.FullName}, which has no primary constructor either but inherits a class that has one. Fable cannot compile this inheritance chain." - |> addError com [] (makeRange ent.DeclarationLocation |> Some) - - None - | _ -> None - else - None - /// In Python a union is emitted as a public type alias (`type Demo = Demo_A | Demo_B`) /// plus a private base class (`_Demo`) that holds the runtime members: attached static /// members and the `cases()` method used by reflection. The type alias is typing-only, @@ -2764,6 +2728,45 @@ module Util = ?entRef = entRef ) + /// Compiler-generated constructors of derived classes receive the inherited fields and pass them to the base + let tryMakeCompilerGeneratedBaseCall (com: Compiler) (ent: FSharpEntity) = + if supportsCompilerGeneratedBaseCall com && hasCompilerGeneratedConstructor ent then + match tryGetCompilerGeneratedBases ent with + | Some(_ :: _ as bases) -> + let baseEnt = List.last bases + + let args = + getInheritedValFields ent Map.empty + |> List.map (fun (field, typ) -> makeTypedIdentExpr typ field.Name) + + let baseExpr = + match tryGlobalOrImportedFSharpEntity com baseEnt with + | Some baseExpr -> baseExpr + | None -> FsEnt.Ref baseEnt |> entityIdent com + + Some(Fable.Call(baseExpr, Fable.CallInfo.Create(args = args), Fable.Unit, None)) + | Some _ -> None + | None -> + match tryGetPrimaryConstructorBase ent, tryGetBaseEntity ent with + | Some(baseEnt, baseGenArgs, cons), _ -> + let args = getPrimaryConstructorBaseArgs ent baseEnt baseGenArgs cons + let baseExpr = FsEnt.Ref baseEnt |> entityIdent com + + let info = Fable.CallInfo.Create(args = args, memberRef = getFunctionMemberRef cons) + + Some(Fable.Call(baseExpr, info, Fable.Unit, None)) + | None, Some(baseEnt, _) when + hasCompilerGeneratedConstructor baseEnt + && ent.MembersFunctionsAndValues |> Seq.exists _.IsConstructor + -> + $"%s{ent.FullName} has no primary constructor and inherits %s{baseEnt.FullName}, which has no primary constructor either but inherits a class that has one. Fable cannot compile this inheritance chain." + |> addError com [] (makeRange ent.DeclarationLocation |> Some) + + None + | _ -> None + else + None + let rec tryFindInTypeHierarchy (ent: FSharpEntity) filter = if filter ent then Some ent diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index d3d28d7da5..ab8cffa0dc 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -1756,6 +1756,23 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs | Fable.Call(_, info, _, _) -> dropUnitCallArg com info.Args info.SignatureArgTypes info.MemberRef | _ -> [] + let omittedBaseArgs = + match tryGetPrimaryConstructorBase fsType.TypeDefinition with + | Some(baseEnt, baseGenArgs, cons) -> + let baseParams = + getPrimaryConstructorBaseArgs fsType.TypeDefinition baseEnt baseGenArgs cons + + baseParams + |> List.skip (min baseArgs.Length baseParams.Length) + |> List.map (fun param -> + match param.Type with + | Fable.Option(genArg, isStruct) -> Fable.Value(Fable.NewOption(None, genArg, isStruct), None) + | t -> Fable.Value(Fable.Null t, None) + ) + | None -> [] + + let baseArgs = baseArgs @ omittedBaseArgs + let! ownArgs = transformExprList com ctx ownArgs 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 d7f1393c7f..7ce27c4769 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1055,6 +1055,27 @@ type PrimaryCtorSameNameChild = val label: string new (a: string, b: string) = { inherit PrimaryCtorNamedBase(a); label = b } +type PrimaryCtorOptionalBase(a: int, ?b: string, ?c: int) = + member _.Describe = $"""{a}-{defaultArg b "B"}-{defaultArg c 7}""" + +type PrimaryCtorOptionalChild = + inherit PrimaryCtorOptionalBase + val Z: int + new () = { inherit PrimaryCtorOptionalBase(1); Z = 9 } + new (b: string) = { inherit PrimaryCtorOptionalBase(1, b); Z = 8 } + new (c: int) = { inherit PrimaryCtorOptionalBase(1, c = c); Z = 7 } + +type PrimaryCtorParamArrayBase(a: int, [] xs: int[]) = + member _.Total = a + Array.sum xs + member _.Count = xs.Length + +type PrimaryCtorParamArrayChild = + inherit PrimaryCtorParamArrayBase + val Z: int + new () = { inherit PrimaryCtorParamArrayBase(1, 2, 3); Z = 5 } + new (xs: int[]) = { inherit PrimaryCtorParamArrayBase(1, xs); Z = 6 } + new (_: bool) = { inherit PrimaryCtorParamArrayBase(1); Z = 7 } + let tests = testList "Types" [ @@ -2135,4 +2156,29 @@ let tests = let child = PrimaryCtorSameNameChild("a", "b") child.BaseLabel |> equal "a" child.label |> equal "b" + + testCase "Explicit constructor passes omitted optional arguments to a base primary constructor" <| fun () -> + let child = PrimaryCtorOptionalChild() + child.Describe |> equal "1-B-7" + child.Z |> equal 9 + let child = PrimaryCtorOptionalChild("x") + child.Describe |> equal "1-x-7" + child.Z |> equal 8 + let child = PrimaryCtorOptionalChild(3) + child.Describe |> equal "1-B-3" + child.Z |> equal 7 + + testCase "Explicit constructor passes ParamArray arguments to a base primary constructor" <| fun () -> + let child = PrimaryCtorParamArrayChild() + child.Total |> equal 6 + child.Count |> equal 2 + child.Z |> equal 5 + let child = PrimaryCtorParamArrayChild([| 4; 5 |]) + child.Total |> equal 10 + child.Count |> equal 2 + child.Z |> equal 6 + let child = PrimaryCtorParamArrayChild(true) + child.Total |> equal 1 + child.Count |> equal 0 + child.Z |> equal 7 ] diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index fddf3f00a0..324abd9202 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2154,6 +2154,27 @@ type PrimaryCtorSameNameChild = val label: string new (a: string, b: string) = { inherit PrimaryCtorNamedBase(a); label = b } +type PrimaryCtorOptionalBase(a: int, ?b: string, ?c: int) = + member _.Describe = $"""{a}-{defaultArg b "B"}-{defaultArg c 7}""" + +type PrimaryCtorOptionalChild = + inherit PrimaryCtorOptionalBase + val Z: int + new () = { inherit PrimaryCtorOptionalBase(1); Z = 9 } + new (b: string) = { inherit PrimaryCtorOptionalBase(1, b); Z = 8 } + new (c: int) = { inherit PrimaryCtorOptionalBase(1, c = c); Z = 7 } + +type PrimaryCtorParamArrayBase(a: int, [] xs: int[]) = + member _.Total = a + Array.sum xs + member _.Count = xs.Length + +type PrimaryCtorParamArrayChild = + inherit PrimaryCtorParamArrayBase + val Z: int + new () = { inherit PrimaryCtorParamArrayBase(1, 2, 3); Z = 5 } + new (xs: int[]) = { inherit PrimaryCtorParamArrayBase(1, xs); Z = 6 } + new (_: bool) = { inherit PrimaryCtorParamArrayBase(1); Z = 7 } + [] let ``test explicit constructor calls a base primary constructor`` () = let child = PrimaryCtorValChild(3, "origin") @@ -2185,3 +2206,30 @@ let ``test explicit constructor keeps base primary constructor arguments apart f let child = PrimaryCtorSameNameChild("a", "b") child.BaseLabel |> equal "a" child.label |> equal "b" + +[] +let ``test explicit constructor passes omitted optional arguments to a base primary constructor`` () = + let child = PrimaryCtorOptionalChild() + child.Describe |> equal "1-B-7" + child.Z |> equal 9 + let child = PrimaryCtorOptionalChild("x") + child.Describe |> equal "1-x-7" + child.Z |> equal 8 + let child = PrimaryCtorOptionalChild(3) + child.Describe |> equal "1-B-3" + child.Z |> equal 7 + +[] +let ``test explicit constructor passes ParamArray arguments to a base primary constructor`` () = + let child = PrimaryCtorParamArrayChild() + child.Total |> equal 6 + child.Count |> equal 2 + child.Z |> equal 5 + let child = PrimaryCtorParamArrayChild([| 4; 5 |]) + child.Total |> equal 10 + child.Count |> equal 2 + child.Z |> equal 6 + let child = PrimaryCtorParamArrayChild(true) + child.Total |> equal 1 + child.Count |> equal 0 + child.Z |> equal 7 From af3ae714f3be599419b757cd31b1e37137a3a134 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Tue, 3 Nov 2026 17:20:50 +0100 Subject: [PATCH 03/16] fix(python): keep ParamArray of primary ctors as arrays --- .../Python/Fable2Python.Transforms.fs | 32 +++++++++++++++++-- 1 file changed, 29 insertions(+), 3 deletions(-) diff --git a/src/Fable.Transforms/Python/Fable2Python.Transforms.fs b/src/Fable.Transforms/Python/Fable2Python.Transforms.fs index c77d94d28c..008793b9f4 100644 --- a/src/Fable.Transforms/Python/Fable2Python.Transforms.fs +++ b/src/Fable.Transforms/Python/Fable2Python.Transforms.fs @@ -96,8 +96,28 @@ let getMemberArgsAndBody (com: IPythonCompiler) ctx kind hasSpread (args: Fable. body None, genTypeParams, args, body - | Attached(isStatic = true), _ - | ClassConstructor, _ -> None, ctx.ScopedTypeParams, args, body + | ClassConstructor, _ -> + let args, body = + match List.tryLast args with + | Some varArg when hasSpread -> + let varArgTuple = { varArg with Name = "_" + varArg.Name } + let elementType = getVarArgElementType varArg.Type + + let array = + Fable.Value( + Fable.NewArray( + Fable.ArrayFrom(Fable.IdentExpr varArgTuple), + elementType, + Fable.MutableArray + ), + None + ) + + List.take (args.Length - 1) args @ [ varArgTuple ], Fable.Let(varArg, array, body) + | _ -> args, body + + None, ctx.ScopedTypeParams, args, body + | Attached(isStatic = true), _ -> None, ctx.ScopedTypeParams, args, body | NonAttached funcName, _ -> Some funcName, Set.empty, args, body | _ -> None, Set.empty, args, body @@ -4701,7 +4721,13 @@ let transformClassWithPrimaryConstructor // Don't generate exposed constructor for abstract classes since they can't be instantiated [] else - let argExprs = consArgs.Args |> List.map (fun p -> Expression.identifier p.Arg) + let argExprs = + let args = consArgs.Args |> List.map (fun p -> Expression.identifier p.Arg) + + match consArgs.VarArg with + | Some varArg -> args @ [ Expression.starred (Expression.identifier varArg.Arg) ] + | None -> args + let exposedConsBody = Expression.call (classIdent, argExprs) let name = com.GetIdentifier(ctx, cons.Name) From 39249aaf012487dbe779b3e36fc5e4e11a145e5e Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Wed, 4 Nov 2026 15:20:00 +0100 Subject: [PATCH 04/16] fix(js/ts/python): fix base ctor arg names and uncurrying --- src/Fable.Transforms/FSharp2Fable.Util.fs | 25 ++++-- src/Fable.Transforms/FSharp2Fable.fs | 9 ++- src/Fable.Transforms/FableTransforms.fs | 13 +++- .../Python/Fable2Python.Transforms.fs | 45 +++++------ .../Python/Fable2Python.Util.fs | 34 ++++++++ tests/Js/Main/TypeTests.fs | 71 +++++++++++++++++ tests/Python/TestType.fs | 77 +++++++++++++++++++ 7 files changed, 235 insertions(+), 39 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index aa2498aecf..164c8d4104 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -2510,6 +2510,7 @@ module Util = | _ -> None let getPrimaryConstructorBaseArgs + (com: Compiler) (ent: FSharpEntity) (baseEnt: FSharpEntity) (baseGenArgs: IList) @@ -2520,20 +2521,28 @@ module Util = |> Seq.map (fun (param, typ) -> genParamName param, makeType Map.empty typ) |> Map.ofSeq - let fieldNames = ent.FSharpFields |> Seq.map _.Name.ToLowerInvariant() |> Set.ofSeq + let sanitize conflicts name = + match com.Options.Language with + | Python -> + (Fable.Py.Naming.toPythonNaming name, Naming.NoMemberPart) + ||> Fable.Py.Naming.sanitizeIdent conflicts + | _ -> (name, Naming.NoMemberPart) ||> Naming.sanitizeJsIdent conflicts - let rec uniqueName (name: string) = - if fieldNames.Contains(name.ToLowerInvariant()) then - uniqueName (name + "_") - else - name + let usedNames = + ent.FSharpFields + |> Seq.filter (fun field -> not field.IsStatic) + |> Seq.map (FsField.FSharpFieldName >> sanitize (fun _ -> false)) + |> HashSet match List.ofSeq (Seq.concat cons.CurriedParameterGroups) with | [ param ] when isUnit param.Type && param.Name.IsNone -> [] | parameters -> parameters |> List.mapi (fun i param -> - let name = param.Name |> Option.defaultValue $"arg%d{i}" |> uniqueName + let name = + param.Name |> Option.defaultValue $"arg%d{i}" |> sanitize usedNames.Contains + + usedNames.Add(name) |> ignore makeTypedIdentExpr (makeType genArgs param.Type) name ) @@ -2749,7 +2758,7 @@ module Util = | None -> match tryGetPrimaryConstructorBase ent, tryGetBaseEntity ent with | Some(baseEnt, baseGenArgs, cons), _ -> - let args = getPrimaryConstructorBaseArgs ent baseEnt baseGenArgs cons + let args = getPrimaryConstructorBaseArgs com ent baseEnt baseGenArgs cons let baseExpr = FsEnt.Ref baseEnt |> entityIdent com let info = Fable.CallInfo.Create(args = args, memberRef = getFunctionMemberRef cons) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index ab8cffa0dc..81c895001b 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -1760,7 +1760,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs match tryGetPrimaryConstructorBase fsType.TypeDefinition with | Some(baseEnt, baseGenArgs, cons) -> let baseParams = - getPrimaryConstructorBaseArgs fsType.TypeDefinition baseEnt baseGenArgs cons + getPrimaryConstructorBaseArgs com fsType.TypeDefinition baseEnt baseGenArgs cons baseParams |> List.skip (min baseArgs.Length baseParams.Length) @@ -1802,7 +1802,12 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs let inheritedArgs = getInheritedValFields fsType.TypeDefinition ctx.GenericArgs - |> List.map (fun (field, typ) -> getFieldWith None typ (Fable.IdentExpr baseIdent) field.Name) + |> List.map (fun (field, typ) -> + let info = + Fable.FieldInfo.Create(field.Name, fieldType = typ, maybeCalculated = true) + + Fable.Get(Fable.IdentExpr baseIdent, info, typ, None) + ) let genArgs = makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType) let entRef = FsEnt.Ref fsType.TypeDefinition diff --git a/src/Fable.Transforms/FableTransforms.fs b/src/Fable.Transforms/FableTransforms.fs index 70730b2074..0e3081a7d1 100644 --- a/src/Fable.Transforms/FableTransforms.fs +++ b/src/Fable.Transforms/FableTransforms.fs @@ -877,10 +877,17 @@ module private Transforms = Emit({ emitInfo with CallInfo = { callInfo with Args = args } }, t, r) // Uncurry also values in setters or new record/union/tuple | Value(NewRecord(args, ent, genArgs), r) -> - let args = + let fieldTypes = com.GetEntity(ent).FSharpFields - |> Seq.filter (fun f -> not f.IsStatic) - |> uncurryConsArgs args + |> List.filter (fun f -> not f.IsStatic) + |> List.map (fun f -> f.FieldType) + + let baseArgTypes = + args + |> List.take (max 0 (args.Length - fieldTypes.Length)) + |> List.map (fun a -> a.Type) + + let args = uncurryArgs com false (baseArgTypes @ fieldTypes) args Value(NewRecord(args, ent, genArgs), r) | Value(NewAnonymousRecord(args, fieldNames, genArgs, isStruct), r) -> diff --git a/src/Fable.Transforms/Python/Fable2Python.Transforms.fs b/src/Fable.Transforms/Python/Fable2Python.Transforms.fs index 008793b9f4..ab8becf839 100644 --- a/src/Fable.Transforms/Python/Fable2Python.Transforms.fs +++ b/src/Fable.Transforms/Python/Fable2Python.Transforms.fs @@ -96,28 +96,8 @@ let getMemberArgsAndBody (com: IPythonCompiler) ctx kind hasSpread (args: Fable. body None, genTypeParams, args, body - | ClassConstructor, _ -> - let args, body = - match List.tryLast args with - | Some varArg when hasSpread -> - let varArgTuple = { varArg with Name = "_" + varArg.Name } - let elementType = getVarArgElementType varArg.Type - - let array = - Fable.Value( - Fable.NewArray( - Fable.ArrayFrom(Fable.IdentExpr varArgTuple), - elementType, - Fable.MutableArray - ), - None - ) - - List.take (args.Length - 1) args @ [ varArgTuple ], Fable.Let(varArg, array, body) - | _ -> args, body - - None, ctx.ScopedTypeParams, args, body - | Attached(isStatic = true), _ -> None, ctx.ScopedTypeParams, args, body + | Attached(isStatic = true), _ + | ClassConstructor, _ -> None, ctx.ScopedTypeParams, args, body | NonAttached funcName, _ -> Some funcName, Set.empty, args, body | _ -> None, Set.empty, args, body @@ -4657,7 +4637,7 @@ let transformClassWithPrimaryConstructor else [], [] - let consArgs, consBody, _returnType = + let consArgs, consBody, _returnType, varArgInit = if classAttributes.Style = ClassStyle.Attributes then if classAttributes.Init then // For attributes style with init=true, generate new constructor with property names @@ -4693,13 +4673,24 @@ let transformClassWithPrimaryConstructor assign None left right |> exprAsStatement ctx ) - propertyArgs, propertyBody, Expression.none + propertyArgs, propertyBody, Expression.none, [] else // For attributes style with init=false, no constructor arguments or body - Arguments.empty, [], Expression.none + Arguments.empty, [], Expression.none, [] else let info = com.GetMember(cons.MemberRef) - getMemberArgsAndBody com ctx ClassConstructor info.HasSpread cons.Args cons.Body + + let usedIn = cons.Body :: Option.toList classDecl.BaseCall + + let args, varArgInit = + match tryMakeConstructorVarArgTuple ctx info.HasSpread cons.Args usedIn with + | Some(args, (varArg, array)) -> args, transformBindingAsStatements com ctx varArg array + | None -> cons.Args, [] + + let consArgs, consBody, returnType = + getMemberArgsAndBody com ctx ClassConstructor info.HasSpread args cons.Body + + consArgs, consBody, returnType, varArgInit let isOptional = Helpers.isOptional (cons.Args |> Array.ofList) @@ -4772,6 +4763,8 @@ let transformClassWithPrimaryConstructor ) |> Option.defaultValue (None, consBody) + let consBody = varArgInit @ consBody + [ yield! stmts yield! diff --git a/src/Fable.Transforms/Python/Fable2Python.Util.fs b/src/Fable.Transforms/Python/Fable2Python.Util.fs index 23bfd37303..09f0cf44cb 100644 --- a/src/Fable.Transforms/Python/Fable2Python.Util.fs +++ b/src/Fable.Transforms/Python/Fable2Python.Util.fs @@ -114,6 +114,40 @@ module Util = | Fable.Array(elemType, _) -> elemType | _ -> Fable.Any // Fallback if not array type + let tryMakeConstructorVarArgTuple + (ctx: Context) + (hasSpread: bool) + (args: Fable.Ident list) + (usedIn: Fable.Expr list) + = + match List.tryLast args with + | Some varArg when hasSpread -> + let argNames = args |> List.map _.Name |> set + + let tupleName = + ("_" + varArg.Name, Naming.NoMemberPart) + ||> Naming.sanitizeIdent (fun name -> + argNames.Contains name + || ctx.UsedNames.RootScope.Contains name + || ctx.UsedNames.CurrentDeclarationScope.Contains name + || usedIn |> List.exists (isIdentUsed name) + ) + + let varArgTuple = { varArg with Name = tupleName } + + let array = + Fable.Value( + Fable.NewArray( + Fable.ArrayFrom(Fable.IdentExpr varArgTuple), + getVarArgElementType varArg.Type, + Fable.MutableArray + ), + None + ) + + Some(List.take (args.Length - 1) args @ [ varArgTuple ], (varArg, array)) + | _ -> None + /// Splits a list of items into regular items and an optional vararg item. /// When hasSpread is true and items is non-empty, the last item becomes the vararg. let splitVarArg<'T> (hasSpread: bool) (items: 'T list) : 'T list * 'T option = diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index 7ce27c4769..a3d5871de2 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1076,6 +1076,49 @@ type PrimaryCtorParamArrayChild = new (xs: int[]) = { inherit PrimaryCtorParamArrayBase(1, xs); Z = 6 } new (_: bool) = { inherit PrimaryCtorParamArrayBase(1); Z = 7 } +type PrimaryCtorSuffixBase(x: int, x_: int) = + member _.Sum = x * 10 + x_ + +type PrimaryCtorSuffixChild = + inherit PrimaryCtorSuffixBase + val x: int + new (a: int, b: int, c: int) = { inherit PrimaryCtorSuffixBase(a, b); x = c } + +type PrimaryCtorKeywordBase(``switch``: int, pass: int) = + member _.Value = ``switch`` * 10 + pass + +type PrimaryCtorKeywordChild = + inherit PrimaryCtorKeywordBase + val Z: int + new (a: int) = { inherit PrimaryCtorKeywordBase(a, 2); Z = 1 } + +type PrimaryCtorFunctionBase(f: int -> int -> int) = + member _.Apply a b = f a b + +type PrimaryCtorFunctionChild = + inherit PrimaryCtorFunctionBase + val G: int -> int -> int + new (n: int, g: int -> int -> int) = { inherit PrimaryCtorFunctionBase(fun a b -> a + b + n); G = g } + +type ValClassFunctionBase = + val F: int -> int -> int + new (f) = { F = f } + +type ValClassFunctionChild = + inherit ValClassFunctionBase + val G: int -> int -> int + new (f, g) = { inherit ValClassFunctionBase(f); G = g } + +type PrimaryCtorArrayBase(xs: int[]) = + member _.Items = xs + +type PrimaryCtorParamArrayForwardingChild([] xs: int[]) = + inherit PrimaryCtorArrayBase(xs) + member _.First = xs.[0] + +type PrimaryCtorParamArrayPrefixed(_xs: int, [] xs: int[]) = + member _.Value = _xs + xs.Length + let tests = testList "Types" [ @@ -2181,4 +2224,32 @@ let tests = child.Total |> equal 1 child.Count |> equal 0 child.Z |> equal 7 + + testCase "Explicit constructor gives distinct names to base primary constructor arguments" <| fun () -> + let child = PrimaryCtorSuffixChild(1, 2, 3) + child.Sum |> equal 12 + child.x |> equal 3 + + testCase "Explicit constructor accepts base primary constructor arguments named after keywords" <| fun () -> + let child = PrimaryCtorKeywordChild(4) + child.Value |> equal 42 + child.Z |> equal 1 + + testCase "Explicit constructor passes functions to a base primary constructor and its own fields" <| fun () -> + let child = PrimaryCtorFunctionChild(1, (fun a b -> a * b)) + child.Apply 2 3 |> equal 6 + child.G 2 3 |> equal 6 + + testCase "Explicit constructor copies inherited function fields" <| fun () -> + let child = ValClassFunctionChild((fun a b -> a - b), (fun a b -> a * b)) + child.F 5 2 |> equal 3 + child.G 5 2 |> equal 10 + + testCase "Primary constructor forwards its ParamArray to the base constructor" <| fun () -> + let child = PrimaryCtorParamArrayForwardingChild(9, 8) + child.Items |> equal [| 9; 8 |] + child.First |> equal 9 + + testCase "Primary constructor ParamArray does not clash with other arguments" <| fun () -> + PrimaryCtorParamArrayPrefixed(1, 2, 3).Value |> equal 3 ] diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index 324abd9202..439e5e5441 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2175,6 +2175,49 @@ type PrimaryCtorParamArrayChild = new (xs: int[]) = { inherit PrimaryCtorParamArrayBase(1, xs); Z = 6 } new (_: bool) = { inherit PrimaryCtorParamArrayBase(1); Z = 7 } +type PrimaryCtorSuffixBase(x: int, x_: int) = + member _.Sum = x * 10 + x_ + +type PrimaryCtorSuffixChild = + inherit PrimaryCtorSuffixBase + val x: int + new (a: int, b: int, c: int) = { inherit PrimaryCtorSuffixBase(a, b); x = c } + +type PrimaryCtorKeywordBase(``switch``: int, pass: int) = + member _.Value = ``switch`` * 10 + pass + +type PrimaryCtorKeywordChild = + inherit PrimaryCtorKeywordBase + val Z: int + new (a: int) = { inherit PrimaryCtorKeywordBase(a, 2); Z = 1 } + +type PrimaryCtorFunctionBase(f: int -> int -> int) = + member _.Apply a b = f a b + +type PrimaryCtorFunctionChild = + inherit PrimaryCtorFunctionBase + val G: int -> int -> int + new (n: int, g: int -> int -> int) = { inherit PrimaryCtorFunctionBase(fun a b -> a + b + n); G = g } + +type ValClassFunctionBase = + val F: int -> int -> int + new (f) = { F = f } + +type ValClassFunctionChild = + inherit ValClassFunctionBase + val G: int -> int -> int + new (f, g) = { inherit ValClassFunctionBase(f); G = g } + +type PrimaryCtorArrayBase(xs: int[]) = + member _.Items = xs + +type PrimaryCtorParamArrayForwardingChild([] xs: int[]) = + inherit PrimaryCtorArrayBase(xs) + member _.First = xs.[0] + +type PrimaryCtorParamArrayPrefixed(_xs: int, [] xs: int[]) = + member _.Value = _xs + xs.Length + [] let ``test explicit constructor calls a base primary constructor`` () = let child = PrimaryCtorValChild(3, "origin") @@ -2233,3 +2276,37 @@ let ``test explicit constructor passes ParamArray arguments to a base primary co child.Total |> equal 1 child.Count |> equal 0 child.Z |> equal 7 + +[] +let ``test explicit constructor gives distinct names to base primary constructor arguments`` () = + let child = PrimaryCtorSuffixChild(1, 2, 3) + child.Sum |> equal 12 + child.x |> equal 3 + +[] +let ``test explicit constructor accepts base primary constructor arguments named after keywords`` () = + let child = PrimaryCtorKeywordChild(4) + child.Value |> equal 42 + child.Z |> equal 1 + +[] +let ``test explicit constructor passes functions to a base primary constructor and its own fields`` () = + let child = PrimaryCtorFunctionChild(1, (fun a b -> a * b)) + child.Apply 2 3 |> equal 6 + child.G 2 3 |> equal 6 + +[] +let ``test explicit constructor copies inherited function fields`` () = + let child = ValClassFunctionChild((fun a b -> a - b), (fun a b -> a * b)) + child.F 5 2 |> equal 3 + child.G 5 2 |> equal 10 + +[] +let ``test primary constructor forwards its ParamArray to the base constructor`` () = + let child = PrimaryCtorParamArrayForwardingChild(9, 8) + child.Items |> equal [| 9; 8 |] + child.First |> equal 9 + +[] +let ``test primary constructor ParamArray does not clash with other arguments`` () = + PrimaryCtorParamArrayPrefixed(1, 2, 3).Value |> equal 3 From 6f436f012f83ef556f34dd44920e1e0a109c6e9a Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 12:26:46 +0100 Subject: [PATCH 05/16] fix(js/ts/python): error on inheriting a secondary base ctor --- src/Fable.Transforms/FSharp2Fable.fs | 14 ++++++-- .../Compiler/CompilerMessagesTests.fs | 32 +++++++++++++++++++ 2 files changed, 43 insertions(+), 3 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 81c895001b..603356195d 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -1752,9 +1752,17 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs let r = makeRangeFrom fsExpr let baseArgs = - match transformBaseConsCall com ctx r baseCons.DeclaringEntity.Value baseCons baseGenArgs baseArgs with - | Fable.Call(_, info, _, _) -> dropUnitCallArg com info.Args info.SignatureArgTypes info.MemberRef - | _ -> [] + if not baseCons.IsImplicitConstructor then + $"%s{fsType.TypeDefinition.FullName} calls a secondary constructor of %s{baseCons.DeclaringEntity.Value.FullName}. Fable only supports calling the primary constructor of the base class here." + |> addError com ctx.InlinePath r + + [] + else + match + transformBaseConsCall com ctx r baseCons.DeclaringEntity.Value baseCons baseGenArgs baseArgs + with + | Fable.Call(_, info, _, _) -> dropUnitCallArg com info.Args info.SignatureArgTypes info.MemberRef + | _ -> [] let omittedBaseArgs = match tryGetPrimaryConstructorBase fsType.TypeDefinition with diff --git a/tests/Integration/Compiler/CompilerMessagesTests.fs b/tests/Integration/Compiler/CompilerMessagesTests.fs index 7fe26be375..cb41a1bf4b 100644 --- a/tests/Integration/Compiler/CompilerMessagesTests.fs +++ b/tests/Integration/Compiler/CompilerMessagesTests.fs @@ -1114,4 +1114,36 @@ let one = AuthState.One "a" compile source |> Assert.Is.strictSuccess |> ignore + + testCase "Explicit constructor calling a secondary constructor of a base with a primary constructor results in error" <| fun _ -> + let source = + """ +type Base(x: int) = + new (s: string) = Base(s.Length) + member _.X = x + +type Derived = + inherit Base + val Y: int + new (s: string) = { inherit Base(s); Y = 1 } +""" + compile source + |> Assert.Exists.errorWith "Derived calls a secondary constructor of" + |> ignore + + testCase "Explicit constructor calling a parameterless secondary constructor of a base results in error" <| fun _ -> + let source = + """ +type Base(x: int) = + new () = Base(42) + member _.X = x + +type Derived = + inherit Base + val Y: int + new () = { inherit Base(); Y = 1 } +""" + compile source + |> Assert.Exists.errorWith "calls a secondary constructor" + |> ignore ] From 593ce9ee7a284606a58d5941fa0bee6bd7895b5c Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 12:27:37 +0100 Subject: [PATCH 06/16] fix(python): rename base ctor args named after builtins --- src/Fable.Transforms/FSharp2Fable.Util.fs | 7 +++++-- tests/Js/Main/TypeTests.fs | 13 +++++++++++++ tests/Python/TestType.fs | 14 ++++++++++++++ 3 files changed, 32 insertions(+), 2 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 164c8d4104..316c313414 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -2534,13 +2534,16 @@ module Util = |> Seq.map (FsField.FSharpFieldName >> sanitize (fun _ -> false)) |> HashSet + let isUsed name = + usedNames.Contains name + || com.Options.Language = Python && Fable.Py.Naming.pyBuiltins.Contains name + match List.ofSeq (Seq.concat cons.CurriedParameterGroups) with | [ param ] when isUnit param.Type && param.Name.IsNone -> [] | parameters -> parameters |> List.mapi (fun i param -> - let name = - param.Name |> Option.defaultValue $"arg%d{i}" |> sanitize usedNames.Contains + let name = param.Name |> Option.defaultValue $"arg%d{i}" |> sanitize isUsed usedNames.Add(name) |> ignore makeTypedIdentExpr (makeType genArgs param.Type) name diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index a3d5871de2..5ebd7a4753 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1119,6 +1119,14 @@ type PrimaryCtorParamArrayForwardingChild([] xs: int[]) = type PrimaryCtorParamArrayPrefixed(_xs: int, [] xs: int[]) = member _.Value = _xs + xs.Length +type PrimaryCtorSelfBase(self: int, this: int) = + member _.Sum = self * 10 + this + +type PrimaryCtorSelfChild = + inherit PrimaryCtorSelfBase + val Z: int + new (a: int) = { inherit PrimaryCtorSelfBase(a, 2); Z = 4 } + let tests = testList "Types" [ @@ -2252,4 +2260,9 @@ let tests = testCase "Primary constructor ParamArray does not clash with other arguments" <| fun () -> PrimaryCtorParamArrayPrefixed(1, 2, 3).Value |> equal 3 + + testCase "Explicit constructor accepts base primary constructor arguments named self or this" <| fun () -> + let child = PrimaryCtorSelfChild(3) + child.Sum |> equal 32 + child.Z |> equal 4 ] diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index 439e5e5441..57e11b5390 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2218,6 +2218,14 @@ type PrimaryCtorParamArrayForwardingChild([] xs: int[]) = type PrimaryCtorParamArrayPrefixed(_xs: int, [] xs: int[]) = member _.Value = _xs + xs.Length +type PrimaryCtorSelfBase(self: int, this: int) = + member _.Sum = self * 10 + this + +type PrimaryCtorSelfChild = + inherit PrimaryCtorSelfBase + val Z: int + new (a: int) = { inherit PrimaryCtorSelfBase(a, 2); Z = 4 } + [] let ``test explicit constructor calls a base primary constructor`` () = let child = PrimaryCtorValChild(3, "origin") @@ -2310,3 +2318,9 @@ let ``test primary constructor forwards its ParamArray to the base constructor`` [] let ``test primary constructor ParamArray does not clash with other arguments`` () = PrimaryCtorParamArrayPrefixed(1, 2, 3).Value |> equal 3 + +[] +let ``test explicit constructor accepts base primary constructor arguments named self or this`` () = + let child = PrimaryCtorSelfChild(3) + child.Sum |> equal 32 + child.Z |> equal 4 From 6a53d28dccb481cca4e33b124a2e136db0320e74 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 12:28:02 +0100 Subject: [PATCH 07/16] fix(js/ts/python): type base ctor args as uncurried --- src/Fable.Transforms/Babel/Fable2Babel.fs | 19 +++++++++++---- src/Fable.Transforms/FSharp2Fable.Util.fs | 28 +++++++++++++++++++++-- tests/Js/Main/TypeTests.fs | 17 ++++++++++++++ tests/Python/TestType.fs | 18 +++++++++++++++ 4 files changed, 76 insertions(+), 6 deletions(-) diff --git a/src/Fable.Transforms/Babel/Fable2Babel.fs b/src/Fable.Transforms/Babel/Fable2Babel.fs index 5e4efff870..dea2983193 100644 --- a/src/Fable.Transforms/Babel/Fable2Babel.fs +++ b/src/Fable.Transforms/Babel/Fable2Babel.fs @@ -4535,10 +4535,21 @@ but thanks to the optimisation done below we get ) let args = - Array.append baseFieldIds fieldIds - |> Array.map (fun fi -> - Parameter.parameter (fi.Name, ?typeAnnotation = makeFieldAnnotationIfTypeScript com ctx fi.Type) - ) + Array.append + (baseFieldIds + |> Array.map (fun fi -> + let typeAnnotation = + if com.IsTypeScript then + makeTypeAnnotation com ctx fi.Type |> Some + else + None + + Parameter.parameter (fi.Name, ?typeAnnotation = typeAnnotation) + )) + (fieldIds + |> Array.map (fun fi -> + Parameter.parameter (fi.Name, ?typeAnnotation = makeFieldAnnotationIfTypeScript com ctx fi.Type) + )) declareType com ctx ent decl.Name decl.XmlDoc args body baseExpr classMembers diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 316c313414..b6c4b741a3 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -2497,6 +2497,23 @@ module Util = collect ent genArgs [] + let uncurryLikeDeclaredType (declaredType: Fable.Type) (actualType: Fable.Type) = + let rec arity = + function + | Fable.LambdaType(_, returnType) -> 1 + arity returnType + | _ -> 0 + + let rec uncurry n argTypes = + function + | Fable.LambdaType(argType, returnType) when n > 0 -> uncurry (n - 1) (argType :: argTypes) returnType + | returnType -> Fable.DelegateType(List.rev argTypes, returnType) + + match declaredType, actualType with + | Fable.Option(declaredType, _), Fable.Option(actualType, isStruct) when arity declaredType > 1 -> + Fable.Option(uncurry (arity declaredType) [] actualType, isStruct) + | _ when arity declaredType > 1 -> uncurry (arity declaredType) [] actualType + | _ -> actualType + let tryGetPrimaryConstructorBase (ent: FSharpEntity) = match tryGetBaseEntity ent with | Some(baseEnt, baseGenArgs) when @@ -2546,7 +2563,11 @@ module Util = let name = param.Name |> Option.defaultValue $"arg%d{i}" |> sanitize isUsed usedNames.Add(name) |> ignore - makeTypedIdentExpr (makeType genArgs param.Type) name + + let typ = + uncurryLikeDeclaredType (makeType Map.empty param.Type) (makeType genArgs param.Type) + + makeTypedIdentExpr typ name ) /// We can add a suffix to the entity name for special methods, like reflection declaration @@ -2749,7 +2770,10 @@ module Util = let args = getInheritedValFields ent Map.empty - |> List.map (fun (field, typ) -> makeTypedIdentExpr typ field.Name) + |> List.map (fun (field, typ) -> + let typ = uncurryLikeDeclaredType (makeType Map.empty field.FieldType) typ + makeTypedIdentExpr typ field.Name + ) let baseExpr = match tryGlobalOrImportedFSharpEntity com baseEnt with diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index 5ebd7a4753..4a7a9a2ddb 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1127,6 +1127,16 @@ type PrimaryCtorSelfChild = val Z: int new (a: int) = { inherit PrimaryCtorSelfBase(a, 2); Z = 4 } +type PrimaryCtorTypedFunctionBase(f: int -> int -> int, g: int * int -> int, h: (int -> int -> int) option) = + member _.F a b = f a b + member _.G a b = g (a, b) + member _.H a b = match h with Some h -> h a b | None -> -1 + +type PrimaryCtorTypedFunctionChild = + inherit PrimaryCtorTypedFunctionBase + val Z: int + new (f: int -> int -> int) = { inherit PrimaryCtorTypedFunctionBase(f, (fun (a, b) -> a * b), Some(fun a b -> a + b)); Z = 5 } + let tests = testList "Types" [ @@ -2265,4 +2275,11 @@ let tests = let child = PrimaryCtorSelfChild(3) child.Sum |> equal 32 child.Z |> equal 4 + + testCase "Explicit constructor passes curried, tupled and optional functions to a base primary constructor" <| fun () -> + let child = PrimaryCtorTypedFunctionChild(fun a b -> a - b) + child.F 5 2 |> equal 3 + child.G 3 4 |> equal 12 + child.H 3 4 |> equal 7 + child.Z |> equal 5 ] diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index 57e11b5390..59db73bcdd 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2226,6 +2226,16 @@ type PrimaryCtorSelfChild = val Z: int new (a: int) = { inherit PrimaryCtorSelfBase(a, 2); Z = 4 } +type PrimaryCtorTypedFunctionBase(f: int -> int -> int, g: int * int -> int, h: (int -> int -> int) option) = + member _.F a b = f a b + member _.G a b = g (a, b) + member _.H a b = match h with Some h -> h a b | None -> -1 + +type PrimaryCtorTypedFunctionChild = + inherit PrimaryCtorTypedFunctionBase + val Z: int + new (f: int -> int -> int) = { inherit PrimaryCtorTypedFunctionBase(f, (fun (a, b) -> a * b), Some(fun a b -> a + b)); Z = 5 } + [] let ``test explicit constructor calls a base primary constructor`` () = let child = PrimaryCtorValChild(3, "origin") @@ -2324,3 +2334,11 @@ let ``test explicit constructor accepts base primary constructor arguments named let child = PrimaryCtorSelfChild(3) child.Sum |> equal 32 child.Z |> equal 4 + +[] +let ``test explicit constructor passes curried, tupled and optional functions to a base primary constructor`` () = + let child = PrimaryCtorTypedFunctionChild(fun a b -> a - b) + child.F 5 2 |> equal 3 + child.G 3 4 |> equal 12 + child.H 3 4 |> equal 7 + child.Z |> equal 5 From 23a56dde927490d62f4a60b3af2e968eb72f946c Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 12:28:15 +0100 Subject: [PATCH 08/16] fix(js/ts/python): uncurry base args like the base ctor --- src/Fable.Transforms/FSharp2Fable.Util.fs | 7 +++++++ src/Fable.Transforms/FableTransforms.fs | 13 +++++++++---- tests/Js/Main/TypeTests.fs | 15 +++++++++++++++ tests/Python/TestType.fs | 16 ++++++++++++++++ 4 files changed, 47 insertions(+), 4 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index b6c4b741a3..6a27775ad0 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -2570,6 +2570,13 @@ module Util = makeTypedIdentExpr typ name ) + let tryGetPrimaryConstructorBaseArgTypes (ent: Fable.Entity) = + match ent with + | :? FsEnt as ent -> + tryGetPrimaryConstructorBase ent.FSharpEntity + |> Option.map (fun (_, _, cons) -> getArgTypes () cons) + | _ -> None + /// We can add a suffix to the entity name for special methods, like reflection declaration let entityIdentWithSuffix (com: Compiler) (ent: Fable.EntityRef) suffix = let error msg = diff --git a/src/Fable.Transforms/FableTransforms.fs b/src/Fable.Transforms/FableTransforms.fs index 0e3081a7d1..90e05f102f 100644 --- a/src/Fable.Transforms/FableTransforms.fs +++ b/src/Fable.Transforms/FableTransforms.fs @@ -877,15 +877,20 @@ module private Transforms = Emit({ emitInfo with CallInfo = { callInfo with Args = args } }, t, r) // Uncurry also values in setters or new record/union/tuple | Value(NewRecord(args, ent, genArgs), r) -> + let entity = com.GetEntity(ent) + let fieldTypes = - com.GetEntity(ent).FSharpFields + entity.FSharpFields |> List.filter (fun f -> not f.IsStatic) |> List.map (fun f -> f.FieldType) let baseArgTypes = - args - |> List.take (max 0 (args.Length - fieldTypes.Length)) - |> List.map (fun a -> a.Type) + match args.Length - fieldTypes.Length with + | baseArgCount when baseArgCount > 0 -> + match FSharp2Fable.Util.tryGetPrimaryConstructorBaseArgTypes entity with + | Some argTypes -> argTypes @ List.replicate baseArgCount Any |> List.take baseArgCount + | None -> args |> List.take baseArgCount |> List.map (fun a -> a.Type) + | _ -> [] let args = uncurryArgs com false (baseArgTypes @ fieldTypes) args diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index 4a7a9a2ddb..26cd705f35 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1137,6 +1137,15 @@ type PrimaryCtorTypedFunctionChild = val Z: int new (f: int -> int -> int) = { inherit PrimaryCtorTypedFunctionBase(f, (fun (a, b) -> a * b), Some(fun a b -> a + b)); Z = 5 } +type PrimaryCtorGenericFunctionBase<'T>(v: 'T, f: int -> int -> 'T) = + member _.V = v + member _.F a b = f a b + +type PrimaryCtorGenericFunctionChild = + inherit PrimaryCtorGenericFunctionBase int -> int> + val Z: int + new () = { inherit PrimaryCtorGenericFunctionBase int -> int>((fun a b -> a * 10 + b), (fun a b c d -> a + b + c * d)); Z = 1 } + let tests = testList "Types" [ @@ -2282,4 +2291,10 @@ let tests = child.G 3 4 |> equal 12 child.H 3 4 |> equal 7 child.Z |> equal 5 + + testCase "Explicit constructor keeps functions passed to a generic base primary constructor parameter curried" <| fun () -> + let child = PrimaryCtorGenericFunctionChild() + child.V 1 2 |> equal 12 + child.F 1 2 3 4 |> equal 15 + child.Z |> equal 1 ] diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index 59db73bcdd..036031d827 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2236,6 +2236,15 @@ type PrimaryCtorTypedFunctionChild = val Z: int new (f: int -> int -> int) = { inherit PrimaryCtorTypedFunctionBase(f, (fun (a, b) -> a * b), Some(fun a b -> a + b)); Z = 5 } +type PrimaryCtorGenericFunctionBase<'T>(v: 'T, f: int -> int -> 'T) = + member _.V = v + member _.F a b = f a b + +type PrimaryCtorGenericFunctionChild = + inherit PrimaryCtorGenericFunctionBase int -> int> + val Z: int + new () = { inherit PrimaryCtorGenericFunctionBase int -> int>((fun a b -> a * 10 + b), (fun a b c d -> a + b + c * d)); Z = 1 } + [] let ``test explicit constructor calls a base primary constructor`` () = let child = PrimaryCtorValChild(3, "origin") @@ -2342,3 +2351,10 @@ let ``test explicit constructor passes curried, tupled and optional functions to child.G 3 4 |> equal 12 child.H 3 4 |> equal 7 child.Z |> equal 5 + +[] +let ``test explicit constructor keeps functions passed to a generic base primary constructor parameter curried`` () = + let child = PrimaryCtorGenericFunctionChild() + child.V 1 2 |> equal 12 + child.F 1 2 3 4 |> equal 15 + child.Z |> equal 1 From 097f5d22661ee4ab1e93d71dc104232713738f19 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 12:34:36 +0100 Subject: [PATCH 09/16] fix(python): type field ctor args as uncurried --- src/Fable.Transforms/Python/Fable2Python.Transforms.fs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Fable.Transforms/Python/Fable2Python.Transforms.fs b/src/Fable.Transforms/Python/Fable2Python.Transforms.fs index ab8becf839..83ef5f0828 100644 --- a/src/Fable.Transforms/Python/Fable2Python.Transforms.fs +++ b/src/Fable.Transforms/Python/Fable2Python.Transforms.fs @@ -4579,7 +4579,12 @@ let transformClassWithCompilerGeneratedConstructor ] let args = - baseFieldIds @ Array.toList fieldIds + let fieldIds = + fieldIds + |> Array.toList + |> List.map (fun id -> { id with Type = FableTransforms.uncurryType id.Type }) + + baseFieldIds @ fieldIds |> List.map (fun id -> let ta, _ = Annotation.typeAnnotation com ctx None id.Type Arg.arg (ident com ctx id, annotation = ta) From f1825659765c270090701f767e3d48b0dea1ed30 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 17:39:39 +0100 Subject: [PATCH 10/16] fix(js/ts/python): pass DefaultValue fields with base args --- src/Fable.Transforms/FSharp2Fable.fs | 1 + tests/Js/Main/TypeTests.fs | 13 +++++++++++++ 2 files changed, 14 insertions(+) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 603356195d..33b9baf2ec 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -1782,6 +1782,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs let baseArgs = baseArgs @ omittedBaseArgs let! ownArgs = transformExprList com ctx ownArgs + let ownArgs = withDefaultValueFields com ctx fsType ownArgs let genArgs = makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType) let entRef = FsEnt.Ref fsType.TypeDefinition entRef.SourcePath |> Option.iter com.AddSignatureDependency diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index 26cd705f35..3ea3933cb4 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1100,6 +1100,12 @@ type PrimaryCtorFunctionChild = val G: int -> int -> int new (n: int, g: int -> int -> int) = { inherit PrimaryCtorFunctionBase(fun a b -> a + b + n); G = g } +type PrimaryCtorDefaultValueChild = + inherit PrimaryCtorFunctionBase + val G: int -> int -> int + [] val mutable D: int + new (g: int -> int -> int) = { inherit PrimaryCtorFunctionBase(fun a b -> a + b); G = g } + type ValClassFunctionBase = val F: int -> int -> int new (f) = { F = f } @@ -2267,6 +2273,13 @@ let tests = child.Apply 2 3 |> equal 6 child.G 2 3 |> equal 6 + testCase "Explicit constructor passes base arguments next to a DefaultValue field" <| fun () -> + let child = PrimaryCtorDefaultValueChild(fun a b -> a * b) + child.D <- 7 + child.Apply 2 3 |> equal 5 + child.G 5 2 |> equal 10 + child.D |> equal 7 + testCase "Explicit constructor copies inherited function fields" <| fun () -> let child = ValClassFunctionChild((fun a b -> a - b), (fun a b -> a * b)) child.F 5 2 |> equal 3 From 18e74fa860fd389b7f070c83c88e16ef8ca5d0e1 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 18:27:57 +0100 Subject: [PATCH 11/16] fix(js/ts/python): keep object expression fields aligned --- src/Fable.Transforms/FSharp2Fable.fs | 34 +++++++++++++++++++++++++++- tests/Js/Main/TypeTests.fs | 19 ++++++++++++++++ 2 files changed, 52 insertions(+), 1 deletion(-) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 33b9baf2ec..5e3b3613db 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -528,7 +528,39 @@ let private transformObjExpr checkSelfConstructorBase com ctx r baseEnt let genArgs = genArgs1 @ genArgs2 - return transformBaseConsCall com ctx r baseEnt baseCall genArgs baseArgs |> Some + let baseCallExpr = transformBaseConsCall com ctx r baseEnt baseCall genArgs baseArgs + + match baseCallExpr, tryGetPrimaryConstructorBase baseEnt with + | Fable.Call(callee, info, t, r), Some(primaryBaseEnt, primaryBaseGenArgs, primaryCons) when + not baseCall.IsImplicitConstructor + && supportsCompilerGeneratedBaseCall com + && hasCompilerGeneratedConstructor baseEnt + -> + let primaryBaseParams = + getPrimaryConstructorBaseArgs com baseEnt primaryBaseEnt primaryBaseGenArgs primaryCons + + let primaryBaseArgs = + primaryBaseParams + |> List.map (fun param -> + match param.Type with + | Fable.Option(genArg, isStruct) -> + Fable.Value(Fable.NewOption(None, genArg, isStruct), None) + | t -> Replacements.Api.defaultof com ctx None t + ) + + let sigArgTypes = + match info.SignatureArgTypes with + | [] -> [] + | argTypes -> (primaryBaseParams |> List.map _.Type) @ argTypes + + let info = + { info with + Args = primaryBaseArgs @ info.Args + SignatureArgTypes = sigArgTypes + } + + return Fable.Call(callee, info, t, r) |> Some + | _ -> return Some baseCallExpr | _ -> return None | _ -> return None } diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index 3ea3933cb4..c2f00eca72 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1106,6 +1106,20 @@ type PrimaryCtorDefaultValueChild = [] val mutable D: int new (g: int -> int -> int) = { inherit PrimaryCtorFunctionBase(fun a b -> a + b); G = g } +type PrimaryCtorVirtualBase(name: string) = + abstract Calc: int -> int + default _.Calc a = a + member _.Name = name + +type PrimaryCtorVirtualChild = + inherit PrimaryCtorVirtualBase + val K: int + val F: int -> int -> int + new (k, f) = { inherit PrimaryCtorVirtualBase("base"); K = k; F = f } + override this.Calc a = a * this.K + +let multiplyInts (a: int) (b: int) = a * b + type ValClassFunctionBase = val F: int -> int -> int new (f) = { F = f } @@ -2280,6 +2294,11 @@ let tests = child.G 5 2 |> equal 10 child.D |> equal 7 + testCase "Object expression over an explicit constructor passes its own fields" <| fun () -> + let o = { new PrimaryCtorVirtualChild(3, multiplyInts) with override this.Calc a = a + this.K * 100 } + o.Calc 1 |> equal 301 + o.F 2 3 |> equal 6 + testCase "Explicit constructor copies inherited function fields" <| fun () -> let child = ValClassFunctionChild((fun a b -> a - b), (fun a b -> a * b)) child.F 5 2 |> equal 3 From fd8b4352c82c458aae8ad90040c34e1be21c5e73 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 18:27:58 +0100 Subject: [PATCH 12/16] test(python): cover DefaultValue fields next to base args --- tests/Python/TestType.fs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index 036031d827..e3adf04107 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2199,6 +2199,12 @@ type PrimaryCtorFunctionChild = val G: int -> int -> int new (n: int, g: int -> int -> int) = { inherit PrimaryCtorFunctionBase(fun a b -> a + b + n); G = g } +type PrimaryCtorDefaultValueChild = + inherit PrimaryCtorFunctionBase + val G: int -> int -> int + [] val mutable D: int + new (g: int -> int -> int) = { inherit PrimaryCtorFunctionBase(fun a b -> a + b); G = g } + type ValClassFunctionBase = val F: int -> int -> int new (f) = { F = f } @@ -2322,6 +2328,14 @@ let ``test explicit constructor passes functions to a base primary constructor a child.Apply 2 3 |> equal 6 child.G 2 3 |> equal 6 +[] +let ``test explicit constructor passes base arguments next to a DefaultValue field`` () = + let child = PrimaryCtorDefaultValueChild(fun a b -> a * b) + child.D <- 7 + child.Apply 2 3 |> equal 5 + child.G 5 2 |> equal 10 + child.D |> equal 7 + [] let ``test explicit constructor copies inherited function fields`` () = let child = ValClassFunctionChild((fun a b -> a - b), (fun a b -> a * b)) From f3bbe6ee33df14cab1c4a496944478bb09666961 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 21:25:46 +0100 Subject: [PATCH 13/16] fix(js/ts/python): evaluate ctor fields after base --- src/Fable.Transforms/FSharp2Fable.fs | 46 +++++++++++++++++- tests/Js/Main/TypeTests.fs | 67 ++++++++++++++++++++++++++ tests/Python/TestType.fs | 70 ++++++++++++++++++++++++++++ 3 files changed, 182 insertions(+), 1 deletion(-) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 5e3b3613db..767d56d291 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -1819,7 +1819,51 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs let entRef = FsEnt.Ref fsType.TypeDefinition entRef.SourcePath |> Option.iter com.AddSignatureDependency - return Fable.NewRecord(baseArgs @ ownArgs, entRef, genArgs) |> makeValue r + if ownArgs |> List.exists (canHaveSideEffects com) then + let fields = + fsType.TypeDefinition.FSharpFields + |> Seq.filter (fun field -> not field.IsStatic) + |> List.ofSeq + + let placeholders = + ownArgs + |> List.map (fun arg -> + let typ = + match arg.Type with + | NestedLambdaType(argTypes, returnType) when argTypes.Length > 1 -> + Fable.DelegateType(argTypes, returnType) + | t -> t + + Replacements.Api.defaultof com ctx None typ + ) + + let instance = makeTypedIdent Fable.Any (getIdentUniqueName com ctx "instance") + + let fieldSets = + List.zip fields ownArgs + |> List.map (fun (field, arg) -> + Fable.Set( + Fable.IdentExpr instance, + Fable.FieldSet(FsField.FSharpFieldName field), + makeType Map.empty field.FieldType, + arg, + None + ) + ) + + let record = + Fable.NewRecord(baseArgs @ placeholders, entRef, genArgs) |> makeValue r + + let typ = makeType ctx.GenericArgs fsType + + return + Fable.Let( + instance, + record, + Fable.Sequential(fieldSets @ [ Fable.TypeCast(Fable.IdentExpr instance, typ) ]) + ) + else + return Fable.NewRecord(baseArgs @ ownArgs, entRef, genArgs) |> makeValue r | FSharpExprPatterns.Sequential(ConstructorCall(baseCons, _, _) as first, FSharpExprPatterns.NewRecord(fsType, ownArgs)) when diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index c2f00eca72..49dc92a9f8 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1166,6 +1166,47 @@ type PrimaryCtorGenericFunctionChild = val Z: int new () = { inherit PrimaryCtorGenericFunctionBase int -> int>((fun a b -> a * 10 + b), (fun a b c d -> a + b + c * d)); Z = 1 } +type PrimaryCtorNamedUnitBase(u: unit) = + member _.Unit = u + member val Value = 42 + +type PrimaryCtorNamedUnitChild = + inherit PrimaryCtorNamedUnitBase + val Count: int + new (count: int) = { inherit PrimaryCtorNamedUnitBase(()); Count = count } + +let primaryCtorOrderLog = ResizeArray() +let mutable primaryCtorOrderCounter = 0 + +let logPrimaryCtorOrder step value = + primaryCtorOrderLog.Add step + value + +let primaryCtorThrowingLog = ResizeArray() + +type PrimaryCtorOrderBase(n: int) = + do primaryCtorOrderLog.Add $"base body %d{n}" + do primaryCtorOrderCounter <- primaryCtorOrderCounter + 1 + +type PrimaryCtorOrderChild = + inherit PrimaryCtorOrderBase + val Snapshot: int + val Label: string + val Combine: int -> int -> int + new () = + { inherit PrimaryCtorOrderBase(logPrimaryCtorOrder "base arg" 7) + Snapshot = logPrimaryCtorOrder "Snapshot" primaryCtorOrderCounter + Label = logPrimaryCtorOrder "Label" "l" + Combine = logPrimaryCtorOrder "Combine" (fun a b -> a * 10 + b) } + +type PrimaryCtorThrowingBase(n: int) = + do failwith $"base failed %d{n}" + +type PrimaryCtorThrowingChild = + inherit PrimaryCtorThrowingBase + val X: int + new () = { inherit PrimaryCtorThrowingBase(1); X = (primaryCtorThrowingLog.Add "X"; 1) } + let tests = testList "Types" [ @@ -2329,4 +2370,30 @@ let tests = child.V 1 2 |> equal 12 child.F 1 2 3 4 |> equal 15 child.Z |> equal 1 + + testCase "Explicit constructor passes a named unit argument to a base primary constructor" <| fun () -> + let child = PrimaryCtorNamedUnitChild(3) + child.Count |> equal 3 + child.Value |> equal 42 + child.Unit |> equal () + + testCase "Explicit constructor evaluates its field values after the base primary constructor" <| fun () -> + primaryCtorOrderLog.Clear() + let counter = primaryCtorOrderCounter + let child = PrimaryCtorOrderChild() + List.ofSeq primaryCtorOrderLog |> equal [ "base arg"; "base body 7"; "Snapshot"; "Label"; "Combine" ] + child.Snapshot |> equal (counter + 1) + child.Label |> equal "l" + child.Combine 1 2 |> equal 12 + + testCase "Explicit constructor skips its field values when the base primary constructor throws" <| fun () -> + primaryCtorThrowingLog.Clear() + let failed = + try + PrimaryCtorThrowingChild() |> ignore + false + with _ -> + true + failed |> equal true + List.ofSeq primaryCtorThrowingLog |> equal [] ] diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index e3adf04107..aca4dd2182 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2251,6 +2251,47 @@ type PrimaryCtorGenericFunctionChild = val Z: int new () = { inherit PrimaryCtorGenericFunctionBase int -> int>((fun a b -> a * 10 + b), (fun a b c d -> a + b + c * d)); Z = 1 } +type PrimaryCtorNamedUnitBase(u: unit) = + member _.Unit = u + member val Value = 42 + +type PrimaryCtorNamedUnitChild = + inherit PrimaryCtorNamedUnitBase + val Count: int + new (count: int) = { inherit PrimaryCtorNamedUnitBase(()); Count = count } + +let primaryCtorOrderLog = ResizeArray() +let mutable primaryCtorOrderCounter = 0 + +let logPrimaryCtorOrder step value = + primaryCtorOrderLog.Add step + value + +let primaryCtorThrowingLog = ResizeArray() + +type PrimaryCtorOrderBase(n: int) = + do primaryCtorOrderLog.Add $"base body %d{n}" + do primaryCtorOrderCounter <- primaryCtorOrderCounter + 1 + +type PrimaryCtorOrderChild = + inherit PrimaryCtorOrderBase + val Snapshot: int + val Label: string + val Combine: int -> int -> int + new () = + { inherit PrimaryCtorOrderBase(logPrimaryCtorOrder "base arg" 7) + Snapshot = logPrimaryCtorOrder "Snapshot" primaryCtorOrderCounter + Label = logPrimaryCtorOrder "Label" "l" + Combine = logPrimaryCtorOrder "Combine" (fun a b -> a * 10 + b) } + +type PrimaryCtorThrowingBase(n: int) = + do failwith $"base failed %d{n}" + +type PrimaryCtorThrowingChild = + inherit PrimaryCtorThrowingBase + val X: int + new () = { inherit PrimaryCtorThrowingBase(1); X = (primaryCtorThrowingLog.Add "X"; 1) } + [] let ``test explicit constructor calls a base primary constructor`` () = let child = PrimaryCtorValChild(3, "origin") @@ -2372,3 +2413,32 @@ let ``test explicit constructor keeps functions passed to a generic base primary child.V 1 2 |> equal 12 child.F 1 2 3 4 |> equal 15 child.Z |> equal 1 + +[] +let ``test explicit constructor passes a named unit argument to a base primary constructor`` () = + let child = PrimaryCtorNamedUnitChild(3) + child.Count |> equal 3 + child.Value |> equal 42 + child.Unit |> equal () + +[] +let ``test explicit constructor evaluates its field values after the base primary constructor`` () = + primaryCtorOrderLog.Clear() + let counter = primaryCtorOrderCounter + let child = PrimaryCtorOrderChild() + List.ofSeq primaryCtorOrderLog |> equal [ "base arg"; "base body 7"; "Snapshot"; "Label"; "Combine" ] + child.Snapshot |> equal (counter + 1) + child.Label |> equal "l" + child.Combine 1 2 |> equal 12 + +[] +let ``test explicit constructor skips its field values when the base primary constructor throws`` () = + primaryCtorThrowingLog.Clear() + let failed = + try + PrimaryCtorThrowingChild() |> ignore + false + with _ -> + true + failed |> equal true + List.ofSeq primaryCtorThrowingLog |> equal [] From e1540b9cb7242d496464586753b57258fb48cf9c Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 22:24:31 +0100 Subject: [PATCH 14/16] fix(js/ts/python): handle reordered ctor fields --- src/Fable.Transforms/FSharp2Fable.fs | 109 ++++++++++++++---------- src/Fable.Transforms/FableTransforms.fs | 1 + tests/Js/Main/TypeTests.fs | 62 ++++++++++++++ tests/Python/TestType.fs | 87 +++++++++++++++++++ 4 files changed, 216 insertions(+), 43 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 767d56d291..b22ed611be 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -54,6 +54,36 @@ let private transformBaseConsCall | Some baseExpr -> baseExpr | None -> FsEnt.Ref baseEnt |> entityIdent com + let info = + match tryGetPrimaryConstructorBase baseEnt with + | Some(primaryBaseEnt, primaryBaseGenArgs, primaryCons) when + not baseCons.IsImplicitConstructor + && supportsCompilerGeneratedBaseCall com + && hasCompilerGeneratedConstructor baseEnt + -> + let primaryBaseParams = + getPrimaryConstructorBaseArgs com baseEnt primaryBaseEnt primaryBaseGenArgs primaryCons + + let primaryBaseArgs = + primaryBaseParams + |> List.map (fun param -> + match param.Type with + | Fable.Option(genArg, isStruct) -> + Fable.Value(Fable.NewOption(None, genArg, isStruct), None) + | t -> Replacements.Api.defaultof com ctx None t + ) + + let sigArgTypes = + match info.SignatureArgTypes with + | [] -> [] + | argTypes -> (primaryBaseParams |> List.map _.Type) @ argTypes + + { info with + Args = primaryBaseArgs @ info.Args + SignatureArgTypes = sigArgTypes + } + | _ -> info + Fable.Call(baseExpr, info, t, r) // Other cases, like Emit will call directly the base expression | e -> e @@ -528,39 +558,7 @@ let private transformObjExpr checkSelfConstructorBase com ctx r baseEnt let genArgs = genArgs1 @ genArgs2 - let baseCallExpr = transformBaseConsCall com ctx r baseEnt baseCall genArgs baseArgs - - match baseCallExpr, tryGetPrimaryConstructorBase baseEnt with - | Fable.Call(callee, info, t, r), Some(primaryBaseEnt, primaryBaseGenArgs, primaryCons) when - not baseCall.IsImplicitConstructor - && supportsCompilerGeneratedBaseCall com - && hasCompilerGeneratedConstructor baseEnt - -> - let primaryBaseParams = - getPrimaryConstructorBaseArgs com baseEnt primaryBaseEnt primaryBaseGenArgs primaryCons - - let primaryBaseArgs = - primaryBaseParams - |> List.map (fun param -> - match param.Type with - | Fable.Option(genArg, isStruct) -> - Fable.Value(Fable.NewOption(None, genArg, isStruct), None) - | t -> Replacements.Api.defaultof com ctx None t - ) - - let sigArgTypes = - match info.SignatureArgTypes with - | [] -> [] - | argTypes -> (primaryBaseParams |> List.map _.Type) @ argTypes - - let info = - { info with - Args = primaryBaseArgs @ info.Args - SignatureArgTypes = sigArgTypes - } - - return Fable.Call(callee, info, t, r) |> Some - | _ -> return Some baseCallExpr + return transformBaseConsCall com ctx r baseEnt baseCall genArgs baseArgs |> Some | _ -> return None | _ -> return None } @@ -774,6 +772,13 @@ let private transformUnionCaseTest return Fable.Test(unionExpr, Fable.UnionCaseTest(tag), r) } +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 + let private withDefaultValueFields (com: IFableCompiler) (ctx: Context) (fsType: FSharpType) (args: Fable.Expr list) = let ent = fsType.TypeDefinition @@ -1770,7 +1775,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs None args memb | FSharpExprPatterns.Sequential(ConstructorCall(baseCons, baseGenArgs, baseArgs), - FSharpExprPatterns.NewRecord(fsType, ownArgs)) when + BoundNewRecord(bindings, fsType, ownArgs)) when ctx.CaptureBaseConsCall.IsNone && supportsCompilerGeneratedBaseCall com && fsType.HasTypeDefinition @@ -1813,13 +1818,29 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs let baseArgs = baseArgs @ omittedBaseArgs + 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 bindings = List.rev bindings + + let withBindings body = + List.foldBack (fun (ident, value) body -> Fable.Let(ident, value, body)) bindings body + let! ownArgs = transformExprList com ctx ownArgs let ownArgs = withDefaultValueFields com ctx fsType ownArgs let genArgs = makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType) let entRef = FsEnt.Ref fsType.TypeDefinition entRef.SourcePath |> Option.iter com.AddSignatureDependency - if ownArgs |> List.exists (canHaveSideEffects com) then + if + ownArgs |> List.exists (canHaveSideEffects com) + || bindings |> List.exists (snd >> canHaveSideEffects com) + then let fields = fsType.TypeDefinition.FSharpFields |> Seq.filter (fun field -> not field.IsStatic) @@ -1828,13 +1849,11 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs let placeholders = ownArgs |> List.map (fun arg -> - let typ = - match arg.Type with - | NestedLambdaType(argTypes, returnType) when argTypes.Length > 1 -> - Fable.DelegateType(argTypes, returnType) - | t -> t - - Replacements.Api.defaultof com ctx None typ + match arg.Type with + | Fable.Option(genArg, isStruct) -> Fable.Value(Fable.NewOption(None, genArg, isStruct), None) + | NestedLambdaType(argTypes, returnType) when argTypes.Length > 1 -> + Replacements.Api.defaultof com ctx None (Fable.DelegateType(argTypes, returnType)) + | t -> Replacements.Api.defaultof com ctx None t ) let instance = makeTypedIdent Fable.Any (getIdentUniqueName com ctx "instance") @@ -1861,9 +1880,13 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs instance, record, Fable.Sequential(fieldSets @ [ Fable.TypeCast(Fable.IdentExpr instance, typ) ]) + |> withBindings ) else - return Fable.NewRecord(baseArgs @ ownArgs, entRef, genArgs) |> makeValue r + return + Fable.NewRecord(baseArgs @ ownArgs, entRef, genArgs) + |> makeValue r + |> withBindings | FSharpExprPatterns.Sequential(ConstructorCall(baseCons, _, _) as first, FSharpExprPatterns.NewRecord(fsType, ownArgs)) when diff --git a/src/Fable.Transforms/FableTransforms.fs b/src/Fable.Transforms/FableTransforms.fs index 90e05f102f..566de59f78 100644 --- a/src/Fable.Transforms/FableTransforms.fs +++ b/src/Fable.Transforms/FableTransforms.fs @@ -662,6 +662,7 @@ module private Transforms = Get(innerExpr, OptionValue, t, r) | Value(NewOption(Some(Extended(Curry(innerExpr, arity2), _)), t, isStruct), r), _ when matches arity arity2 -> Value(NewOption(Some(innerExpr), t, isStruct), r) + | Value(NewOption(None, _, _), _), _ -> expr // User imports are uncurried even if they're typed as lambdas, see test "ofImport should inline properly" | Import({ Kind = UserImport _ }, _, _), _ -> expr | _, Some arity -> Replacements.Api.uncurryExprAtRuntime com arity expr diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index 49dc92a9f8..d765453fa1 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1207,6 +1207,46 @@ type PrimaryCtorThrowingChild = val X: int new () = { inherit PrimaryCtorThrowingBase(1); X = (primaryCtorThrowingLog.Add "X"; 1) } +let primaryCtorOutOfOrderLog = ResizeArray() + +let logPrimaryCtorOutOfOrder step value = + primaryCtorOutOfOrderLog.Add step + value + +type PrimaryCtorOutOfOrderChild = + inherit PrimaryCtorBase + val P: int + val Q: int + new (a: int, b: int) = { inherit PrimaryCtorBase(a); Q = b + 1; P = a } + +type PrimaryCtorOutOfOrderLoggedBase(n: int) = + do primaryCtorOutOfOrderLog.Add $"base body %d{n}" + +type PrimaryCtorOutOfOrderLoggedChild = + inherit PrimaryCtorOutOfOrderLoggedBase + val X: int + val Y: int + new (a: int) = + { inherit PrimaryCtorOutOfOrderLoggedBase(logPrimaryCtorOutOfOrder "base arg" a) + Y = logPrimaryCtorOutOfOrder "Y" (a + 1) + X = logPrimaryCtorOutOfOrder "X" a } + +let passPrimaryCtorValue value = value + +type PrimaryCtorOptionFunctionChild = + inherit PrimaryCtorBase + val H: (int -> int -> int) option + new () = { inherit PrimaryCtorBase(1); H = passPrimaryCtorValue (Some(fun a b -> a * 10 + b)) } + +type PrimaryCtorExplicitMid = + inherit PrimaryCtorBase + val B: int + new (b) = { inherit PrimaryCtorBase(1); B = b } + +type PrimaryCtorOverExplicitLeaf(c: int) = + inherit PrimaryCtorExplicitMid(c) + member _.C = c + let tests = testList "Types" [ @@ -2396,4 +2436,26 @@ let tests = true failed |> equal true List.ofSeq primaryCtorThrowingLog |> equal [] + + testCase "Explicit constructor sets fields listed out of declaration order" <| fun () -> + let child = PrimaryCtorOutOfOrderChild(1, 2) + child.P |> equal 1 + child.Q |> equal 3 + child.Describe() |> equal "base:1" + + testCase "Explicit constructor evaluates fields listed out of declaration order after the base primary constructor" <| fun () -> + primaryCtorOutOfOrderLog.Clear() + let child = PrimaryCtorOutOfOrderLoggedChild(5) + List.ofSeq primaryCtorOutOfOrderLog |> equal [ "base arg"; "base body 5"; "Y"; "X" ] + child.X |> equal 5 + child.Y |> equal 6 + + testCase "Explicit constructor sets an option of a curried function computed after the base primary constructor" <| fun () -> + let child = PrimaryCtorOptionFunctionChild() + child.H.Value 1 2 |> equal 12 + + testCase "Primary constructor passes its arguments to an explicit base constructor over a primary constructor" <| fun () -> + let leaf = PrimaryCtorOverExplicitLeaf(4) + leaf.B |> equal 4 + leaf.C |> equal 4 ] diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index aca4dd2182..0ae3071246 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2292,6 +2292,60 @@ type PrimaryCtorThrowingChild = val X: int new () = { inherit PrimaryCtorThrowingBase(1); X = (primaryCtorThrowingLog.Add "X"; 1) } +type PrimaryCtorVirtualBase(name: string) = + abstract Calc: int -> int + default _.Calc a = a + member _.Name = name + +type PrimaryCtorVirtualChild = + inherit PrimaryCtorVirtualBase + val K: int + val F: int -> int -> int + new (k, f) = { inherit PrimaryCtorVirtualBase("base"); K = k; F = f } + override this.Calc a = a * this.K + +let multiplyInts (a: int) (b: int) = a * b + +let primaryCtorOutOfOrderLog = ResizeArray() + +let logPrimaryCtorOutOfOrder step value = + primaryCtorOutOfOrderLog.Add step + value + +type PrimaryCtorOutOfOrderChild = + inherit PrimaryCtorBase + val P: int + val Q: int + new (a: int, b: int) = { inherit PrimaryCtorBase(a); Q = b + 1; P = a } + +type PrimaryCtorOutOfOrderLoggedBase(n: int) = + do primaryCtorOutOfOrderLog.Add $"base body %d{n}" + +type PrimaryCtorOutOfOrderLoggedChild = + inherit PrimaryCtorOutOfOrderLoggedBase + val X: int + val Y: int + new (a: int) = + { inherit PrimaryCtorOutOfOrderLoggedBase(logPrimaryCtorOutOfOrder "base arg" a) + Y = logPrimaryCtorOutOfOrder "Y" (a + 1) + X = logPrimaryCtorOutOfOrder "X" a } + +let passPrimaryCtorValue value = value + +type PrimaryCtorOptionFunctionChild = + inherit PrimaryCtorBase + val H: (int -> int -> int) option + new () = { inherit PrimaryCtorBase(1); H = passPrimaryCtorValue (Some(fun a b -> a * 10 + b)) } + +type PrimaryCtorExplicitMid = + inherit PrimaryCtorBase + val B: int + new (b) = { inherit PrimaryCtorBase(1); B = b } + +type PrimaryCtorOverExplicitLeaf(c: int) = + inherit PrimaryCtorExplicitMid(c) + member _.C = c + [] let ``test explicit constructor calls a base primary constructor`` () = let child = PrimaryCtorValChild(3, "origin") @@ -2442,3 +2496,36 @@ let ``test explicit constructor skips its field values when the base primary con true failed |> equal true List.ofSeq primaryCtorThrowingLog |> equal [] + +[] +let ``test explicit constructor sets fields listed out of declaration order`` () = + let child = PrimaryCtorOutOfOrderChild(1, 2) + child.P |> equal 1 + child.Q |> equal 3 + child.Describe() |> equal "base:1" + +[] +let ``test explicit constructor evaluates fields listed out of declaration order after the base primary constructor`` () = + primaryCtorOutOfOrderLog.Clear() + let child = PrimaryCtorOutOfOrderLoggedChild(5) + List.ofSeq primaryCtorOutOfOrderLog |> equal [ "base arg"; "base body 5"; "Y"; "X" ] + child.X |> equal 5 + child.Y |> equal 6 + +[] +let ``test explicit constructor sets an option of a curried function computed after the base primary constructor`` () = + let child = PrimaryCtorOptionFunctionChild() + child.H.Value 1 2 |> equal 12 + +[] +let ``test primary constructor passes its arguments to an explicit base constructor over a primary constructor`` () = + let leaf = PrimaryCtorOverExplicitLeaf(4) + leaf.B |> equal 4 + leaf.C |> equal 4 + +[] +let ``test object expression over an explicit constructor passes its own fields`` () = + let o = { new PrimaryCtorVirtualChild(3, multiplyInts) with override _.ToString() = "o" } + o.Calc 1 |> equal 3 + o.F 2 3 |> equal 6 + string o |> equal "o" From 2e6155a314952f49683387be56d45426e4465707 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Thu, 5 Nov 2026 23:21:20 +0100 Subject: [PATCH 15/16] fix(all): keep the option type when uncurrying None --- src/Fable.Transforms/FableTransforms.fs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Fable.Transforms/FableTransforms.fs b/src/Fable.Transforms/FableTransforms.fs index 566de59f78..425e8b97cb 100644 --- a/src/Fable.Transforms/FableTransforms.fs +++ b/src/Fable.Transforms/FableTransforms.fs @@ -662,7 +662,9 @@ module private Transforms = Get(innerExpr, OptionValue, t, r) | Value(NewOption(Some(Extended(Curry(innerExpr, arity2), _)), t, isStruct), r), _ when matches arity arity2 -> Value(NewOption(Some(innerExpr), t, isStruct), r) - | Value(NewOption(None, _, _), _), _ -> expr + | Value(NewOption(None, (LambdaType _ as t), isStruct), r), Some arity -> + let argTypes, returnType = uncurryLambdaType arity [] t + Value(NewOption(None, DelegateType(argTypes, returnType), isStruct), r) // User imports are uncurried even if they're typed as lambdas, see test "ofImport should inline properly" | Import({ Kind = UserImport _ }, _, _), _ -> expr | _, Some arity -> Replacements.Api.uncurryExprAtRuntime com arity expr From 49f0a3d262f0c70b4c1f727d0ae2439f4b022857 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Sat, 7 Nov 2026 12:12:17 +0100 Subject: [PATCH 16/16] fix(js/ts/python): run then blocks over primary bases --- src/Fable.Transforms/FSharp2Fable.fs | 42 ++++++++++-- .../Compiler/CompilerMessagesTests.fs | 4 +- tests/Js/Main/TypeTests.fs | 64 ++++++++++++++++++ tests/Python/TestType.fs | 67 +++++++++++++++++++ 4 files changed, 170 insertions(+), 7 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index b22ed611be..134ca17bd5 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -779,6 +779,16 @@ let rec private (|BoundNewRecord|_|) (e: FSharpExpr) = Some((var, value) :: bindings, fsType, args) | _ -> None +// With a base, F# puts the `then` writes on self, such as `init@`, after the record +let rec private (|BoundNewRecordThen|_|) (e: FSharpExpr) = + match e with + | BoundNewRecord(bindings, fsType, args) -> Some(bindings, fsType, args, []) + | FSharpExprPatterns.Sequential(BoundNewRecordThen(bindings, fsType, args, rest), next) -> + Some(bindings, fsType, args, rest @ [ next ]) + | FSharpExprPatterns.Let((var, value, _), BoundNewRecordThen(bindings, fsType, args, rest)) -> + Some((var, value) :: bindings, fsType, args, rest) + | _ -> None + let private withDefaultValueFields (com: IFableCompiler) (ctx: Context) (fsType: FSharpType) (args: Fable.Expr list) = let ent = fsType.TypeDefinition @@ -931,7 +941,11 @@ let private (|ExplicitConstructorThen|_|) com (ctx: Context) (fsExpr: FSharpExpr && not m.IsImplicitConstructor && supportsCompilerGeneratedBaseCall com && m.DeclaringEntity - |> Option.exists (fun ent -> (tryGetBaseEntity ent).IsNone && not (isAttachMembersEntity com ent)) + |> Option.exists (fun ent -> + not (isAttachMembersEntity com ent) + && ((tryGetBaseEntity ent).IsNone + || hasCompilerGeneratedConstructor ent && (tryGetPrimaryConstructorBase ent).IsSome) + ) -> let isCreated (e: FSharpExpr) = e.Type.HasTypeDefinition @@ -1151,7 +1165,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs match ctx.BoundConstructorThis with | Some i -> identWithRange r i |> Fable.IdentExpr | None -> - "This explicit constructor uses a self identifier (`new() as x`), which Fable only supports on JavaScript, TypeScript and Python, in a class with no base class and without []." + "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, has a primary constructor." |> addErrorAndReturnNull com ctx.InlinePath r | FSharpExprPatterns.Value var -> @@ -1775,11 +1789,12 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs None args memb | FSharpExprPatterns.Sequential(ConstructorCall(baseCons, baseGenArgs, baseArgs), - BoundNewRecord(bindings, fsType, ownArgs)) when + BoundNewRecordThen(bindings, fsType, ownArgs, thenExprs)) when ctx.CaptureBaseConsCall.IsNone && supportsCompilerGeneratedBaseCall com && fsType.HasTypeDefinition && hasCompilerGeneratedConstructor fsType.TypeDefinition + && (thenExprs.IsEmpty || not (isAttachMembersEntity com fsType.TypeDefinition)) && ( match baseCons.DeclaringEntity, tryGetPrimaryConstructorBase fsType.TypeDefinition with | Some callee, Some(baseEnt, _, _) -> callee = baseEnt @@ -1832,11 +1847,27 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs List.foldBack (fun (ident, value) body -> Fable.Let(ident, value, body)) bindings body let! ownArgs = transformExprList com ctx ownArgs - let ownArgs = withDefaultValueFields com ctx fsType ownArgs + + let ownArgs = + withDefaultValueFields com ctx fsType ownArgs + |> withOmittedFieldDefaults com ctx fsType + let genArgs = makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType) let entRef = FsEnt.Ref fsType.TypeDefinition entRef.SourcePath |> Option.iter com.AddSignatureDependency + let thisIdent = + getIdentUniqueName com ctx "this" + |> makeTypedIdent (makeType ctx.GenericArgs fsType) + + let! thenExprs = + transformExprList com { ctx with BoundConstructorThis = Some thisIdent } thenExprs + + let withThen created = + match thenExprs with + | [] -> created + | _ -> Fable.Let(thisIdent, created, Fable.Sequential(thenExprs @ [ Fable.IdentExpr thisIdent ])) + if ownArgs |> List.exists (canHaveSideEffects com) || bindings |> List.exists (snd >> canHaveSideEffects com) @@ -1879,13 +1910,14 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs Fable.Let( instance, record, - Fable.Sequential(fieldSets @ [ Fable.TypeCast(Fable.IdentExpr instance, typ) ]) + Fable.Sequential(fieldSets @ [ Fable.TypeCast(Fable.IdentExpr instance, typ) |> withThen ]) |> withBindings ) else return Fable.NewRecord(baseArgs @ ownArgs, entRef, genArgs) |> makeValue r + |> withThen |> withBindings | FSharpExprPatterns.Sequential(ConstructorCall(baseCons, _, _) as first, diff --git a/tests/Integration/Compiler/CompilerMessagesTests.fs b/tests/Integration/Compiler/CompilerMessagesTests.fs index cb41a1bf4b..be0816b933 100644 --- a/tests/Integration/Compiler/CompilerMessagesTests.fs +++ b/tests/Integration/Compiler/CompilerMessagesTests.fs @@ -107,7 +107,7 @@ type Derived = |> Assert.Exists.errorWith "uses a self identifier" |> ignore - testCase "Self identifier with a primary constructor base results in error" <| fun _ -> + testCase "Self identifier with a primary constructor base compiles" <| fun _ -> let source = """ type Base(a: int) = @@ -119,7 +119,7 @@ type Derived = 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" + |> Assert.Is.strictSuccess |> ignore testCase "Self identifier with a BCL base results in error" <| fun _ -> diff --git a/tests/Js/Main/TypeTests.fs b/tests/Js/Main/TypeTests.fs index d765453fa1..2ee949a34c 100644 --- a/tests/Js/Main/TypeTests.fs +++ b/tests/Js/Main/TypeTests.fs @@ -1247,6 +1247,48 @@ type PrimaryCtorOverExplicitLeaf(c: int) = inherit PrimaryCtorExplicitMid(c) member _.C = c +let primaryCtorThenLog = ResizeArray() +let primaryCtorThenSaved = ResizeArray() + +type PrimaryCtorThenBase(a: int) = + do primaryCtorThenLog.Add "base" + member _.A = a + +type PrimaryCtorThenChild = + inherit PrimaryCtorThenBase + val X: int + val Y: string + new (n: int) = + let v = n + 1 + { inherit PrimaryCtorThenBase((primaryCtorThenLog.Add "arg"; v)); Y = (primaryCtorThenLog.Add "y"; "y"); X = (primaryCtorThenLog.Add "x"; v * 2) } + then primaryCtorThenLog.Add "then" + +type PrimaryCtorThenSelfChild = + inherit PrimaryCtorThenBase + val mutable X: int + new (x: int) as self = { inherit PrimaryCtorThenBase(x); X = x } then primaryCtorThenSaved.Add(box self); self.X <- self.X + self.A + new () as self = PrimaryCtorThenSelfChild(7) then self.X <- self.X * 2; primaryCtorThenSaved.Add(box self) + +type PrimaryCtorThenGenericBase<'T>(a: 'T) = + member _.A = a + +type PrimaryCtorThenGenericChild<'T> = + inherit PrimaryCtorThenGenericBase<'T> + val mutable Items: 'T list + new (a: 'T) as self = { inherit PrimaryCtorThenGenericBase<'T>(a); Items = [] } then self.Items <- [ self.A; a ] + +type PrimaryCtorThenSelfBase(a: int) as this = + let mutable touched = 0 + do this.Touch() + member _.A = a + member _.Touched = touched + member _.Touch() = touched <- touched + 1 + +type PrimaryCtorThenSelfBaseChild = + inherit PrimaryCtorThenSelfBase + val X: int + new () = { inherit PrimaryCtorThenSelfBase(1); X = 2 } + let tests = testList "Types" [ @@ -2458,4 +2500,26 @@ let tests = let leaf = PrimaryCtorOverExplicitLeaf(4) leaf.B |> equal 4 leaf.C |> equal 4 + + testCase "Explicit constructor runs its then block after a base primary constructor" <| fun () -> + primaryCtorThenLog.Clear() + let c = PrimaryCtorThenChild(1) + (c.A, c.X, c.Y) |> equal (2, 4, "y") + List.ofSeq primaryCtorThenLog |> equal [ "arg"; "base"; "y"; "x"; "then" ] + + testCase "Explicit constructor with a self identifier works with a base primary constructor" <| fun () -> + primaryCtorThenSaved.Clear() + let a = PrimaryCtorThenSelfChild(3) + (a.A, a.X) |> equal (3, 6) + obj.ReferenceEquals(primaryCtorThenSaved.[0], a) |> equal true + let b = PrimaryCtorThenSelfChild() + (b.A, b.X) |> equal (7, 28) + obj.ReferenceEquals(primaryCtorThenSaved.[1], b) |> equal true + obj.ReferenceEquals(primaryCtorThenSaved.[2], b) |> equal true + let g = PrimaryCtorThenGenericChild("q") + g.Items |> equal [ "q"; "q" ] + + testCase "Explicit constructor works with a base primary constructor that has a self identifier" <| fun () -> + let c = PrimaryCtorThenSelfBaseChild() + (c.A, c.Touched, c.X) |> equal (1, 1, 2) ] diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index 0ae3071246..60f9a40225 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -2529,3 +2529,70 @@ let ``test object expression over an explicit constructor passes its own fields` o.Calc 1 |> equal 3 o.F 2 3 |> equal 6 string o |> equal "o" + +let primaryCtorThenLog = ResizeArray() +let primaryCtorThenSaved = ResizeArray() + +type PrimaryCtorThenBase(a: int) = + do primaryCtorThenLog.Add "base" + member _.A = a + +type PrimaryCtorThenChild = + inherit PrimaryCtorThenBase + val X: int + val Y: string + new (n: int) = + let v = n + 1 + { inherit PrimaryCtorThenBase((primaryCtorThenLog.Add "arg"; v)); Y = (primaryCtorThenLog.Add "y"; "y"); X = (primaryCtorThenLog.Add "x"; v * 2) } + then primaryCtorThenLog.Add "then" + +type PrimaryCtorThenSelfChild = + inherit PrimaryCtorThenBase + val mutable X: int + new (x: int) as self = { inherit PrimaryCtorThenBase(x); X = x } then primaryCtorThenSaved.Add(box self); self.X <- self.X + self.A + new () as self = PrimaryCtorThenSelfChild(7) then self.X <- self.X * 2; primaryCtorThenSaved.Add(box self) + +type PrimaryCtorThenGenericBase<'T>(a: 'T) = + member _.A = a + +type PrimaryCtorThenGenericChild<'T> = + inherit PrimaryCtorThenGenericBase<'T> + val mutable Items: 'T list + new (a: 'T) as self = { inherit PrimaryCtorThenGenericBase<'T>(a); Items = [] } then self.Items <- [ self.A; a ] + +type PrimaryCtorThenSelfBase(a: int) as this = + let mutable touched = 0 + do this.Touch() + member _.A = a + member _.Touched = touched + member _.Touch() = touched <- touched + 1 + +type PrimaryCtorThenSelfBaseChild = + inherit PrimaryCtorThenSelfBase + val X: int + new () = { inherit PrimaryCtorThenSelfBase(1); X = 2 } + +[] +let ``test explicit constructor runs its then block after a base primary constructor`` () = + primaryCtorThenLog.Clear() + let c = PrimaryCtorThenChild(1) + (c.A, c.X, c.Y) |> equal (2, 4, "y") + List.ofSeq primaryCtorThenLog |> equal [ "arg"; "base"; "y"; "x"; "then" ] + +[] +let ``test explicit constructor with a self identifier works with a base primary constructor`` () = + primaryCtorThenSaved.Clear() + let a = PrimaryCtorThenSelfChild(3) + (a.A, a.X) |> equal (3, 6) + obj.ReferenceEquals(primaryCtorThenSaved.[0], a) |> equal true + let b = PrimaryCtorThenSelfChild() + (b.A, b.X) |> equal (7, 28) + obj.ReferenceEquals(primaryCtorThenSaved.[1], b) |> equal true + obj.ReferenceEquals(primaryCtorThenSaved.[2], b) |> equal true + let g = PrimaryCtorThenGenericChild("q") + g.Items |> equal [ "q"; "q" ] + +[] +let ``test explicit constructor works with a base primary constructor that has a self identifier`` () = + let c = PrimaryCtorThenSelfBaseChild() + (c.A, c.Touched, c.X) |> equal (1, 1, 2)