diff options
| -rw-r--r-- | src/type_check.ml | 6 | ||||
| -rw-r--r-- | test/typecheck/pass/repeat_constraint.sail | 9 | ||||
| -rw-r--r-- | test/typecheck/pass/repeat_constraint/v1.expect | 6 | ||||
| -rw-r--r-- | test/typecheck/pass/repeat_constraint/v1.sail | 9 |
4 files changed, 29 insertions, 1 deletions
diff --git a/src/type_check.ml b/src/type_check.ml index 82bc92d8..08b6eb5a 100644 --- a/src/type_check.ml +++ b/src/type_check.ml @@ -3882,7 +3882,11 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) = | Measure_aux (Measure_some exp,l) -> Measure_aux (Measure_some (crule check_exp env exp int_typ),l) in - let checked_body = crule check_exp (add_opt_constraint (assert_constraint env true checked_cond) env) body unit_typ in + let nc = match loop_type with + | While -> assert_constraint env true checked_cond + | Until -> None + in + let checked_body = crule check_exp (add_opt_constraint nc env) body unit_typ in annot_exp (E_loop (loop_type, checked_measure, checked_cond, checked_body)) unit_typ | E_for (v, f, t, step, ord, body) -> begin diff --git a/test/typecheck/pass/repeat_constraint.sail b/test/typecheck/pass/repeat_constraint.sail new file mode 100644 index 00000000..6d63f2e8 --- /dev/null +++ b/test/typecheck/pass/repeat_constraint.sail @@ -0,0 +1,9 @@ +$include <flow.sail> + +val main : unit -> unit + +function main() = { + repeat { + _not_prove(constraint(false)); + } until (false); +} diff --git a/test/typecheck/pass/repeat_constraint/v1.expect b/test/typecheck/pass/repeat_constraint/v1.expect new file mode 100644 index 00000000..9d561e11 --- /dev/null +++ b/test/typecheck/pass/repeat_constraint/v1.expect @@ -0,0 +1,6 @@ +Type error: +[[96mrepeat_constraint/v1.sail[0m]:7:4-29 +7[96m |[0m _prove(constraint(false)); + [91m |[0m [91m^-----------------------^[0m + [91m |[0m Cannot prove false + [91m |[0m diff --git a/test/typecheck/pass/repeat_constraint/v1.sail b/test/typecheck/pass/repeat_constraint/v1.sail new file mode 100644 index 00000000..5dd2f513 --- /dev/null +++ b/test/typecheck/pass/repeat_constraint/v1.sail @@ -0,0 +1,9 @@ +$include <flow.sail> + +val main : unit -> unit + +function main() = { + repeat { + _prove(constraint(false)); + } until (false); +} |
