Browse Source

type abstract constructors to return the abstract, not the underlying type

Simon Krajewski 10 years ago
parent
commit
b2167ae7cc
2 changed files with 50 additions and 6 deletions
  1. 40 0
      tests/unit/src/unit/issues/Issue3370.hx
  2. 10 6
      typeload.ml

+ 40 - 0
tests/unit/src/unit/issues/Issue3370.hx

@@ -0,0 +1,40 @@
+package unit.issues;
+
+import haxe.Int64;
+abstract FunInt64(Int64)
+{
+    public static var NEGATIVE_ONE(default, null) : FunInt64 = FunInt64.make(0xffffffff, 0xffffffff);
+    public static var ZERO(default, null) : FunInt64 = FunInt64.make(0x00000000, 0x00000000);
+
+    public static inline function make(high : Int, low : Int) : FunInt64
+    {
+        return new FunInt64(Int64.make(high, low));
+    }
+
+    @:op(A>>B) public static inline function shrs_i(j : FunInt64, k : Int)
+    {
+        if (k >= 63)
+        {
+            return (Int64.getHigh(j) < 0) ? NEGATIVE_ONE : ZERO;
+        }
+        return new FunInt64(Int64.shr(j, k));
+    }
+
+    public inline function new(a : Int64) : Int64
+    {
+        this = a;
+    }
+
+    @:to public inline function toInt64()
+    {
+        return this;
+    }
+}
+
+class Issue3370 extends unit.Test {
+	function test() {
+		var val64 : FunInt64 = FunInt64.make(0, 2);
+		val64 = val64 >> 1;
+		eq(1, Int64.toInt(val64.toInt64()));
+	}
+}

+ 10 - 6
typeload.ml

@@ -134,10 +134,12 @@ let make_module ctx mpath file tdecls loadp =
 				a.a_this <- t_dynamic;
 				a.a_this <- t_dynamic;
 				acc
 				acc
 			| fields ->
 			| fields ->
+				let a_t =
+					let params = List.map (fun t -> TPType (CTPath { tname = t.tp_name; tparams = []; tsub = None; tpackage = [] })) d.d_params in
+					CTPath { tpackage = []; tname = d.d_name; tparams = params; tsub = None }
+				in
 				let rec loop = function
 				let rec loop = function
-					| [] ->
-						let params = List.map (fun t -> TPType (CTPath { tname = t.tp_name; tparams = []; tsub = None; tpackage = [] })) d.d_params in
-						CTPath { tpackage = []; tname = d.d_name; tparams = params; tsub = None }
+					| [] -> a_t
 					| AIsType t :: _ -> t
 					| AIsType t :: _ -> t
 					| _ :: l -> loop l
 					| _ :: l -> loop l
 				in
 				in
@@ -155,7 +157,9 @@ let make_module ctx mpath file tdecls loadp =
 						f
 						f
 					| FFun fu when f.cff_name = "new" && not stat ->
 					| FFun fu when f.cff_name = "new" && not stat ->
 						let init p = (EVars ["this",Some this_t,None],p) in
 						let init p = (EVars ["this",Some this_t,None],p) in
-						let ret p = (EReturn (Some (EConst (Ident "this"),p)),p) in
+						let cast e = (ECast(e,None)),pos e in
+						let check_type e ct = (ECheckType(e,ct)),pos e in
+						let ret p = (EReturn (Some (cast (EConst (Ident "this"),p))),p) in
 						if Meta.has Meta.MultiType a.a_meta then begin
 						if Meta.has Meta.MultiType a.a_meta then begin
 							if List.mem AInline f.cff_access then error "MultiType constructors cannot be inline" f.cff_pos;
 							if List.mem AInline f.cff_access then error "MultiType constructors cannot be inline" f.cff_pos;
 							if fu.f_expr <> None then error "MultiType constructors cannot have a body" f.cff_pos;
 							if fu.f_expr <> None then error "MultiType constructors cannot have a body" f.cff_pos;
@@ -172,11 +176,11 @@ let make_module ctx mpath file tdecls loadp =
 							f_expr = (match fu.f_expr with
 							f_expr = (match fu.f_expr with
 							| None -> if Meta.has Meta.MultiType a.a_meta then Some (EConst (Ident "null"),p) else None
 							| None -> if Meta.has Meta.MultiType a.a_meta then Some (EConst (Ident "null"),p) else None
 							| Some (EBlock [EBinop (OpAssign,(EConst (Ident "this"),_),e),_],_ | EBinop (OpAssign,(EConst (Ident "this"),_),e),_) when not (has_call e) ->
 							| Some (EBlock [EBinop (OpAssign,(EConst (Ident "this"),_),e),_],_ | EBinop (OpAssign,(EConst (Ident "this"),_),e),_) when not (has_call e) ->
-								Some (EReturn (Some e), pos e)
+								Some (EReturn (Some (cast (check_type e this_t))), pos e)
 							| Some (EBlock el,p) -> Some (EBlock (init p :: el @ [ret p]),p)
 							| Some (EBlock el,p) -> Some (EBlock (init p :: el @ [ret p]),p)
 							| Some e -> Some (EBlock [init p;e;ret p],p)
 							| Some e -> Some (EBlock [init p;e;ret p],p)
 							);
 							);
-							f_type = Some this_t;
+							f_type = Some a_t;
 						} in
 						} in
 						{ f with cff_name = "_new"; cff_access = AStatic :: f.cff_access; cff_kind = FFun fu; cff_meta = (Meta.Impl,[],p) :: f.cff_meta }
 						{ f with cff_name = "_new"; cff_access = AStatic :: f.cff_access; cff_kind = FFun fu; cff_meta = (Meta.Impl,[],p) :: f.cff_meta }
 					| FFun fu when not stat ->
 					| FFun fu when not stat ->