Better range for "can only extend structures" errors, closes #8697 (#8706)

src/typing/typeload.ml

@@ -221,8 +221,8 @@ let is_redefined ctx cf1 fields p =
 	with Not_found ->
 		false
 
-let make_extension_type ctx tl p =
-	let mk_extension fields t = match follow t with
+let make_extension_type ctx tl =
+	let mk_extension fields (t,p) = match follow t with
 		| TAnon a ->
 			PMap.fold (fun cf fields ->
 				if not (is_redefined ctx cf fields p) then PMap.add cf.cf_name cf fields
@@ -232,6 +232,7 @@ let make_extension_type ctx tl p =
 			error "Can only extend structures" p
 	in
 	let fields = List.fold_left mk_extension PMap.empty tl in
+	let tl = List.map (fun (t,_) -> t) tl in
 	let ta = TAnon { a_fields = fields; a_status = ref (Extend tl); } in
 	ta
 
@@ -369,7 +370,7 @@ and load_complex_type' ctx allow_display (t,p) =
 	| CTIntersection tl ->
 		let tl = List.map (fun (t,pn) ->
 			try
-				load_complex_type ctx allow_display (t,pn)
+				(load_complex_type ctx allow_display (t,pn),pn)
 			with DisplayException(DisplayFields Some({fkind = CRTypeHint} as r)) ->
 				let l = List.filter (fun item -> match item.ci_kind with
 					| ITType({kind = Struct},_) -> true
@@ -381,7 +382,7 @@ and load_complex_type' ctx allow_display (t,p) =
 		let t = TMono tr in
 		let r = exc_protect ctx (fun r ->
 			r := lazy_processing (fun() -> t);
-			let ta = make_extension_type ctx tl p in
+			let ta = make_extension_type ctx tl in
 			tr := Some ta;
 			ta
 		) "constraint" in
@@ -389,7 +390,7 @@ and load_complex_type' ctx allow_display (t,p) =
 	| CTExtend (tl,l) ->
 		begin match load_complex_type ctx allow_display (CTAnonymous l,p) with
 		| TAnon a as ta ->
-			let mk_extension t =
+			let mk_extension (t,p) =
 				match follow t with
 				| TInst ({cl_kind = KTypeParameter _},_) ->
 					error "Cannot structurally extend type parameters" p
@@ -400,7 +401,7 @@ and load_complex_type' ctx allow_display (t,p) =
 					TAnon { a_fields = (PMap.foldi PMap.add a.a_fields a2.a_fields); a_status = ref (Extend [t]); }
 				| _ -> error "Can only extend structures" p
 			in
-			let loop t = match follow t with
+			let loop (t,p) = match follow t with
 				| TAnon a2 ->
 					PMap.iter (fun f cf ->
 						if not (is_redefined ctx cf a.a_fields p) then
@@ -411,7 +412,7 @@ and load_complex_type' ctx allow_display (t,p) =
 			in
 			let il = List.map (fun (t,pn) ->
 				try
-					load_instance ctx ~allow_display (t,pn) false
+					(load_instance ctx ~allow_display (t,pn) false,pn)
 				with DisplayException(DisplayFields Some({fkind = CRTypeHint} as r)) ->
 					let l = List.filter (fun item -> match item.ci_kind with
 						| ITType({kind = Struct},_) -> true
@@ -428,7 +429,7 @@ and load_complex_type' ctx allow_display (t,p) =
 						mk_extension i
 					| _ ->
 						List.iter loop il;
-						a.a_status := Extend il;
+						a.a_status := Extend (List.map (fun(t,_) -> t) il);
 						ta);
 				t
 			) "constraint" in

tests/misc/projects/Issue8697/Main.hx

@@ -0,0 +1 @@
+typedef Foo = String & {}

tests/misc/projects/Issue8697/Main2.hx

@@ -0,0 +1,3 @@
+typedef Foo = {
+	> String,
+}

tests/misc/projects/Issue8697/compile-fail.hxml

@@ -0,0 +1 @@
+-main Main

tests/misc/projects/Issue8697/compile-fail.hxml-stderr

@@ -0,0 +1 @@
+Main.hx:1: characters 15-21 : Can only extend structures

tests/misc/projects/Issue8697/compile2-fail.hxml

@@ -0,0 +1 @@
+-main Main

tests/misc/projects/Issue8697/compile2-fail.hxml-stderr

@@ -0,0 +1 @@
+Main.hx:2: characters 4-10 : Can only extend structures