From 53959905b8e4bfd4877c1e052195391d89bdb0d6 Mon Sep 17 00:00:00 2001
From: Alasdair Armstrong
Date: Tue, 3 Jul 2018 19:06:03 +0100
Subject: Fix a bug in foreach loops

We should test before the first iteration in case 'to' starts out as
less than 'from'.
---
 src/c_backend.ml           | 15 +++++++--------
 test/c/foreach_none.expect |  1 +
 test/c/foreach_none.sail   | 11 +++++++++++
 3 files changed, 19 insertions(+), 8 deletions(-)
 create mode 100644 test/c/foreach_none.expect
 create mode 100644 test/c/foreach_none.sail

diff --git a/src/c_backend.ml b/src/c_backend.ml
index 8a41df67..4335e98e 100644
--- a/src/c_backend.ml
+++ b/src/c_backend.ml
@@ -1215,6 +1215,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
      in
 
      let loop_start_label = label "for_start_" in
+     let loop_end_label = label "for_end_" in
      let body_setup, _, body_call, body_cleanup = compile_aexp ctx body in
      let body_gs = gensym () in
 
@@ -1223,17 +1224,15 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
      @ variable_init step_gs step_setup step_ctyp step_call step_cleanup
      @ [iblock ([idecl CT_int64 loop_var;
                  icopy (CL_id loop_var) (F_id from_gs, CT_int64);
-                 ilabel loop_start_label;
                  idecl CT_unit body_gs;
-                 iblock (body_setup
+                 iblock ([ilabel loop_start_label]
+                         @ [ijump (F_op (F_id loop_var, (if is_inc then ">" else "<"), F_id to_gs), CT_bool) loop_end_label]
+                         @ body_setup
                          @ [body_call (CL_id body_gs)]
                          @ body_cleanup
-                         @ if is_inc then
-                             [icopy (CL_id loop_var) (F_op (F_id loop_var, "+", F_id step_gs), CT_int64);
-                              ijump (F_op (F_id loop_var, "<=", F_id to_gs), CT_bool) loop_start_label]
-                           else
-                             [icopy (CL_id loop_var) (F_op (F_id loop_var, "-", F_id step_gs), CT_int64);
-                              ijump (F_op (F_id loop_var, ">=", F_id to_gs), CT_bool) loop_start_label])])],
+                         @ [icopy (CL_id loop_var) (F_op (F_id loop_var, (if is_inc then "+" else "-"), F_id step_gs), CT_int64)]
+                         @ [igoto loop_start_label]);
+                 ilabel loop_end_label])],
      CT_unit,
      (fun clexp -> icopy clexp unit_fragment),
      []
diff --git a/test/c/foreach_none.expect b/test/c/foreach_none.expect
new file mode 100644
index 00000000..9766475a
--- /dev/null
+++ b/test/c/foreach_none.expect
@@ -0,0 +1 @@
+ok
diff --git a/test/c/foreach_none.sail b/test/c/foreach_none.sail
new file mode 100644
index 00000000..bc960b85
--- /dev/null
+++ b/test/c/foreach_none.sail
@@ -0,0 +1,11 @@
+
+val "print" : string -> unit
+
+val main : unit -> unit
+
+function main() = {
+  foreach (i from 0 to -1 by 1 in inc) {
+    print("unreachable\n");
+  };
+  print("ok\n")
+}
\ No newline at end of file
-- 
cgit v1.2.3