From 9f72a2a2fec0902aeae5e5082779bb197657c1f4 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer 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