Add typing tests for [@unboxed] and [@untagged]

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@16388 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

3 files changed, 238 insertions, 0 deletions

diff --git a/testsuite/tests/typing-unboxed/Makefile b/testsuite/tests/typing-unboxed/Makefile
new file mode 100644
index 0000000000..c9433b2ecb
--- /dev/null
+++ b/testsuite/tests/typing-unboxed/Makefile
@@ -0,0 +1,15 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.toplevel
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/typing-unboxed/test.ml b/testsuite/tests/typing-unboxed/test.ml
new file mode 100644
index 0000000000..65091481b4
--- /dev/null
+++ b/testsuite/tests/typing-unboxed/test.ml
@@ -0,0 +1,94 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                 Jeremie Dimino, Jane Street Europe                  *)
+(*                                                                     *)
+(*  Copyright 2015 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+
+external a : (int [@untagged]) -> unit = "a"
+external b : (int32 [@unboxed]) -> unit = "b"
+external c : (int64 [@unboxed]) -> unit = "c"
+external d : (nativeint [@unboxed]) -> unit = "d"
+external e : (float [@unboxed]) -> unit = "e"
+
+type t = private int
+
+external f : (t [@untagged]) -> unit = "f"
+
+module M : sig
+  external a : int -> (int [@untagged]) = "a"
+  external b : (int [@untagged]) -> int = "b"
+end = struct
+  external a : int -> (int [@untagged]) = "a"
+  external b : (int [@untagged]) -> int = "b"
+end;;
+
+(* Bad: attributes not reported in the interface *)
+
+module Bad1 : sig
+  external f : int -> int = "f"
+end = struct
+  external f : int -> (int [@untagged]) = "f"
+end;;
+
+module Bad2 : sig
+  external f : int -> int = "a"
+end = struct
+  external f : (int [@untagged]) -> int = "f"
+end;;
+
+module Bad3 : sig
+  external f : float -> float = "f"
+end = struct
+  external f : float -> (float [@unboxed]) = "f"
+end;;
+
+module Bad4 : sig
+  external f : float -> float = "a"
+end = struct
+  external f : (float [@unboxed]) -> float = "f"
+end;;
+
+(* Bad: attributes in the interface but not in the implementation *)
+
+module Bad5 : sig
+  external f : int -> (int [@untagged]) = "f"
+end = struct
+  external f : int -> int = "f"
+end;;
+
+module Bad6 : sig
+  external f : (int [@untagged]) -> int = "f"
+end = struct
+  external f : int -> int = "a"
+end;;
+
+module Bad7 : sig
+  external f : float -> (float [@unboxed]) = "f"
+end = struct
+  external f : float -> float = "f"
+end;;
+
+module Bad8 : sig
+  external f : (float [@unboxed]) -> float = "f"
+end = struct
+  external f : float -> float = "a"
+end;;
+
+(* Bad: unboxed or untagged with the wrong type *)
+
+external g : (float [@untagged]) -> float = "g";;
+external h : (int [@unboxed]) -> float = "h";;
+
+(* This should be rejected, but it is quite complicated to do
+   in the current state of things *)
+
+external i : int -> float [@unboxed] = "i";;
+external j : int -> (float [@unboxed]) * float = "j";;
+external k : int -> (float [@unboxd]) = "k";;
diff --git a/testsuite/tests/typing-unboxed/test.ml.reference b/testsuite/tests/typing-unboxed/test.ml.reference
new file mode 100644
index 0000000000..cb70eaaa1e
--- /dev/null
+++ b/testsuite/tests/typing-unboxed/test.ml.reference
@@ -0,0 +1,129 @@
+
+#                                                           external a : (int [@untagged]) -> unit = "a"
+external b : (int32 [@unboxed]) -> unit = "b"
+external c : (int64 [@unboxed]) -> unit = "c"
+external d : (nativeint [@unboxed]) -> unit = "d"
+external e : (float [@unboxed]) -> unit = "e"
+type t = private int
+external f : (t [@untagged]) -> unit = "f"
+module M :
+  sig
+    external a : int -> (int [@untagged]) = "a"
+    external b : (int [@untagged]) -> int = "b"
+  end
+#               Characters 110-166:
+  ......struct
+    external f : int -> (int [@untagged]) = "f"
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : int -> (int [@untagged]) = "f" end
+       is not included in
+         sig external f : int -> int = "f" end
+       Values do not match:
+         external f : int -> (int [@untagged]) = "f"
+       is not included in
+         external f : int -> int = "f"
+#           Characters 57-113:
+  ......struct
+    external f : (int [@untagged]) -> int = "f"
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : (int [@untagged]) -> int = "f" end
+       is not included in
+         sig external f : int -> int = "a" end
+       Values do not match:
+         external f : (int [@untagged]) -> int = "f"
+       is not included in
+         external f : int -> int = "a"
+#           Characters 61-120:
+  ......struct
+    external f : float -> (float [@unboxed]) = "f"
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : float -> (float [@unboxed]) = "f" end
+       is not included in
+         sig external f : float -> float = "f" end
+       Values do not match:
+         external f : float -> (float [@unboxed]) = "f"
+       is not included in
+         external f : float -> float = "f"
+#           Characters 61-120:
+  ......struct
+    external f : (float [@unboxed]) -> float = "f"
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : (float [@unboxed]) -> float = "f" end
+       is not included in
+         sig external f : float -> float = "a" end
+       Values do not match:
+         external f : (float [@unboxed]) -> float = "f"
+       is not included in
+         external f : float -> float = "a"
+#               Characters 141-183:
+  ......struct
+    external f : int -> int = "f"
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : int -> int = "f" end
+       is not included in
+         sig external f : int -> (int [@untagged]) = "f" end
+       Values do not match:
+         external f : int -> int = "f"
+       is not included in
+         external f : int -> (int [@untagged]) = "f"
+#           Characters 71-113:
+  ......struct
+    external f : int -> int = "a"
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : int -> int = "a" end
+       is not included in
+         sig external f : (int [@untagged]) -> int = "f" end
+       Values do not match:
+         external f : int -> int = "a"
+       is not included in
+         external f : (int [@untagged]) -> int = "f"
+#           Characters 74-120:
+  ......struct
+    external f : float -> float = "f"
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : float -> float = "f" end
+       is not included in
+         sig external f : float -> (float [@unboxed]) = "f" end
+       Values do not match:
+         external f : float -> float = "f"
+       is not included in
+         external f : float -> (float [@unboxed]) = "f"
+#           Characters 74-120:
+  ......struct
+    external f : float -> float = "a"
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig external f : float -> float = "a" end
+       is not included in
+         sig external f : (float [@unboxed]) -> float = "f" end
+       Values do not match:
+         external f : float -> float = "a"
+       is not included in
+         external f : (float [@unboxed]) -> float = "f"
+#       Characters 67-72:
+  external g : (float [@untagged]) -> float = "g";;
+                ^^^^^
+Error: Don't know how to untag this type. Only int can be untagged
+# Characters 14-17:
+  external h : (int [@unboxed]) -> float = "h";;
+                ^^^
+Error: Don't know how to unbox this type. Only float, int32, int64 and nativeint can be unboxed
+#   *     external i : int -> float = "i"
+# external j : int -> float * float = "j"
+# external k : int -> float = "k"
+#