[WIP] Fix #2425

src/Fable.Transforms/FSharp2Fable.fs

@@ -18,6 +18,12 @@ open Util
 let inline private transformExprList com ctx xs = trampolineListMap (transformExpr com ctx) xs
 let inline private transformExprOpt com ctx opt = trampolineOptionMap (transformExpr com ctx) opt
 
+let private transformSequential com ctx xs =
+    trampoline {
+        let! xs = trampolineListMap (transformExpr com ctx) xs
+        return Fable.Sequential xs
+    }
+
 let private transformBaseConsCall com ctx r (baseEnt: FSharpEntity) (baseCons: FSharpMemberOrFunctionOrValue) genArgs baseArgs =
     let baseEnt = FsEnt baseEnt
     let argTypes = lazy getArgTypes com baseCons
@@ -815,24 +821,32 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
         return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs None args memb
 
     | BasicPatterns.Sequential (first, second) ->
-        let exprs =
-            match ctx.CaptureBaseConsCall with
-            | Some(baseEnt, captureBaseCall) ->
-                match first with
-                | ConstructorCall(call, genArgs, args)
-                // This pattern occurs in constructors that define a this value: `type C() as this`
-                // We're discarding the bound `this` value, it "shouldn't" be used in the base constructor arguments
-                | BasicPatterns.Let(_, (ConstructorCall(call, genArgs, args))) ->
-                    match call.DeclaringEntity with
-                    | Some ent when ent = baseEnt ->
-                        let r = makeRangeFrom first
-                        transformBaseConsCall com ctx r baseEnt call genArgs args |> captureBaseCall
-                        [second]
-                    | _ -> [first; second]
-                | _ -> [first; second]
-            | _ -> [first; second]
-        let! exprs = transformExprList com ctx exprs
-        return Fable.Sequential exprs
+        match ctx.CaptureBaseConsCall with
+        | Some(baseEnt, captureBaseCall) ->
+            match first with
+            | ConstructorCall(call, genArgs, args)
+            // This pattern occurs in constructors that define a this value: `type C() as this`
+            // We're discarding the bound `this` value, it "shouldn't" be used in the base constructor arguments
+            | BasicPatterns.Let(_, (ConstructorCall(call, genArgs, args))) ->
+                match call.DeclaringEntity with
+                | Some ent when ent = baseEnt ->
+                    let r = makeRangeFrom first
+                    transformBaseConsCall com ctx r baseEnt call genArgs args |> captureBaseCall
+                    return! transformExpr com ctx second
+                | _ -> return! transformSequential com ctx [first; second]
+            | _ -> return! transformSequential com ctx [first; second]
+        | None ->
+            match first, second with
+            | ConstructorCall(baseCall, _, baseArgs), BasicPatterns.NewRecord(consType, consArgs)
+                when (match baseCall.DeclaringEntity, consType.BaseType with
+                      | Some baseCallEntity, Some(TypeDefinition consBaseEntity) -> baseCallEntity = consBaseEntity
+                      | _ -> false) ->
+                let r = makeRangeFrom fsExpr
+                let! baseArgs = transformExprList com ctx baseArgs
+                let! consArgs = transformExprList com ctx consArgs
+                let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments consType)
+                return Fable.NewRecord(baseArgs @ consArgs, FsEnt.Ref consType.TypeDefinition, genArgs) |> makeValue r
+            | _ -> return! transformSequential com ctx [first; second]
 
     | BasicPatterns.NewRecord(fsType, argExprs) ->
         let r = makeRangeFrom fsExpr

src/Fable.Transforms/Fable2Babel.fs

@@ -819,7 +819,7 @@ module Util =
         getExpr r expr (Expression.stringLiteral("tag"))
 
     /// Wrap int expressions with `| 0` to help optimization of JS VMs
-    let wrapIntExpression typ (e: Expression) =
+    let wrapIfIntExpression typ (e: Expression) =
         match e, typ with
         | Literal(NumericLiteral(_)), _ -> e
         // TODO: Unsigned ints seem to cause problems, should we check only Int32 here?
@@ -1071,7 +1071,7 @@ module Util =
                 |> extractBaseExprFromBaseCall com ctx None
                 |> Option.map (fun (baseExpr, baseArgs) ->
                     let consBody = BlockStatement([|callSuperAsStatement baseArgs|])
-                    let cons = makeClassConstructor [||]  consBody
+                    let cons = makeClassConstructor [||] consBody
                     Some baseExpr, cons::classMembers
                 )
                 |> Option.defaultValue (None, classMembers)
@@ -1099,7 +1099,7 @@ module Util =
         match strategy with
         | None | Some ReturnUnit -> ExpressionStatement(babelExpr)
         // TODO: Where to put these int wrappings? Add them also for function arguments?
-        | Some Return ->  Statement.returnStatement(wrapIntExpression t babelExpr)
+        | Some Return -> Statement.returnStatement(wrapIfIntExpression t babelExpr)
         | Some(Assign left) -> ExpressionStatement(assign None left babelExpr)
         | Some(Target left) -> ExpressionStatement(assign None (left |> Expression.Identifier) babelExpr)
 
@@ -1233,7 +1233,7 @@ module Util =
 
     let transformSet (com: IBabelCompiler) ctx range fableExpr (value: Fable.Expr) kind =
         let expr = com.TransformAsExpr(ctx, fableExpr)
-        let value = com.TransformAsExpr(ctx, value) |> wrapIntExpression value.Type
+        let value = com.TransformAsExpr(ctx, value) |> wrapIfIntExpression value.Type
         let ret =
             match kind with
             | None -> expr
@@ -1251,7 +1251,7 @@ module Util =
             if var.IsMutable then
                 com.TransformAsExpr(ctx, value)
             else
-                com.TransformAsExpr(ctx, value) |> wrapIntExpression value.Type
+                com.TransformAsExpr(ctx, value) |> wrapIfIntExpression value.Type
 
     let transformBindingAsExpr (com: IBabelCompiler) ctx (var: Fable.Ident) (value: Fable.Expr) =
         transformBindingExprBody com ctx var value
@@ -1943,25 +1943,31 @@ module Util =
 
     let transformClassWithCompilerGeneratedConstructor (com: IBabelCompiler) ctx (ent: Fable.Entity) (entName: string) classMembers =
         let fieldIds = getEntityFieldsAsIdents com ent
-        let args = fieldIds |> Array.map identAsExpr
-        let baseExpr =
+        let baseArgs, baseExpr =
             if ent.IsFSharpExceptionDeclaration
-            then libValue com ctx "Types" "FSharpException" |> Some
+            then [], libValue com ctx "Types" "FSharpException" |> Some
             elif ent.IsFSharpRecord || ent.IsValueType
-            then libValue com ctx "Types" "Record" |> Some
-            else None
+            then [], libValue com ctx "Types" "Record" |> Some
+            else
+                match ent.BaseType with
+                | Some b ->
+                    let baseEntity = b.Entity |> com.GetEntity
+                    // TODO: Get base constructor arguments
+                    [], Some(jsConstructor com ctx baseEntity)
+                | None -> [], None
         let body =
             BlockStatement([|
                 if Option.isSome baseExpr then
-                    yield callSuperAsStatement []
+                    yield baseArgs |> List.map identAsExpr |> callSuperAsStatement
                 yield! ent.FSharpFields |> Seq.mapi (fun i field ->
                     let left = get None thisExpr field.Name
-                    let right = wrapIntExpression field.FieldType args.[i]
+                    let right = identAsExpr fieldIds.[i] |> wrapIfIntExpression field.FieldType
                     assign None left right |> ExpressionStatement)
                 |> Seq.toArray
             |])
-        let typedPattern x = typedIdent com ctx x
-        let args = fieldIds |> Array.map (typedPattern >> Pattern.Identifier)
+        let args =
+            Array.append (List.toArray baseArgs) fieldIds
+            |> Array.map (fun x -> typedIdent com ctx x |> Pattern.Identifier)
         declareType com ctx ent entName args body baseExpr classMembers
 
     let transformClassWithImplicitConstructor (com: IBabelCompiler) ctx (classDecl: Fable.ClassDecl) classMembers (cons: Fable.MemberDecl) =

src/quicktest/QuickTest.fs

@@ -66,3 +66,17 @@ let measureTime (f: unit -> unit) = emitJsStatement () """
 // to Fable.Tests project. For example:
 // testCase "Addition works" <| fun () ->
 //     2 + 2 |> equal 4
+type Node =
+    val X: int
+    new (x: int) = { X = x }
+
+type Node2(x: int, ?j: int) = //, ?j: int) =
+    member val X = x
+    member val J = defaultArg j 3
+    // new (x: int) = { X = x }
+
+type Leaf =
+    inherit Node2
+    val Y: string
+    new (y: string, x) =
+        { inherit Node2(x + 5); Y = y + "a" }