Blob Blame History Raw
From 9f72a2a2fec0902aeae5e5082779bb197657c1f4 Mon Sep 17 00:00:00 2001
From: Gabriel Scherer <gabriel.scherer@gmail.com>
Date: Tue, 5 Jul 2022 10:38:50 +0200
Subject: [PATCH 10/24] Merge pull request #11396 from gasche/fix11392

Fix 11392 (assertion failure on external with -rectypes)

(cherry picked from commit 724cefb8b0f1f96ef5181fffc24975ac9460ce3e)
---
 Changes                                    |  3 ++
 testsuite/tests/typing-external/pr11392.ml | 34 ++++++++++++++++++++++
 typing/typedecl.ml                         |  2 +-
 3 files changed, 38 insertions(+), 1 deletion(-)
 create mode 100644 testsuite/tests/typing-external/pr11392.ml

diff --git a/Changes b/Changes
index 0fe7732a02..8182f5ced7 100644
--- a/Changes
+++ b/Changes
@@ -22,6 +22,9 @@ OCaml 4.14 maintenance branch
   of both shadowing warnings and the `-bin-annot` compiler flag.
   (Florian Angeletti, report by Christophe Raffalli, review by Gabriel Scherer)
 
+- #11392, #11392: assertion failure with -rectypes and external definitions
+  (Gabriel Scherer, review by Florian Angeletti, report by Dmitrii Kosarev)
+
 OCaml 4.14.0 (28 March 2022)
 ----------------------------
 
diff --git a/testsuite/tests/typing-external/pr11392.ml b/testsuite/tests/typing-external/pr11392.ml
new file mode 100644
index 0000000000..91c8ea77eb
--- /dev/null
+++ b/testsuite/tests/typing-external/pr11392.ml
@@ -0,0 +1,34 @@
+(* TEST
+   * expect
+*)
+
+type 'self nat =
+  | Z
+  | S of 'self
+;;
+[%%expect{|
+type 'self nat = Z | S of 'self
+|}]
+
+
+
+(* without rectypes: rejected *)
+external cast : int -> 'self nat as 'self = "%identity"
+;;
+[%%expect{|
+Line 1, characters 16-41:
+1 | external cast : int -> 'self nat as 'self = "%identity"
+                    ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This alias is bound to type int -> 'a nat
+       but is used as an instance of type 'a
+       The type variable 'a occurs inside int -> 'a nat
+|}]
+
+#rectypes;;
+
+(* with rectypes: accepted (used to crash) *)
+external cast : int -> 'self nat as 'self = "%identity"
+;;
+[%%expect{|
+external cast : int -> 'a nat as 'a = "%identity"
+|}]
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index 9d38ebe97e..d00c0fc450 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -1334,7 +1334,7 @@ let rec parse_native_repr_attributes env core_type ty ~global_repr =
       parse_native_repr_attributes env ct2 t2 ~global_repr
     in
     (repr_arg :: repr_args, repr_res)
-  | Ptyp_poly (_, t), _, _ ->
+  | (Ptyp_poly (_, t) | Ptyp_alias (t, _)), _, _ ->
      parse_native_repr_attributes env t ty ~global_repr
   | Ptyp_arrow _, _, _ | _, Tarrow _, _ -> assert false
   | _ -> ([], make_native_repr env core_type ty ~global_repr)
-- 
2.37.0.rc2