fix(js/ts/python): call base ctor from explicit constructors

src/Fable.Transforms/Babel/Fable2Babel.fs

@@ -4439,6 +4439,18 @@ but thanks to the optimisation done below we get
 
             declareType com ctx ent entName doc args body baseExpr classMembers
 
+    let baseCallIdents (baseCall: Fable.Expr option) =
+        match baseCall with
+        | Some(Fable.Call(_, info, _, _)) ->
+            info.Args
+            |> List.choose (
+                function
+                | Fable.IdentExpr id -> Some id
+                | _ -> None
+            )
+            |> List.toArray
+        | _ -> [||]
+
     let transformClassWithCompilerGeneratedConstructor
         (com: IBabelCompiler)
         ctx
@@ -4450,19 +4462,25 @@ but thanks to the optimisation done below we get
         let fieldIds = getEntityFieldsAsIdents ent |> List.toArray
         let args = fieldIds |> Array.map identAsExpr
 
-        let baseExpr =
+        let baseExpr, superArgs, baseFieldIds =
             if ent.IsFSharpExceptionDeclaration then
-                libValue com ctx "Types" "FSharpException" |> SuperExpression |> Some
+                libValue com ctx "Types" "FSharpException" |> SuperExpression |> Some, [], [||]
             elif ent.IsFSharpRecord || ent.IsValueType then
-                libValue com ctx "Types" "Record" |> SuperExpression |> Some
+                libValue com ctx "Types" "Record" |> SuperExpression |> Some, [], [||]
             else
-                None
+                let baseType =
+                    ent.BaseType
+                    |> Option.map (fun d -> Fable.DeclaredType(d.Entity, d.GenericArgs))
+
+                match extractSuperClassFromBaseCall com ctx baseType decl.BaseCall with
+                | Some(baseExpr, superArgs) -> Some baseExpr, superArgs, baseCallIdents decl.BaseCall
+                | None -> None, [], [||]
 
         let body =
             BlockStatement(
                 [|
                     if Option.isSome baseExpr then
-                        yield callSuperAsStatement []
+                        yield callSuperAsStatement superArgs
                     yield!
                         ent.FSharpFields
                         |> List.filter (fun field -> not field.IsStatic)
@@ -4478,7 +4496,7 @@ but thanks to the optimisation done below we get
             )
 
         let args =
-            fieldIds
+            Array.append baseFieldIds fieldIds
             |> Array.map (fun fi ->
                 Parameter.parameter (fi.Name, ?typeAnnotation = makeFieldAnnotationIfTypeScript com ctx fi.Type)
             )

src/Fable.Transforms/FSharp2Fable.Util.fs

@@ -2421,6 +2421,52 @@ module Util =
     let getGenParamNames (types: Fable.Type list) : string list = getGenParams types |> List.map fst
     let getGenParamTypes (types: Fable.Type list) : Fable.Type list = getGenParams types |> List.map snd
 
+    let supportsCompilerGeneratedBaseCall (com: Compiler) =
+        match com.Options.Language with
+        | JavaScript
+        | TypeScript
+        | Python -> true
+        | _ -> false
+
+    /// A class without a primary constructor gets a compiler-generated one that takes its fields
+    let hasCompilerGeneratedConstructor (ent: FSharpEntity) =
+        ent.IsClass
+        && not ent.IsFSharpExceptionDeclaration
+        && not ent.IsValueType
+        && not (isGlobalOrImportedFSharpEntity ent)
+        && (FsEnt.Ref ent).SourcePath.IsSome
+        && not (ent.MembersFunctionsAndValues |> Seq.exists _.IsImplicitConstructor)
+
+    /// Base classes with compiler-generated constructors, root first, or None when a base has a primary constructor
+    let rec tryGetCompilerGeneratedBases (ent: FSharpEntity) : FSharpEntity list option =
+        match tryGetBaseEntity ent with
+        | None -> Some []
+        | Some(baseEnt, _) when hasCompilerGeneratedConstructor baseEnt ->
+            tryGetCompilerGeneratedBases baseEnt
+            |> Option.map (fun bases -> bases @ [ baseEnt ])
+        | Some _ -> None
+
+    /// Inherited val fields root first, with the base generic arguments resolved through the chain
+    let getInheritedValFields (ent: FSharpEntity) (genArgs: Map<string, Fable.Type>) =
+        let rec collect (ent: FSharpEntity) genArgs acc =
+            match tryGetBaseEntity ent with
+            | Some(baseEnt, baseGenArgs) when hasCompilerGeneratedConstructor baseEnt ->
+                let baseGenArgs =
+                    Seq.zip baseEnt.GenericParameters baseGenArgs
+                    |> Seq.map (fun (param, typ) -> genParamName param, makeType genArgs typ)
+                    |> Map.ofSeq
+
+                let fields =
+                    baseEnt.FSharpFields
+                    |> Seq.filter (fun field -> not field.IsStatic)
+                    |> Seq.map (fun field -> field, makeType baseGenArgs field.FieldType)
+                    |> List.ofSeq
+
+                collect baseEnt baseGenArgs (fields @ acc)
+            | _ -> acc
+
+        collect ent genArgs []
+
     /// 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 =
@@ -2439,6 +2485,27 @@ 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))
+            | _ -> 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,

src/Fable.Transforms/FSharp2Fable.fs

@@ -1578,6 +1578,38 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs
 
             return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs None args memb
 
+        | FSharpExprPatterns.Sequential(ConstructorCall(baseCons, _, _) as first,
+                                        FSharpExprPatterns.NewRecord(fsType, ownArgs)) when
+            ctx.CaptureBaseConsCall.IsNone
+            && supportsCompilerGeneratedBaseCall com
+            && fsType.HasTypeDefinition
+            && (
+                match baseCons.DeclaringEntity, tryGetBaseEntity fsType.TypeDefinition with
+                | Some callee, Some(baseEnt, _) -> callee = baseEnt
+                | _ -> false
+            )
+            && (tryGetCompilerGeneratedBases fsType.TypeDefinition
+                |> Option.exists (List.isEmpty >> not))
+            ->
+            let r = makeRangeFrom fsExpr
+            let! baseValue = transformExpr com ctx [] first
+            let! ownArgs = transformExprList com ctx ownArgs
+
+            let baseIdent = getIdentUniqueName com ctx "base" |> makeTypedIdent baseValue.Type
+
+            let inheritedArgs =
+                getInheritedValFields fsType.TypeDefinition ctx.GenericArgs
+                |> List.map (fun (field, typ) -> getFieldWith None typ (Fable.IdentExpr baseIdent) field.Name)
+
+            let genArgs = makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType)
+            let entRef = FsEnt.Ref fsType.TypeDefinition
+            entRef.SourcePath |> Option.iter com.AddSignatureDependency
+
+            let newRecord =
+                Fable.NewRecord(inheritedArgs @ ownArgs, entRef, genArgs) |> makeValue r
+
+            return Fable.Let(baseIdent, baseValue, newRecord)
+
         | FSharpExprPatterns.Sequential(first, second) ->
             let exprs =
                 match ctx.CaptureBaseConsCall with
@@ -2418,7 +2450,7 @@ let rec private transformDeclarations (com: FableCompiler) ctx fsDecls =
                                     Name = name
                                     Entity = entRef
                                     Constructor = None
-                                    BaseCall = None
+                                    BaseCall = tryMakeCompilerGeneratedBaseCall com fsEnt
                                     AttachedMembers = []
                                     Tags = Fable.Tags.empty
                                     XmlDoc = tryGetXmlDoc fsEnt.XmlDoc
@@ -3162,7 +3194,7 @@ let rec attachClassMembers (com: FableCompiler) =
         |> Option.map (fun members ->
             { decl with
                 Constructor = members.Cons
-                BaseCall = members.BaseCall
+                BaseCall = members.BaseCall |> Option.orElse decl.BaseCall
                 AttachedMembers = members.Members.ToArray() |> List.ofArray
             }
             |> Fable.ClassDeclaration

src/Fable.Transforms/FableTransforms.fs

@@ -1020,7 +1020,7 @@ let rec transformDeclaration transformations (com: Compiler) file decl =
 
         let cons, baseCall =
             match decl.Constructor, decl.BaseCall with
-            | None, _ -> None, None
+            | None, baseCall -> None, baseCall
             | Some cons, None -> uncurryMemberArgs cons |> transformMemberBody com |> Some, None
             | Some cons, Some baseCall ->
                 // In order to uncurry correctly the baseCall arguments,

src/Fable.Transforms/Python/Fable2Python.Transforms.fs

@@ -4498,6 +4498,7 @@ let transformClassWithCompilerGeneratedConstructor
     ctx
     (ent: Fable.Entity)
     (entName: string)
+    (baseCall: Fable.Expr option)
     classMembers
     (classAttributes: ClassAttributes)
     =
@@ -4512,18 +4513,34 @@ let transformClassWithCompilerGeneratedConstructor
     let isOptional =
         Helpers.isOptional fieldIds || ent.IsFSharpRecord || ent.IsValueType
 
-    let baseExpr =
+    let baseExpr, superArgs, baseFieldIds, baseStmts =
         if ent.IsFSharpExceptionDeclaration then
-            libValue com ctx "exceptions" "FSharpException" |> Some
+            libValue com ctx "exceptions" "FSharpException" |> Some, [], [], []
         elif ent.IsFSharpRecord || ent.IsValueType then
-            libValue com ctx "record" "Record" |> Some
+            libValue com ctx "record" "Record" |> Some, [], [], []
         else
-            None
+            match extractBaseExprFromBaseCall com ctx ent.BaseType baseCall with
+            | Some(baseExpr, (superArgs, _keywords, stmts)) ->
+                let baseFieldIds =
+                    match baseCall with
+                    | Some(Fable.Call(_, info, _, _)) ->
+                        info.Args
+                        |> List.choose (
+                            function
+                            | Fable.IdentExpr id -> Some id
+                            | _ -> None
+                        )
+                    | _ -> []
+
+                Some baseExpr, superArgs, baseFieldIds, stmts
+            | None -> None, [], [], []
 
     let body =
         [
+            yield! baseStmts
+
             if Option.isSome baseExpr then
-                yield callSuperAsStatement []
+                yield callSuperAsStatement superArgs
 
             // For attributes style, use direct attribute names and proper parameter handling
             if classAttributes.Style = ClassStyle.Attributes then
@@ -4562,8 +4579,8 @@ let transformClassWithCompilerGeneratedConstructor
         ]
 
     let args =
-        fieldIds
-        |> Array.mapToList (fun id ->
+        baseFieldIds @ Array.toList fieldIds
+        |> List.map (fun id ->
             let ta, _ = Annotation.typeAnnotation com ctx None id.Type
             Arg.arg (ident com ctx id, annotation = ta)
         )
@@ -5388,7 +5405,14 @@ let rec transformDeclaration (com: IPythonCompiler) ctx (decl: Fable.Declaration
                     allStatements @ classStmts
             | _, None ->
                 let classStmts =
-                    transformClassWithCompilerGeneratedConstructor com ctx ent decl.Name allClassMembers classAttributes
+                    transformClassWithCompilerGeneratedConstructor
+                        com
+                        ctx
+                        ent
+                        decl.Name
+                        decl.BaseCall
+                        allClassMembers
+                        classAttributes
 
                 allStatements @ classStmts
 

tests/Js/Main/TypeTests.fs

@@ -894,6 +894,60 @@ let walkLazyTree (tree: LazyTree<Lazy<'a>>) : string =
 
     loop tree
 
+type ValClassBase =
+    val Id: int
+    val Label: string
+    new (id: int) = { Id = id * 10; Label = "base" }
+    member this.Describe() = this.Label + ":" + string this.Id
+
+type ValClassChild =
+    inherit ValClassBase
+    val Extra: float
+    new (id: int, extra: float) = { inherit ValClassBase(id); Extra = extra }
+
+type ValClassGrandChild =
+    inherit ValClassChild
+    val Flag: bool
+    new (id: int, extra: float, flag: bool) =
+        let doubled = id * 2
+        { inherit ValClassChild(doubled, extra); Flag = flag }
+
+let mutable valClassBaseCalls = 0
+
+type ValClassCounting =
+    val N: int
+    new (n: int) =
+        valClassBaseCalls <- valClassBaseCalls + 1
+        { N = n }
+
+type ValClassCountingChild =
+    inherit ValClassCounting
+    val M: int
+    new (n: int, m: int) = { inherit ValClassCounting(n); M = m }
+
+type ValClassDefaultBase =
+    val Tag: string
+    new () = { Tag = "default" }
+
+type ValClassDefaultChild =
+    inherit ValClassDefaultBase
+    val Value: int
+    new (value: int) = { inherit ValClassDefaultBase(); Value = value }
+
+type ValClassGenericBase<'T> =
+    val Value: 'T
+    new (v: 'T) = { Value = v }
+
+type ValClassIntBox =
+    inherit ValClassGenericBase<int>
+    val Tag: string
+    new (v: int, t: string) = { inherit ValClassGenericBase<int>(v); Tag = t }
+
+type ValClassPairBox<'U> =
+    inherit ValClassGenericBase<'U * 'U>
+    val Count: int
+    new (a: 'U, b: 'U) = { inherit ValClassGenericBase<'U * 'U>((a, b)); Count = 2 }
+
 let tests =
   testList "Types" [
 
@@ -1838,4 +1892,41 @@ let tests =
     testCase "Nested lambda does not shadow an outer generic type parameter" <| fun () ->
         let box = mapGenericMethodBox 42
         box.Get() |> List.ofSeq |> equal [ 42 ]
+
+    testCase "Explicit constructor calls the base constructor" <| fun () ->
+        let child = ValClassChild(3, 1.5)
+        child.Id |> equal 30
+        child.Label |> equal "base"
+        child.Extra |> equal 1.5
+        child.Describe() |> equal "base:30"
+        (child :> ValClassBase).Id |> equal 30
+        (box child :? ValClassBase) |> equal true
+
+    testCase "Explicit constructors chain through several levels" <| fun () ->
+        let g = ValClassGrandChild(2, 0.5, true)
+        g.Id |> equal 40
+        g.Label |> equal "base"
+        g.Extra |> equal 0.5
+        g.Flag |> equal true
+        g.Describe() |> equal "base:40"
+
+    testCase "Explicit constructor runs the base constructor once" <| fun () ->
+        valClassBaseCalls <- 0
+        let c = ValClassCountingChild(5, 6)
+        valClassBaseCalls |> equal 1
+        c.N |> equal 5
+        c.M |> equal 6
+
+    testCase "Explicit constructor calls a parameterless base constructor" <| fun () ->
+        let c = ValClassDefaultChild(9)
+        c.Tag |> equal "default"
+        c.Value |> equal 9
+
+    testCase "Explicit constructor resolves the generic arguments of the base class" <| fun () ->
+        let intBox = ValClassIntBox(5, "x")
+        intBox.Value |> equal 5
+        intBox.Tag |> equal "x"
+        let pairBox = ValClassPairBox("a", "b")
+        pairBox.Value |> equal ("a", "b")
+        pairBox.Count |> equal 2
   ]