Fix PR#7113: -safe-string can break GADT compatibility check
parent
f5bc512181
commit
c989c820fb
1
Changes
1
Changes
|
@ -458,6 +458,7 @@ Bug fixes:
|
||||||
- PR#7108: ocamldoc, have -html preserve custom/extended html generators
|
- PR#7108: ocamldoc, have -html preserve custom/extended html generators
|
||||||
(Armaël Guéneau)
|
(Armaël Guéneau)
|
||||||
- PR#7096: ocamldoc uses an incorrect subscript/superscript style
|
- PR#7096: ocamldoc uses an incorrect subscript/superscript style
|
||||||
|
- PR#7113: -safe-string can break GADT compatibility check
|
||||||
- PR#7115: shadowing in a branch of a GADT match breaks unused variable
|
- PR#7115: shadowing in a branch of a GADT match breaks unused variable
|
||||||
warning (Alain Frisch, report by Valentin Gatien-Baron)
|
warning (Alain Frisch, report by Valentin Gatien-Baron)
|
||||||
- PR#7133: Jump labels in assembly end up as symbols in the executable on OS X
|
- PR#7133: Jump labels in assembly end up as symbols in the executable on OS X
|
||||||
|
|
|
@ -0,0 +1,16 @@
|
||||||
|
# Check safety of linking
|
||||||
|
|
||||||
|
SOURCES = a.ml b_bad.ml
|
||||||
|
OBJECTS = $(SOURCES:%.ml=%.cmo)
|
||||||
|
|
||||||
|
all: a.cmo
|
||||||
|
@printf " ... testing 'b_bad.ml'"
|
||||||
|
@$(OCAMLC) -c -safe-string -warn-error +8 b_bad.ml 2> /dev/null \
|
||||||
|
&& echo " => failed" || echo " => passed"
|
||||||
|
|
||||||
|
clean:
|
||||||
|
@rm -f *.cmo *.cmi
|
||||||
|
|
||||||
|
BASEDIR=../..
|
||||||
|
include $(BASEDIR)/makefiles/Makefile.common
|
||||||
|
|
|
@ -0,0 +1,5 @@
|
||||||
|
type _ t =
|
||||||
|
X of string
|
||||||
|
| Y : bytes t
|
||||||
|
|
||||||
|
let y : string t = Y
|
|
@ -0,0 +1,4 @@
|
||||||
|
let f : string A.t -> unit = function
|
||||||
|
A.X s -> print_endline s
|
||||||
|
|
||||||
|
let () = f A.y
|
|
@ -30,6 +30,7 @@ tests/typing-private-bugs
|
||||||
tests/typing-recmod
|
tests/typing-recmod
|
||||||
tests/typing-recordarg
|
tests/typing-recordarg
|
||||||
tests/typing-rectypes-bugs
|
tests/typing-rectypes-bugs
|
||||||
|
tests/typing-safe-linking
|
||||||
tests/typing-short-paths
|
tests/typing-short-paths
|
||||||
tests/typing-signatures
|
tests/typing-signatures
|
||||||
tests/typing-sigsubst
|
tests/typing-sigsubst
|
||||||
|
|
|
@ -1933,6 +1933,13 @@ let non_aliasable p decl =
|
||||||
(* in_pervasives p || (subsumed by in_current_module) *)
|
(* in_pervasives p || (subsumed by in_current_module) *)
|
||||||
in_current_module p && decl.type_newtype_level = None
|
in_current_module p && decl.type_newtype_level = None
|
||||||
|
|
||||||
|
(* PR#7113: -safe-string should be a global property *)
|
||||||
|
let compatible_paths p1 p2 =
|
||||||
|
let open Predef in
|
||||||
|
Path.same p1 p2 ||
|
||||||
|
Path.same p1 path_bytes && Path.same p2 path_string ||
|
||||||
|
Path.same p1 path_string && Path.same p2 path_bytes
|
||||||
|
|
||||||
(* Check for datatypes carefully; see PR#6348 *)
|
(* Check for datatypes carefully; see PR#6348 *)
|
||||||
let rec expands_to_datatype env ty =
|
let rec expands_to_datatype env ty =
|
||||||
let ty = repr ty in
|
let ty = repr ty in
|
||||||
|
@ -2071,7 +2078,7 @@ and mcomp_type_decl type_pairs env p1 p2 tl1 tl2 =
|
||||||
try
|
try
|
||||||
let decl = Env.find_type p1 env in
|
let decl = Env.find_type p1 env in
|
||||||
let decl' = Env.find_type p2 env in
|
let decl' = Env.find_type p2 env in
|
||||||
if Path.same p1 p2 then begin
|
if compatible_paths p1 p2 then begin
|
||||||
let inj =
|
let inj =
|
||||||
try List.map Variance.(mem Inj) (Env.find_type p1 env).type_variance
|
try List.map Variance.(mem Inj) (Env.find_type p1 env).type_variance
|
||||||
with Not_found -> List.map (fun _ -> false) tl1
|
with Not_found -> List.map (fun _ -> false) tl1
|
||||||
|
|
Loading…
Reference in New Issue