#1455 fix trait calls not resolved from base classes

Author: Jand42

src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs

@@ -1388,7 +1388,11 @@ let rec transformExpression (env: Environment) (expr: FSharpExpr) =
                             )
                             |> List.tryPick (fun t -> 
                                 if t.HasTypeDefinition then
-                                    t.TypeDefinition.TryGetMembersFunctionsAndValues()
+                                    let rec getAllMembers (t: FSharpEntity) =
+                                        match t.BaseType with
+                                        | None -> t.TryGetMembersFunctionsAndValues() :> _ seq
+                                        | Some bt -> Seq.append (t.TryGetMembersFunctionsAndValues()) (getAllMembers bt.TypeDefinition)
+                                    getAllMembers t.TypeDefinition
                                     |> Seq.tryPick (fun mem ->
                                         match sr.ReadMember mem with
                                         | Member.Method(inst, m) when inst = isInstance && m.Value.MethodName = traitName -> 

src/compiler/WebSharper.Compiler/Compilation.fs

@@ -749,15 +749,22 @@ type Compilation(meta: Info, ?hasGraph) =
             | _ ->
                 failwithf "Error looking up abstract method generics %s.%s" typ.Value.FullName meth.Value.MethodName
 
-    member this.GetMethods typ =
+    member this.GetMethods (typ: Concrete<TypeDefinition>) =
+        let typEnt = typ.Entity
         compilingMethods |> Seq.choose (fun (KeyValue ((td, m), _)) ->
-            if td = typ then Some m else None
+            if td = typEnt then Some (typ, m) else None
         ) |> Seq.append (
-            match this.TryLookupClassInfo typ with
-            | Some (_, cls) when not (this.IsInterface(typ)) -> cls.Methods.Keys :> _ seq
+            match this.TryLookupClassInfo typEnt with
+            | Some (_, cls) when not (this.IsInterface(typEnt)) -> 
+                match cls.BaseClass with
+                | None ->
+                    cls.Methods.Keys |> Seq.map (fun m -> typ, m)
+                | Some bTyp ->
+                    let gsArr = typ.Generics |> List.toArray
+                    Seq.append (cls.Methods.Keys |> Seq.map (fun m -> typ, m)) (this.GetMethods { bTyp with Generics = bTyp.Generics |> List.map (fun p -> p.SubstituteGenerics(gsArr)) })
             | _ ->
-            match this.TryLookupInterfaceInfo typ with
-            | Some intf -> intf.Methods.Keys :> _ seq
+            match this.TryLookupInterfaceInfo typEnt with
+            | Some intf -> intf.Methods.Keys |> Seq.map (fun m -> typ, m)
             | _ ->
                 Seq.empty
         )

src/compiler/WebSharper.Compiler/CompilationHelpers.fs

@@ -481,6 +481,7 @@ let varEvalOrder (vars : Id list) expr =
             | Import _
             | Interface _
             | XmlComment _
+            | LazyClass _
                 -> fail()      
 
     eval expr

src/compiler/WebSharper.Compiler/Translator.fs

@@ -1221,26 +1221,26 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) =
                 match typ with
                 | ConcreteType ct ->
                     //let trmv = trmv.SubstituteGenerics(Array.ofList (typ :: meth.Generics))
-                    let methods = comp.GetMethods ct.Entity
+                    let methods = comp.GetMethods ct
                     let getMethods pars ret =
-                        methods |> Seq.choose (fun m ->
+                        methods |> Seq.choose (fun (mtyp, m) ->
                             let tcSig = FSharpFuncType (TupleType (pars, false), ret)
                             let mv = m.Value
                             if mv.MethodName = mName then
                                 let mSig = FSharpFuncType (TupleType (mv.Parameters, false), mv.ReturnType)
                                 if Type.IsGenericCompatible(mSig, tcSig) then
-                                    Some m 
+                                    Some (mtyp, m) 
                                 else
                                     None
                             else None
                         ) 
                         |> List.ofSeq
                     match getMethods trmv.Parameters trmv.ReturnType with
-                    | [ m ] ->
-                        this.TransformCall(thisObj, ct, Generic m meth.Generics, args) |> Some
+                    | [ (mtyp, m) ] ->
+                        this.TransformCall(thisObj, mtyp, Generic m meth.Generics, args) |> Some
                     | [] -> 
                         let targets =
-                            methods |> Seq.choose (fun m ->
+                            methods |> Seq.choose (fun (_, m) ->
                                 let mv = m.Value
                                 if mv.MethodName = mName then
                                     let mSig = FSharpFuncType (TupleType (mv.Parameters, false), mv.ReturnType)
@@ -2097,7 +2097,7 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) =
                         TypeOf "function"
                     | M.FSharpRecordInfo _
                     | M.FSharpAnonRecordInfo _
-                    | M.StructInfo _ ->
+                    | M.StructInfo ->
                         PlainObject false
                     | M.FSharpUnionInfo ui ->
                         PlainObject ui.HasNull

tests/WebSharper.Tests/ASTTests.fsx

@@ -346,7 +346,7 @@ let stExpr s = WebSharper.Core.AST.StatementExpr(s, None)
 
 open System.IO
 
-let translate isBundle source = 
+let translate isBundle (source: string) = 
 
     let tempFileName = Path.GetTempFileName()
     let fileName = Path.ChangeExtension(tempFileName, ".fs")

tests/WebSharper.Tests/Regression.fs

@@ -568,6 +568,29 @@ module Bug1390 =
 type IValue<'T> =
     abstract member Value : 'T with get
 
+[<JavaScript>]
+module Bug1455 =
+    [<Inline>]
+    let inline ( := ) (o: ^x) (v: ^a) = (^x: (member Value: ^a with set) (o, v))
+
+    type [<AbstractClass>] ValueRef<'T>() =
+        abstract Get : unit -> 'T
+        abstract Set : 'T -> unit
+        member this.Value
+            with [<Inline>] get() = this.Get()
+            and [<Inline>] set v = this.Set v
+        
+    and ConcreteValueRef<'T>(initVal) =
+        inherit ValueRef<'T>()
+        let mutable value = initVal
+        default this.Get() = value
+        default this.Set(v) = value <- v
+
+    let test() =
+        let v = ConcreteValueRef ""
+        v := "test"
+        v.Get()    
+
 [<JavaScript>]
 let Tests =
     TestCategory "Regression" {
@@ -1124,4 +1147,8 @@ let Tests =
                 i.Value
             equal test 4
         }
+
+        Test "#1455 Inlines not resolved from base classes" {
+            equal (Bug1455.test()) "test"
+        }
     }