merge trunk up to commit 14699safe-string

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/safe-string@14700 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

9 files changed, 290 insertions, 50 deletions

diff --git a/testsuite/external/.ignore b/testsuite/external/.ignore
index 8b57bbb1eb..39e14de915 100644
--- a/testsuite/external/.ignore
+++ b/testsuite/external/.ignore
@@ -26,7 +26,7 @@ camlpdf-0.5
 camlp4
 camlp4-trunk
 camlp5
-camlp5-6.10
+camlp5-git
 camlzip
 camlzip-1.04
 camomile
diff --git a/testsuite/external/Makefile b/testsuite/external/Makefile
index 33acd2ae64..566aaf3921 100644
--- a/testsuite/external/Makefile
+++ b/testsuite/external/Makefile
@@ -44,10 +44,10 @@ all-cygwin: findlib ounit res pcre react ocamltext ocamlssl camlzip cryptokit \
 
 all-macos: findlib res pcre react ocamltext \
            ocamlssl camlzip cryptokit sqlite menhir hevea \
-           xmllight xmlm omake \
+           xmllight xmlm omake zen \
            altergo boomerang vsyml extlib \
            ocamlify calendar \
-           dbm framac
+           dbm geneweb framac coq compcert
 
 platform:
 	case `uname -s` in \
@@ -1573,56 +1573,53 @@ distclean::
 	rm -f ${CSV}.tar.gz
 all: csv
 
-# disabled: need to be updated for new AST stuff
-# # http://pauillac.inria.fr/~ddr/camlp5/
-# CAMLP5=camlp5-6.10
-# ${CAMLP5}.tgz:
-# 	${WGET} http://pauillac.inria.fr/~ddr/camlp5/distrib/src/$@
-# camlp5: ${CAMLP5}.tgz
-# 	printf "%s " "$@" >/dev/tty
-# 	test -d ${PREFIX}
-# 	rm -rf ${CAMLP5}
-# 	tar zxf ${CAMLP5}.tgz
-# 	./Patcher.sh ${CAMLP5}
-# 	( cd ${CAMLP5} && \
-# 	  export PATH=${PREFIX}/bin:$$PATH && \
-# 	  ./configure --transitional && \
-# 	  ${MAKE} world.opt && \
-# 	  ${MAKE} install )
-# 	echo ${VERSION} >$@
-# clean::
-# 	rm -rf ${CAMLP5} camlp5
-# distclean::
-# 	rm -f ${CAMLP5}.tgz
-# all: camlp5
-
-# disabled: depends on camlp5
-# # http://opensource.geneanet.org/projects/geneweb
-# GENEWEB=gw-6.05-src
-# ${GENEWEB}.tgz:
-# 	${WGET} http://opensource.geneanet.org/attachments/download/190/$@
-# geneweb: ${GENEWEB}.tgz camlp5
-# 	printf "%s " "$@" >/dev/tty
-# 	test -d ${PREFIX}
-# 	rm -rf ${GENEWEB}
-# 	tar zxf ${GENEWEB}.tgz
-# 	./Patcher.sh ${GENEWEB}
-# 	( cd ${GENEWEB} && \
-# 	  export PATH=${PREFIX}/bin:$$PATH && \
-# 	  sh ./configure && \
-# 	  ${MAKE} )
-# 	echo ${VERSION} >$@
-# clean::
-# 	rm -rf ${GENEWEB} geneweb
-# distclean::
-# 	rm -f ${GENEWEB}.tgz
-# all: geneweb
+# http://pauillac.inria.fr/~ddr/camlp5/
+CAMLP5=camlp5-git
+camlp5:
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${CAMLP5}
+	git clone git://scm.gforge.inria.fr/camlp5/camlp5.git ${CAMLP5}
+	./Patcher.sh ${CAMLP5}
+	( cd ${CAMLP5} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ./configure --transitional && \
+	  ${MAKE} world.opt && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${CAMLP5} camlp5
+distclean::
+	rm -f ${CAMLP5}-git
+all: camlp5
+
+disabled: depends on camlp5
+# http://opensource.geneanet.org/projects/geneweb
+GENEWEB=gw-6.05-src
+${GENEWEB}.tgz:
+	${WGET} http://opensource.geneanet.org/attachments/download/190/$@
+geneweb: ${GENEWEB}.tgz camlp5
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${GENEWEB}
+	tar zxf ${GENEWEB}.tgz
+	./Patcher.sh ${GENEWEB}
+	( cd ${GENEWEB} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure && \
+	  ${MAKE} )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${GENEWEB} geneweb
+distclean::
+	rm -f ${GENEWEB}.tgz
+all: geneweb
 
 # http://coq.inria.fr/download
 COQ=coq-8.4pl2
 ${COQ}.tar.gz:
 	${WGET} http://coq.inria.fr/distrib/V8.4pl2/files/$@
-xxcoq: ${COQ}.tar.gz camlp5
+coq: ${COQ}.tar.gz camlp5
 	printf "%s " "$@" >/dev/tty
 	test -d ${PREFIX}
 	rm -rf ${COQ}
diff --git a/testsuite/external/camlp5-git.patch b/testsuite/external/camlp5-git.patch
new file mode 100644
index 0000000000..8ea012cc5c
--- /dev/null
+++ b/testsuite/external/camlp5-git.patch
@@ -0,0 +1,12 @@
+diff --git a/Makefile b/Makefile
+index 13622f7..b33a042 100644
+--- camlp5-git/Makefile.orig
++++ camlp5-git/Makefile
+@@ -54,6 +54,7 @@ depend:
+ 	cd ocaml_stuff; $(MAKE) depend; cd ..
+ 	for i in $(DIRS) compile; do (cd $$i; $(MAKE) depend; cd ..); done
+ 
++.PHONY: install
+ install:
+ 	rm -rf "$(DESTDIR)$(LIBDIR)/$(CAMLP5N)"
+ 	for i in $(DIRS) compile; do \
diff --git a/testsuite/tests/asmcomp/parsecmm.mly b/testsuite/tests/asmcomp/parsecmm.mly
index ad697b6f4b..c81ca619b6 100644
--- a/testsuite/tests/asmcomp/parsecmm.mly
+++ b/testsuite/tests/asmcomp/parsecmm.mly
@@ -172,7 +172,7 @@ componentlist:
 ;
 expr:
     INTCONST    { Cconst_int $1 }
-  | FLOATCONST  { Cconst_float $1 }
+  | FLOATCONST  { Cconst_float (float_of_string $1) }
   | STRING      { Cconst_symbol $1 }
   | POINTER     { Cconst_pointer $1 }
   | IDENT       { Cvar(find_ident $1) }
@@ -316,7 +316,7 @@ dataitem:
   | BYTE INTCONST               { Cint8 $2 }
   | HALF INTCONST               { Cint16 $2 }
   | INT INTCONST                { Cint(Nativeint.of_int $2) }
-  | FLOAT FLOATCONST            { Cdouble $2 }
+  | FLOAT FLOATCONST            { Cdouble (float_of_string $2) }
   | ADDR STRING                 { Csymbol_address $2 }
   | ADDR INTCONST               { Clabel_address $2 }
   | KSTRING STRING              { Cstring $2 }
diff --git a/testsuite/tests/basic/constprop.ml b/testsuite/tests/basic/constprop.ml
new file mode 100644
index 0000000000..6661291316
--- /dev/null
+++ b/testsuite/tests/basic/constprop.ml
@@ -0,0 +1,72 @@
+(***********************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2014 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. *)
+(* *)
+(***********************************************************************)
+
+(* Test constant propagation through inlining *)
+
+(* constprop.ml is generated from constprop.mlp using
+      cpp constprop.mlp > constprop.ml
+*)
+let do_test msg res1 res2 =
+  Printf.printf "%s: %s\n" msg (if res1 = res2 then "passed" else "FAILED")
+(* Hide a constant from the optimizer, preventing constant propagation *)
+let hide x = List.nth [x] 0
+let _ =
+  begin
+    let x = true and y = false in
+    let xh = hide x and yh = hide y in
+    do_test "booleans" ((x && y, x || y, not x)) ((xh && yh, xh || yh, not xh))
+  end;
+  begin
+    let x = 89809344 and y = 457455773 and s = 7 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "integers" ((-x, x + y, x - y, x * y, x / y, x mod y, x land y, x lor y, x lxor y, x lsl s, x lsr s, x asr s, x = y, x <> y, x < y, x <= y, x > y, x >= y, succ x, pred y)) ((-xh, xh + yh, xh - yh, xh * yh, xh / yh, xh mod yh, xh land yh, xh lor yh, xh lxor yh, xh lsl sh, xh lsr sh, xh asr sh, xh = yh, xh <> yh, xh < yh, xh <= yh, xh > yh, xh >= yh, succ xh, pred yh))
+  end;
+  begin
+    let x = 3.141592654 and y = 0.341638588598232096 in
+    let xh = hide x and yh = hide y in
+    do_test "floats" ((int_of_float x, x +. y, x -. y, x *. y, x /. y, x = y, x <> y, x < y, x <= y, x > y, x >= y)) ((int_of_float xh, xh +. yh, xh -. yh, xh *. yh, xh /. yh, xh = yh, xh <> yh, xh < yh, xh <= yh, xh > yh, xh >= yh))
+  end;
+  begin
+    let x = 781944104l and y = 308219921l and s = 3 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "32-bit integers" (Int32.(neg x, add x y, sub x y, mul x y, div x y, rem x y, logand x y, logor x y, logxor x y, shift_left x s, shift_right x s, shift_right_logical x s, x = y, x <> y, x < y, x <= y, x > y, x >= y)) (Int32.(neg xh, add xh yh, sub xh yh, mul xh yh, div xh yh, rem xh yh, logand xh yh, logor xh yh, logxor xh yh, shift_left xh sh, shift_right xh sh, shift_right_logical xh sh, xh = yh, xh <> yh, xh < yh, xh <= yh, xh > yh, xh >= yh))
+  end;
+  begin
+    let x = 1828697041n and y = -521695949n and s = 8 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "native integers" (Nativeint.(neg x, add x y, sub x y, mul x y, div x y, rem x y, logand x y, logor x y, logxor x y, shift_left x s, shift_right x s, shift_right_logical x s, x = y, x <> y, x < y, x <= y, x > y, x >= y)) (Nativeint.(neg xh, add xh yh, sub xh yh, mul xh yh, div xh yh, rem xh yh, logand xh yh, logor xh yh, logxor xh yh, shift_left xh sh, shift_right xh sh, shift_right_logical xh sh, xh = yh, xh <> yh, xh < yh, xh <= yh, xh > yh, xh >= yh))
+  end;
+  begin
+    let x = 1511491586921138079L and y = 6677538715441746158L and s = 17 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "64-bit integers" (Int64.(neg x, add x y, sub x y, mul x y, div x y, rem x y, logand x y, logor x y, logxor x y, shift_left x s, shift_right x s, shift_right_logical x s, x = y, x <> y, x < y, x <= y, x > y, x >= y)) (Int64.(neg xh, add xh yh, sub xh yh, mul xh yh, div xh yh, rem xh yh, logand xh yh, logor xh yh, logxor xh yh, shift_left xh sh, shift_right xh sh, shift_right_logical xh sh, xh = yh, xh <> yh, xh < yh, xh <= yh, xh > yh, xh >= yh))
+  end;
+  begin
+    let x = 1000807289 in
+    let xh = hide x in
+    do_test "integer conversions" ((float_of_int x, Int32.of_int x, Nativeint.of_int x, Int64.of_int x)) ((float_of_int xh, Int32.of_int xh, Nativeint.of_int xh, Int64.of_int xh))
+  end;
+  begin
+    let x = 10486393l in
+    let xh = hide x in
+    do_test "32-bit integer conversions" ((Int32.to_int x, Nativeint.of_int32 x, Int64.of_int32 x)) ((Int32.to_int xh, Nativeint.of_int32 xh, Int64.of_int32 xh))
+  end;
+  begin
+    let x = -131134014n in
+    let xh = hide x in
+    do_test "native integer conversions" ((Nativeint.to_int x, Nativeint.to_int32 x, Int64.of_nativeint x)) ((Nativeint.to_int xh, Nativeint.to_int32 xh, Int64.of_nativeint xh))
+  end;
+  begin
+    let x = 531871273453404175L in
+    let xh = hide x in
+    do_test "64-bit integer conversions" ((Int64.to_int x, Int64.to_int32 x, Int64.to_nativeint x)) ((Int64.to_int xh, Int64.to_int32 xh, Int64.to_nativeint xh))
+  end
diff --git a/testsuite/tests/basic/constprop.mlp b/testsuite/tests/basic/constprop.mlp
new file mode 100644
index 0000000000..305a98dd95
--- /dev/null
+++ b/testsuite/tests/basic/constprop.mlp
@@ -0,0 +1,130 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2014 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* Test constant propagation through inlining *)
+
+(* constprop.ml is generated from constprop.mlp using
+      cpp constprop.mlp > constprop.ml
+*)
+
+#define tbool(x,y) \
+  (x && y, x || y, not x)
+
+#define tint(x,y,s)                                                         \
+  (-x, x + y, x - y, x * y, x / y, x mod y,                                 \
+   x land y, x lor y, x lxor y,                                             \
+   x lsl s, x lsr s, x asr s,                                               \
+   x = y, x <> y, x < y, x <= y, x > y, x >= y,                             \
+   succ x, pred y)
+
+#define tfloat(x,y)                                                         \
+  (int_of_float x,                                                          \
+   x +. y, x -. y, x *. y, x /. y,                                          \
+   x = y, x <> y, x < y, x <= y, x > y, x >= y)
+
+#define tconvint(i)                                                         \
+  (float_of_int i,                                                          \
+   Int32.of_int i,                                                          \
+   Nativeint.of_int i,                                                      \
+   Int64.of_int i)
+
+#define tconvint32(i)                                                       \
+  (Int32.to_int i,                                                          \
+   Nativeint.of_int32 i,                                                    \
+   Int64.of_int32 i)
+
+#define tconvnativeint(i)                                                   \
+  (Nativeint.to_int i,                                                      \
+   Nativeint.to_int32 i,                                                    \
+   Int64.of_nativeint i)
+
+#define tconvint64(i)                                                       \
+  (Int64.to_int i,                                                          \
+   Int64.to_int32 i,                                                        \
+   Int64.to_nativeint i)                                                    \
+
+#define tint32(x,y,s)                                                       \
+  Int32.(neg x, add x y, sub x y, mul x y, div x y, rem x y,                \
+         logand x y, logor x y, logxor x y,                                 \
+         shift_left x s, shift_right x s, shift_right_logical x s,          \
+         x = y, x <> y, x < y, x <= y, x > y, x >= y)
+  
+#define tnativeint(x,y,s)                                                   \
+  Nativeint.(neg x, add x y, sub x y, mul x y, div x y, rem x y,            \
+         logand x y, logor x y, logxor x y,                                 \
+         shift_left x s, shift_right x s, shift_right_logical x s,          \
+         x = y, x <> y, x < y, x <= y, x > y, x >= y)
+
+#define tint64(x,y,s)                                                       \
+  Int64.(neg x, add x y, sub x y, mul x y, div x y, rem x y,                \
+         logand x y, logor x y, logxor x y,                                 \
+         shift_left x s, shift_right x s, shift_right_logical x s,          \
+         x = y, x <> y, x < y, x <= y, x > y, x >= y)
+  
+let do_test msg res1 res2 =
+  Printf.printf "%s: %s\n" msg (if res1 = res2 then "passed" else "FAILED")
+
+(* Hide a constant from the optimizer, preventing constant propagation *)
+let hide x = List.nth [x] 0
+
+let _ =
+  begin
+    let x = true and y = false in
+    let xh = hide x and yh = hide y in
+    do_test "booleans" (tbool(x, y)) (tbool(xh,yh))
+  end;
+  begin
+    let x = 89809344 and y = 457455773 and s = 7 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "integers" (tint(x, y, s)) (tint(xh,yh,sh))
+  end;
+  begin
+    let x = 3.141592654 and y = 0.341638588598232096 in
+    let xh = hide x and yh = hide y in
+    do_test "floats" (tfloat(x, y)) (tfloat(xh, yh))
+  end;
+  begin
+    let x = 781944104l and y = 308219921l and s = 3 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "32-bit integers" (tint32(x, y, s)) (tint32(xh, yh, sh))
+  end;
+  begin
+    let x = 1828697041n and y = -521695949n and s = 8 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "native integers" (tnativeint(x, y, s)) (tnativeint(xh, yh, sh))
+  end;
+  begin
+    let x = 1511491586921138079L and y = 6677538715441746158L and s = 17 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "64-bit integers" (tint64(x, y, s)) (tint64(xh, yh, sh))
+  end;
+  begin
+    let x = 1000807289 in
+    let xh = hide x in
+    do_test "integer conversions" (tconvint(x)) (tconvint(xh))
+  end;
+  begin
+    let x = 10486393l in
+    let xh = hide x in
+    do_test "32-bit integer conversions" (tconvint32(x)) (tconvint32(xh))
+  end;
+  begin
+    let x = -131134014n in
+    let xh = hide x in
+    do_test "native integer conversions" (tconvnativeint(x)) (tconvnativeint(xh))
+  end;
+  begin
+    let x = 531871273453404175L in
+    let xh = hide x in
+    do_test "64-bit integer conversions" (tconvint64(x)) (tconvint64(xh))
+  end
+
diff --git a/testsuite/tests/basic/constprop.reference b/testsuite/tests/basic/constprop.reference
new file mode 100644
index 0000000000..59590530ae
--- /dev/null
+++ b/testsuite/tests/basic/constprop.reference
@@ -0,0 +1,10 @@
+booleans: passed
+integers: passed
+floats: passed
+32-bit integers: passed
+native integers: passed
+64-bit integers: passed
+integer conversions: passed
+32-bit integer conversions: passed
+native integer conversions: passed
+64-bit integer conversions: passed
diff --git a/testsuite/tests/typing-modules/aliases.ml b/testsuite/tests/typing-modules/aliases.ml
index a65812e4bb..b77b0c47db 100644
--- a/testsuite/tests/typing-modules/aliases.ml
+++ b/testsuite/tests/typing-modules/aliases.ml
@@ -204,3 +204,19 @@ module type Alias = sig module N : sig end module M = N end;;
 module F (X : sig end) = struct type t end;;
 module type A = Alias with module N := F(List);;
 module rec Bad : A = Bad;;
+
+(* Shinwell 2014-04-23 *)
+module B = struct
+ module R = struct
+   type t = string
+ end
+
+ module O = R
+end
+
+module K = struct
+ module E = B
+ module N = E.O
+end;;
+
+let x : K.N.t = "foo";;
diff --git a/testsuite/tests/typing-modules/aliases.ml.reference b/testsuite/tests/typing-modules/aliases.ml.reference
index d31516b987..e820b78e28 100644
--- a/testsuite/tests/typing-modules/aliases.ml.reference
+++ b/testsuite/tests/typing-modules/aliases.ml.reference
@@ -371,4 +371,7 @@ Error: Module type declarations do not match:
   module rec Bad : A = Bad;;
                    ^
 Error: Unbound module type A
+#                           module B : sig module R : sig type t = string end module O = R end
+module K : sig module E = B module N = E.O end
+#   val x : K.N.t = "foo"
 #