From c989c820fbca286cf6dcd05dc6031ffa24e39232 Mon Sep 17 00:00:00 2001
From: Jacques Garrigue <garrigue@math.nagoya-u.ac.jp>
Date: Tue, 1 Mar 2016 09:30:35 +0900
Subject: [PATCH] Fix PR#7113: -safe-string can break GADT compatibility check

---
 Changes                                      |  1 +
 testsuite/tests/typing-safe-linking/Makefile | 16 ++++++++++++++++
 testsuite/tests/typing-safe-linking/a.ml     |  5 +++++
 testsuite/tests/typing-safe-linking/b_bad.ml |  4 ++++
 testsuite/typing                             |  1 +
 typing/ctype.ml                              |  9 ++++++++-
 6 files changed, 35 insertions(+), 1 deletion(-)
 create mode 100644 testsuite/tests/typing-safe-linking/Makefile
 create mode 100644 testsuite/tests/typing-safe-linking/a.ml
 create mode 100644 testsuite/tests/typing-safe-linking/b_bad.ml

diff --git a/Changes b/Changes
index 37d6941ac..db780c0b0 100644
--- a/Changes
+++ b/Changes
@@ -458,6 +458,7 @@ Bug fixes:
 - PR#7108: ocamldoc, have -html preserve custom/extended html generators
   (Armaël Guéneau)
 - 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
   warning (Alain Frisch, report by Valentin Gatien-Baron)
 - PR#7133: Jump labels in assembly end up as symbols in the executable on OS X
diff --git a/testsuite/tests/typing-safe-linking/Makefile b/testsuite/tests/typing-safe-linking/Makefile
new file mode 100644
index 000000000..3b33faf09
--- /dev/null
+++ b/testsuite/tests/typing-safe-linking/Makefile
@@ -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
+
diff --git a/testsuite/tests/typing-safe-linking/a.ml b/testsuite/tests/typing-safe-linking/a.ml
new file mode 100644
index 000000000..030242bd1
--- /dev/null
+++ b/testsuite/tests/typing-safe-linking/a.ml
@@ -0,0 +1,5 @@
+ type _ t =
+     X of string
+   | Y : bytes t 
+
+let y : string t = Y
diff --git a/testsuite/tests/typing-safe-linking/b_bad.ml b/testsuite/tests/typing-safe-linking/b_bad.ml
new file mode 100644
index 000000000..8730dcbdd
--- /dev/null
+++ b/testsuite/tests/typing-safe-linking/b_bad.ml
@@ -0,0 +1,4 @@
+let f : string A.t -> unit = function
+    A.X s -> print_endline s
+
+let () = f A.y
diff --git a/testsuite/typing b/testsuite/typing
index f96282b7c..3fbfcec10 100644
--- a/testsuite/typing
+++ b/testsuite/typing
@@ -30,6 +30,7 @@ tests/typing-private-bugs
 tests/typing-recmod
 tests/typing-recordarg
 tests/typing-rectypes-bugs
+tests/typing-safe-linking
 tests/typing-short-paths
 tests/typing-signatures
 tests/typing-sigsubst
diff --git a/typing/ctype.ml b/typing/ctype.ml
index 8779e3570..508596c4e 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -1933,6 +1933,13 @@ let non_aliasable p decl =
   (* in_pervasives p ||  (subsumed by in_current_module) *)
   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 *)
 let rec expands_to_datatype env ty =
   let ty = repr ty in
@@ -2071,7 +2078,7 @@ and mcomp_type_decl type_pairs env p1 p2 tl1 tl2 =
   try
     let decl = Env.find_type p1 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 =
         try List.map Variance.(mem Inj) (Env.find_type p1 env).type_variance
         with Not_found -> List.map (fun _ -> false) tl1