Fix PR#6920

Make sure correct debugging informations are generated for %apply and
%revapply.

6 files changed, 35 insertions, 4 deletions

diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index efbb8919d9..fd1709e0fc 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -640,7 +640,8 @@ let primitive_is_ccall = function
   (* Determine if a primitive is a Pccall or will be turned later into
      a C function call that may raise an exception *)
   | Pccall _ | Pstringrefs | Pstringsets | Parrayrefs _ | Parraysets _ |
-    Pbigarrayref _ | Pbigarrayset _ | Pduprecord _ -> true
+    Pbigarrayref _ | Pbigarrayset _ | Pduprecord _ | Pdirapply _ |
+    Prevapply _ -> true
   | _ -> false
 
 (* Assertions *)
diff --git a/testsuite/tests/backtrace/Makefile b/testsuite/tests/backtrace/Makefile
index 1d638f5427..6faa1a26a3 100644
--- a/testsuite/tests/backtrace/Makefile
+++ b/testsuite/tests/backtrace/Makefile
@@ -16,7 +16,8 @@ EXECNAME=program$(EXE)
 ABCDFILES=backtrace.ml
 OTHERFILES=backtrace2.ml raw_backtrace.ml \
            backtrace_deprecated.ml backtrace_slots.ml
-OTHERFILESNOINLINING=backtraces_and_finalizers.ml
+OTHERFILESNOINLINING=pr6920_why_at.ml pr6920_why_swallow.ml
+OTHERFILESNOINLINING_NATIVE=backtraces_and_finalizers.ml
 
 default:
 	@$(MAKE) byte
@@ -37,7 +38,7 @@ byte:
 	    && echo " => passed" || echo " => failed"; \
 	  done; \
 	done
-	@for file in $(OTHERFILES); do \
+	@for file in $(OTHERFILES) $(OTHERFILESNOINLINING); do \
 	  rm -f program program.exe; \
 	  $(OCAMLC) -g -o $(EXECNAME) $$file; \
 	  printf " ... testing '$$file' with ocamlc:"; \
@@ -75,7 +76,8 @@ native:
 	  $(DIFF) $$F.reference $$F.native.result >/dev/null \
 	  && echo " => passed" || echo " => failed"; \
 	done;
-	@for file in $(OTHERFILESNOINLINING); do \
+	@for file in $(OTHERFILESNOINLINING) $(OTHERFILESNOINLINING_NATIVE); \
+	do \
 	  rm -f program program.exe; \
 	  $(OCAMLOPT) -inline 0 -g -o $(EXECNAME) $$file; \
 	  printf " ... testing '$$file' with ocamlopt:"; \
diff --git a/testsuite/tests/backtrace/pr6920_why_at.ml b/testsuite/tests/backtrace/pr6920_why_at.ml
new file mode 100644
index 0000000000..2bacd9fd4c
--- /dev/null
+++ b/testsuite/tests/backtrace/pr6920_why_at.ml
@@ -0,0 +1,9 @@
+let why : unit -> unit = fun () -> raise Exit
+let f () =
+  why @@ ();
+  ignore (3 + 2);
+  ()
+
+let () =
+  Printexc.record_backtrace true;
+  f ()
diff --git a/testsuite/tests/backtrace/pr6920_why_at.reference b/testsuite/tests/backtrace/pr6920_why_at.reference
new file mode 100644
index 0000000000..dcc2fcc1e8
--- /dev/null
+++ b/testsuite/tests/backtrace/pr6920_why_at.reference
@@ -0,0 +1,4 @@
+Fatal error: exception Pervasives.Exit
+Raised at file "pr6920_why_at.ml", line 1, characters 41-45
+Called from file "pr6920_why_at.ml", line 3, characters 2-11
+Called from file "pr6920_why_at.ml", line 9, characters 2-6
diff --git a/testsuite/tests/backtrace/pr6920_why_swallow.ml b/testsuite/tests/backtrace/pr6920_why_swallow.ml
new file mode 100644
index 0000000000..5938956d0f
--- /dev/null
+++ b/testsuite/tests/backtrace/pr6920_why_swallow.ml
@@ -0,0 +1,11 @@
+let why : unit -> unit = fun () -> raise Exit
+let f () =
+  for i = 1 to 10 do
+    why @@ ();
+  done;
+  ignore (3 + 2);
+  ()
+
+let () =
+  Printexc.record_backtrace true;
+  f ()
diff --git a/testsuite/tests/backtrace/pr6920_why_swallow.reference b/testsuite/tests/backtrace/pr6920_why_swallow.reference
new file mode 100644
index 0000000000..ad66532f31
--- /dev/null
+++ b/testsuite/tests/backtrace/pr6920_why_swallow.reference
@@ -0,0 +1,4 @@
+Fatal error: exception Pervasives.Exit
+Raised at file "pr6920_why_swallow.ml", line 1, characters 41-45
+Called from file "pr6920_why_swallow.ml", line 4, characters 4-14
+Called from file "pr6920_why_swallow.ml", line 11, characters 2-6