ocaml/0010-Merge-pull-request-11396-from-gasche-fix11392.patch
Richard W.M. Jones 6fbb4db452 Include more upstream patches from 4.14 branch
Don't use %configure macro because that breaks on riscv64.
https://bugzilla.redhat.com/2124272
2022-09-06 13:34:55 +01:00

86 lines
2.7 KiB
Diff

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