From 752f1560eba0f2c38a598563eeda992c3c0210f8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A1s=20Jank=C3=B3?= Date: Fri, 6 Jul 2018 19:10:00 +0200 Subject: [PATCH] #982 System.Exception translates to JS Error, working inheritance --- .../ProjectReader.fs | 45 ++++++++++---- .../WebSharper.Compiler.FSharp/CodeReader.fs | 58 +++++++++++++------ .../ProjectReader.fs | 20 +++---- .../WebSharper.Compiler/CompilationHelpers.fs | 6 ++ .../WebSharper.Compiler/Translator.fs | 4 ++ .../WebSharper.Core.JavaScript/Runtime.js | 9 ++- .../WebSharper.Main.Proxies/Exception.fs | 17 ++++-- tests/WebSharper.CSharp.Tests/Object.cs | 9 ++- tests/WebSharper.Tests/Exception.fs | 4 ++ 9 files changed, 124 insertions(+), 48 deletions(-) diff --git a/src/compiler/WebSharper.Compiler.CSharp/ProjectReader.fs b/src/compiler/WebSharper.Compiler.CSharp/ProjectReader.fs index 54aa37008..89e44988b 100644 --- a/src/compiler/WebSharper.Compiler.CSharp/ProjectReader.fs +++ b/src/compiler/WebSharper.Compiler.CSharp/ProjectReader.fs @@ -380,6 +380,14 @@ let private transformClass (rcomp: CSharpCompilation) (sr: R.SymbolReader) (comp if staticInits.Count = 0 then None else ExprStatement (Sequential (staticInits |> List.ofSeq)) |> Some + let baseCls = + if cls.IsValueType || cls.IsStatic then + None + elif annot.Prototype = Some false then + cls.BaseType |> sr.ReadNamedTypeDefinition |> ignoreSystemObject + else + cls.BaseType |> sr.ReadNamedTypeDefinition |> Some + let mutable hasStubMember = false for meth in members.OfType() do @@ -507,10 +515,31 @@ let private transformClass (rcomp: CSharpCompilation) (sr: R.SymbolReader) (comp let b = match c.Initializer with | Some (CodeReader.BaseInitializer (bTyp, bCtor, args, reorder)) -> - CombineStatements [ - ExprStatement (baseCtor This bTyp bCtor args |> reorder) - c.Body - ] + match baseCls with + | Some t when t.Value.FullName = "System.Exception" -> + let msg, inner = + match args with + | [] -> None, None + | [msg] -> Some msg, None + | [msg; inner] -> Some msg, Some inner + | _ -> failwith "Too many arguments for Error constructor" + CombineStatements [ + match msg with + | Some m -> + yield ExprStatement <| ItemSet(This, Value (String "message"), m) + | None -> () + match inner with + | Some i -> + yield ExprStatement <| ItemSet(This, Value (String "inner"), i) + | None -> () + yield ExprStatement <| CompilationHelpers.restorePrototype + c.Body + ] + | _ -> + CombineStatements [ + ExprStatement (baseCtor This bTyp bCtor args |> reorder) + c.Body + ] | Some (CodeReader.ThisInitializer (bCtor, args, reorder)) -> CombineStatements [ ExprStatement (baseCtor This (NonGeneric def) bCtor args |> reorder) @@ -836,14 +865,6 @@ let private transformClass (rcomp: CSharpCompilation) (sr: R.SymbolReader) (comp then NotResolvedClassKind.WithPrototype else NotResolvedClassKind.Class - let baseCls = - if cls.IsValueType || cls.IsStatic then - None - elif annot.Prototype = Some false then - cls.BaseType |> sr.ReadNamedTypeDefinition |> ignoreSystemObject - else - cls.BaseType |> sr.ReadNamedTypeDefinition |> Some - Some ( def, { diff --git a/src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs b/src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs index c83eae46c..5054967fd 100644 --- a/src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs +++ b/src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs @@ -133,10 +133,10 @@ let getDeclaringEntity (x : FSharpMemberOrFunctionOrValue) = | Some e -> e | None -> failwithf "Enclosing entity not found for %s" x.FullName -type FixCtorTransformer(?thisExpr) = +type FixCtorTransformer(typ, btyp, ?thisExpr) = inherit Transformer() - let mutable firstOcc = true + let mutable addedBaseCtor = false let thisExpr = defaultArg thisExpr This @@ -157,24 +157,42 @@ type FixCtorTransformer(?thisExpr) = override this.TransformStatementExpr(a, b) = StatementExpr (a, b) override this.TransformCtor (t, c, a) = - if not firstOcc then Ctor (t, c, a) else - firstOcc <- false - if t.Entity = Definitions.Obj then thisExpr - elif (let fn = t.Entity.Value.FullName in fn = "WebSharper.ExceptionProxy" || fn = "System.Exception") then - match a with - | [] -> Undefined - | [msg] -> ItemSet(thisExpr, Value (String "message"), msg) - | [msg; inner] -> + if addedBaseCtor then Ctor (t, c, a) else + addedBaseCtor <- true + let isBase = t.Entity <> typ + let tn = typ.Value.FullName + if (not isBase || Option.isSome btyp) && not (tn = "System.Object" || tn = "System.Exception") then + if t.Entity.Value.FullName = "System.Exception" then + let msg, inner = + match a with + | [] -> None, None + | [msg] -> Some msg, None + | [msg; inner] -> Some msg, Some inner + | _ -> failwith "Too many arguments for Error constructor" Sequential [ - ItemSet(thisExpr, Value (String "message"), msg) - ItemSet(thisExpr, Value (String "inner"), inner) + match msg with + | Some m -> + yield ItemSet(thisExpr, Value (String "message"), m) + | None -> () + match inner with + | Some i -> + yield ItemSet(thisExpr, Value (String "inner"), i) + | None -> () + yield CompilationHelpers.restorePrototype ] - | _ -> failwith "Too many arguments for Error" - else - BaseCtor(thisExpr, t, c, a) + else + BaseCtor(thisExpr, t, c, a) + else thisExpr + + member this.Fix(expr) = + let res = this.TransformExpression(expr) + match btyp with + | Some b when not addedBaseCtor -> + Sequential [ BaseCtor(thisExpr, NonGeneric b, ConstructorInfo.Default(), []); res ] + | _ -> res -let fixCtor expr = - FixCtorTransformer().TransformExpression(expr) +let fixCtor thisTyp baseTyp expr = + FixCtorTransformer(thisTyp, baseTyp).Fix(expr) module Definitions = let List = @@ -1048,9 +1066,11 @@ let rec transformExpression (env: Environment) (expr: FSharpExpr) = yield Var o ] ) - Let(r, CopyCtor(sr.ReadAndRegisterTypeDefinition env.Compilation typ.TypeDefinition, plainObj), + let td = sr.ReadAndRegisterTypeDefinition env.Compilation typ.TypeDefinition + let baseTyp = typ.TypeDefinition.BaseType |> Option.map (fun t -> sr.ReadAndRegisterTypeDefinition env.Compilation t.TypeDefinition) + Let(r, CopyCtor(td, plainObj), Sequential [ - yield FixCtorTransformer(Var r).TransformExpression(tr expr) + yield FixCtorTransformer(td, baseTyp, Var r).TransformExpression(tr expr) yield Var r ] ) diff --git a/src/compiler/WebSharper.Compiler.FSharp/ProjectReader.fs b/src/compiler/WebSharper.Compiler.FSharp/ProjectReader.fs index 98526d5bc..98b230f1b 100644 --- a/src/compiler/WebSharper.Compiler.FSharp/ProjectReader.fs +++ b/src/compiler/WebSharper.Compiler.FSharp/ProjectReader.fs @@ -358,6 +358,14 @@ let rec private transformClass (sc: Lazy<_ * StartupCode>) (comp: Compilation) ( ) |> HashSet + let baseCls = + if fsharpSpecific || fsharpModule || cls.IsValueType || annot.IsStub || def.Value.FullName = "System.Object" then + None + elif annot.Prototype = Some false then + cls.BaseType |> Option.bind (fun t -> t.TypeDefinition |> sr.ReadTypeDefinition |> ignoreSystemObject) + else + cls.BaseType |> Option.map (fun t -> t.TypeDefinition |> sr.ReadTypeDefinition) + for i = 0 to members.Count - 1 do let m = members.[i] match m with @@ -480,7 +488,7 @@ let rec private transformClass (sc: Lazy<_ * StartupCode>) (comp: Compilation) ( let b = match memdef with | Member.Constructor _ -> - try CodeReader.fixCtor b + try CodeReader.fixCtor def baseCls b with e -> let tryGetExprSourcePos expr = match expr with @@ -738,14 +746,6 @@ let rec private transformClass (sc: Lazy<_ * StartupCode>) (comp: Compilation) ( then NotResolvedClassKind.WithPrototype else NotResolvedClassKind.Class - let baseCls = - if fsharpSpecific || fsharpModule || cls.IsValueType || annot.IsStub || def.Value.FullName = "System.Object" then - None - elif annot.Prototype = Some false then - cls.BaseType |> Option.bind (fun t -> t.TypeDefinition |> sr.ReadTypeDefinition |> ignoreSystemObject) - else - cls.BaseType |> Option.map (fun t -> t.TypeDefinition |> sr.ReadTypeDefinition) - let hasWSPrototype = hasWSPrototype ckind baseCls clsMembers @@ -976,7 +976,7 @@ let rec private transformClass (sc: Lazy<_ * StartupCode>) (comp: Compilation) ( IsProxy = Option.isSome annot.ProxyOf Macros = annot.Macros ForceNoPrototype = (annot.Prototype = Some false) || hasConstantCase - ForceAddress = hasSingletonCase + ForceAddress = hasSingletonCase || def.Value.FullName = "System.Exception" // needed for Error inheritance } ) diff --git a/src/compiler/WebSharper.Compiler/CompilationHelpers.fs b/src/compiler/WebSharper.Compiler/CompilationHelpers.fs index 395a4712a..331bdc435 100644 --- a/src/compiler/WebSharper.Compiler/CompilationHelpers.fs +++ b/src/compiler/WebSharper.Compiler/CompilationHelpers.fs @@ -1390,6 +1390,12 @@ type OptimizeLocalCurriedFunc(var, currying) = base.TransformCurriedApplication(func, args) | _ -> base.TransformCurriedApplication(func, args) +//Object.setPrototypeOf(this, ThisClass.prototype); +let restorePrototype = + Application( + ItemGet(Global ["Object"], Value (String "setPrototypeOf"), Pure) + , [This; ItemGet(Self, Value (String "prototype"), Pure)], NonPure, None) + #if DEBUG let mutable logTransformations = false #endif diff --git a/src/compiler/WebSharper.Compiler/Translator.fs b/src/compiler/WebSharper.Compiler/Translator.fs index 8150f83b0..c123e886e 100644 --- a/src/compiler/WebSharper.Compiler/Translator.fs +++ b/src/compiler/WebSharper.Compiler/Translator.fs @@ -616,6 +616,8 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) = comp.FailedCompiledConstructor(typ, ctor) else currentIsInline <- isInline info + // for Error inheritance, using restorePrototype + selfAddress <- comp.TryLookupClassInfo(typ) |> Option.bind (fun cls -> cls.Address) match info with | NotCompiled (i, _, opts) -> currentFuncArgs <- opts.FuncArgs @@ -1355,6 +1357,8 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) = // This is allowing some simple inlines | Let (i1, a1, New(func, [Var v1])) when i1 = v1 -> Application(func |> getItem "call", expr :: [a1], NonPure, None) + | Let (i1, a1, Let (i2, a2, New(func, [Var v1; Var v2]))) when i1 = v1 && i2 = v2 -> + Application(func |> getItem "call", expr :: [a1; a2], NonPure, None) | _ -> comp.AddError (this.CurrentSourcePos, SourceError "Chained constructor is an Inline in a not supported form") Application(errorPlaceholder, args |> List.map this.TransformExpression, NonPure, None) diff --git a/src/compiler/WebSharper.Core.JavaScript/Runtime.js b/src/compiler/WebSharper.Core.JavaScript/Runtime.js index cb6c55f92..7662277d5 100644 --- a/src/compiler/WebSharper.Core.JavaScript/Runtime.js +++ b/src/compiler/WebSharper.Core.JavaScript/Runtime.js @@ -292,7 +292,7 @@ IntelliFactory.Runtime.OnLoad(function () { // Polyfill if (!Date.now) { - Date.now = function now() { + Date.now = function () { return new Date().getTime(); }; } @@ -303,6 +303,13 @@ if (!Math.trunc) { } } +if (!Object.setPrototypeOf) { + Object.setPrototypeOf = function (obj, proto) { + obj.__proto__ = proto; + return obj; + } +} + function ignore() { }; function id(x) { return x }; function fst(x) { return x[0] }; diff --git a/src/stdlib/WebSharper.Main.Proxies/Exception.fs b/src/stdlib/WebSharper.Main.Proxies/Exception.fs index b02b4eef9..31a254085 100644 --- a/src/stdlib/WebSharper.Main.Proxies/Exception.fs +++ b/src/stdlib/WebSharper.Main.Proxies/Exception.fs @@ -22,17 +22,24 @@ namespace WebSharper open WebSharper.JavaScript +[] +module Exception = + let withInner (msg, inner) = + let e = Error(msg) + e?inner <- inner + e + [] [)>] type private ExceptionProxy = - [] - new (message: string) = { } + [] + new () = { } - [] - new (message: string, inner: exn) = { } + [] + new (message: string) = { } [] - new () = ExceptionProxy "Exception of type 'System.Exception' was thrown." + static member CtorProxy (message: string, inner: exn) = Exception.withInner (message, inner) member this.Message with [] get () = X member this.InnerException with [] get () = X diff --git a/tests/WebSharper.CSharp.Tests/Object.cs b/tests/WebSharper.CSharp.Tests/Object.cs index b456def6b..ef16d01aa 100644 --- a/tests/WebSharper.CSharp.Tests/Object.cs +++ b/tests/WebSharper.CSharp.Tests/Object.cs @@ -264,6 +264,8 @@ public void Structs() public class MyException : Exception { public bool IsThisMyException => true; + + public MyException() : base("This is my exception") { } } [Test] @@ -277,7 +279,12 @@ public void Exception() catch (MyException e) { if (e.IsThisMyException) - res = "ok"; + { + if (e.Message == "This is my exception") + res = "ok"; + else + res = "wrong message on exception"; + } else res = "wrong method value on exception"; } diff --git a/tests/WebSharper.Tests/Exception.fs b/tests/WebSharper.Tests/Exception.fs index 255885900..554cab338 100644 --- a/tests/WebSharper.Tests/Exception.fs +++ b/tests/WebSharper.Tests/Exception.fs @@ -97,4 +97,8 @@ let Tests = ) ("OOPS", 2) } + Test "Inheritance" { + isTrue (box (System.ArgumentException()) :? exn) + } + }