summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLeo White <leo@lpw25.net>2019-06-28 14:31:42 +0100
committerGitHub <noreply@github.com>2019-06-28 14:31:42 +0100
commitc4dc6ba66ff1301373eb67d542f174db4cd71d23 (patch)
treec2e133ed34066aa0c20f04c87778041245b25b39
parentad5333d2b5bb5dc37d166e0583325b16554851c4 (diff)
downloadocaml-c4dc6ba66ff1301373eb67d542f174db4cd71d23.tar.gz
Fix #8769 (#8770)
* Don't generate illegal Pfield's when compiling alias coercions * Simplify lambda code when compiling packs * Add regression test for pr8769 * Add Changes entry
-rw-r--r--Changes3
-rw-r--r--asmcomp/asmpackager.ml2
-rw-r--r--bytecomp/bytepackager.ml1
-rw-r--r--bytecomp/translmod.ml5
-rw-r--r--testsuite/tests/regression/pr8769/fortuna.ml0
-rw-r--r--testsuite/tests/regression/pr8769/nocrypto.mli3
-rw-r--r--testsuite/tests/regression/pr8769/ocamltests1
-rw-r--r--testsuite/tests/regression/pr8769/pr8769.ml32
-rw-r--r--testsuite/tests/regression/pr8769/rng.ml1
9 files changed, 47 insertions, 1 deletions
diff --git a/Changes b/Changes
index 14ffd5613b..30efc781f1 100644
--- a/Changes
+++ b/Changes
@@ -7,6 +7,9 @@ OCaml 4.08 maintenance branch:
native-code on amd64. (observed with the mingw64 compiler)
(Nicolás Ojeda Bär, review by David Allsopp)
+- #8769, #8770: Fix assertion failure with -pack
+ (Leo White, review by Gabriel Scherer, report by Fabian @copy)
+
OCaml 4.08.0 (13 June 2019)
---------------------------
diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml
index cddb34631d..f079e0e6a8 100644
--- a/asmcomp/asmpackager.ml
+++ b/asmcomp/asmpackager.ml
@@ -101,6 +101,7 @@ let make_package_object ~ppf_dump members targetobj targetname coercion
let prefixname = Filename.remove_extension objtemp in
if Config.flambda then begin
let size, lam = Translmod.transl_package_flambda components coercion in
+ let lam = Simplif.simplify_lambda targetname lam in
let flam =
Middle_end.middle_end ~ppf_dump
~prefixname
@@ -116,6 +117,7 @@ let make_package_object ~ppf_dump members targetobj targetname coercion
let main_module_block_size, code =
Translmod.transl_store_package
components (Ident.create_persistent targetname) coercion in
+ let code = Simplif.simplify_lambda targetname code in
Asmgen.compile_implementation_clambda
prefixname ~ppf_dump { Lambda.code; main_module_block_size;
module_ident; required_globals = Ident.Set.empty }
diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml
index ba57ef9411..4c19f5c280 100644
--- a/bytecomp/bytepackager.ml
+++ b/bytecomp/bytepackager.ml
@@ -195,6 +195,7 @@ let build_global_target ~ppf_dump oc target_name members mapping pos coercion =
let lam =
Translmod.transl_package
components (Ident.create_persistent target_name) coercion in
+ let lam = Simplif.simplify_lambda target_name lam in
if !Clflags.dump_lambda then
Format.fprintf ppf_dump "%a@." Printlambda.lambda lam;
let instrs =
diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml
index c48e4f6e77..436344f484 100644
--- a/bytecomp/translmod.ml
+++ b/bytecomp/translmod.ml
@@ -72,7 +72,10 @@ let rec apply_coercion loc strict restr arg =
arg
| Tcoerce_structure(pos_cc_list, id_pos_list) ->
name_lambda strict arg (fun id ->
- let get_field pos = Lprim(Pfield pos,[Lvar id], loc) in
+ let get_field pos =
+ if pos < 0 then lambda_unit
+ else Lprim(Pfield pos,[Lvar id], loc)
+ in
let lam =
Lprim(Pmakeblock(0, Immutable, None),
List.map (apply_coercion_field loc get_field) pos_cc_list,
diff --git a/testsuite/tests/regression/pr8769/fortuna.ml b/testsuite/tests/regression/pr8769/fortuna.ml
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/regression/pr8769/fortuna.ml
diff --git a/testsuite/tests/regression/pr8769/nocrypto.mli b/testsuite/tests/regression/pr8769/nocrypto.mli
new file mode 100644
index 0000000000..94301b5a13
--- /dev/null
+++ b/testsuite/tests/regression/pr8769/nocrypto.mli
@@ -0,0 +1,3 @@
+module Rng : sig
+ module F : sig end
+end
diff --git a/testsuite/tests/regression/pr8769/ocamltests b/testsuite/tests/regression/pr8769/ocamltests
new file mode 100644
index 0000000000..195f6bcd00
--- /dev/null
+++ b/testsuite/tests/regression/pr8769/ocamltests
@@ -0,0 +1 @@
+pr8769.ml
diff --git a/testsuite/tests/regression/pr8769/pr8769.ml b/testsuite/tests/regression/pr8769/pr8769.ml
new file mode 100644
index 0000000000..fa0c73f7a4
--- /dev/null
+++ b/testsuite/tests/regression/pr8769/pr8769.ml
@@ -0,0 +1,32 @@
+(* TEST
+modules = "nocrypto.mli fortuna.ml rng.ml"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+module = "nocrypto.mli"
+** ocamlc.byte
+flags = "-for-pack Nocrypto"
+module = "fortuna.ml"
+** ocamlc.byte
+flags = "-for-pack Nocrypto"
+module = "rng.ml"
+** ocamlc.byte
+program = "nocrypto.cmo"
+flags = "-pack"
+all_modules = "fortuna.cmo rng.cmo"
+
+* setup-ocamlopt.byte-build-env
+** ocamlopt.byte
+module = "nocrypto.mli"
+** ocamlopt.byte
+flags = "-for-pack Nocrypto"
+module = "fortuna.ml"
+** ocamlopt.byte
+flags = "-for-pack Nocrypto"
+module = "rng.ml"
+** ocamlopt.byte
+program = "nocrypto.cmx"
+flags = "-pack"
+all_modules = "fortuna.cmx rng.cmx"
+
+*)
diff --git a/testsuite/tests/regression/pr8769/rng.ml b/testsuite/tests/regression/pr8769/rng.ml
new file mode 100644
index 0000000000..37a77602dc
--- /dev/null
+++ b/testsuite/tests/regression/pr8769/rng.ml
@@ -0,0 +1 @@
+module F = Fortuna