summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/type_check.ml9
-rw-r--r--test/typecheck/fail/missing_tick.expect11
-rw-r--r--test/typecheck/fail/missing_tick.sail7
-rw-r--r--test/typecheck/fail/struct_incomplete_literal.expect8
-rw-r--r--test/typecheck/fail/struct_incomplete_literal.sail12
-rwxr-xr-xtest/typecheck/run_tests.sh6
6 files changed, 48 insertions, 5 deletions
diff --git a/src/type_check.ml b/src/type_check.ml
index 73ad5362..3b047040 100644
--- a/src/type_check.ml
+++ b/src/type_check.ml
@@ -2838,20 +2838,25 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ
in
annot_exp (E_record_update (checked_exp, List.map check_fexp fexps)) typ
| E_record fexps, _ ->
- (* TODO: check record fields are total *)
let rectyp_id = match Env.expand_synonyms env typ with
| Typ_aux (Typ_id rectyp_id, _) | Typ_aux (Typ_app (rectyp_id, _), _) when Env.is_record rectyp_id env ->
rectyp_id
| _ -> typ_error env l ("The type " ^ string_of_typ typ ^ " is not a record")
in
+ let record_fields = ref (Env.get_record rectyp_id env |> snd |> List.map snd |> IdSet.of_list) in
let check_fexp (FE_aux (FE_Fexp (field, exp), (l, ()))) =
+ record_fields := IdSet.remove field !record_fields;
let (typq, rectyp_q, field_typ, _) = Env.get_accessor rectyp_id field env in
let unifiers = try unify l env (tyvars_of_typ rectyp_q) rectyp_q typ with Unification_error (l, m) -> typ_error env l ("Unification error: " ^ m) in
let field_typ' = subst_unifiers unifiers field_typ in
let checked_exp = crule check_exp env exp field_typ' in
FE_aux (FE_Fexp (field, checked_exp), (l, None))
in
- annot_exp (E_record (List.map check_fexp fexps)) typ
+ let fexps = List.map check_fexp fexps in
+ if IdSet.is_empty !record_fields then
+ annot_exp (E_record fexps) typ
+ else
+ typ_error env l ("struct literal missing fields: " ^ string_of_list ", " string_of_id (IdSet.elements !record_fields))
| E_let (LB_aux (letbind, (let_loc, _)), exp), _ ->
begin
match letbind with
diff --git a/test/typecheck/fail/missing_tick.expect b/test/typecheck/fail/missing_tick.expect
new file mode 100644
index 00000000..b447fdd2
--- /dev/null
+++ b/test/typecheck/fail/missing_tick.expect
@@ -0,0 +1,11 @@
+Type error:
+[missing_tick.sail]:5:16-17
+5 |type foo = bits(x)
+  | ^
+  | Undefined synonym x
+  | This error was caused by:
+  | [missing_tick.sail]:5:0-18
+  | 5 |type foo = bits(x)
+  |  |^----------------^
+  |  | Types are not well-formed within this type definition. Note that recursive types are forbidden.
+  |
diff --git a/test/typecheck/fail/missing_tick.sail b/test/typecheck/fail/missing_tick.sail
new file mode 100644
index 00000000..67a468b1
--- /dev/null
+++ b/test/typecheck/fail/missing_tick.sail
@@ -0,0 +1,7 @@
+default Order dec
+$include <vector_dec.sail>
+
+let 'x = 0
+type foo = bits(x)
+
+function y() : unit -> foo = sail_zeros(0)
diff --git a/test/typecheck/fail/struct_incomplete_literal.expect b/test/typecheck/fail/struct_incomplete_literal.expect
new file mode 100644
index 00000000..2178d1a1
--- /dev/null
+++ b/test/typecheck/fail/struct_incomplete_literal.expect
@@ -0,0 +1,8 @@
+Type error:
+[struct_incomplete_literal.sail]:10:20-12:1
+10 |let foo_val : foo = struct {
+  | ^-------
+12 |}
+  |^
+  | struct literal missing fields: b
+  |
diff --git a/test/typecheck/fail/struct_incomplete_literal.sail b/test/typecheck/fail/struct_incomplete_literal.sail
new file mode 100644
index 00000000..f5c07c2e
--- /dev/null
+++ b/test/typecheck/fail/struct_incomplete_literal.sail
@@ -0,0 +1,12 @@
+default Order dec
+
+$include <prelude.sail>
+
+struct foo = {
+ a : int,
+ b : int
+}
+
+let foo_val : foo = struct {
+ a = 1
+}
diff --git a/test/typecheck/run_tests.sh b/test/typecheck/run_tests.sh
index adc30c42..e0720baf 100755
--- a/test/typecheck/run_tests.sh
+++ b/test/typecheck/run_tests.sh
@@ -92,13 +92,13 @@ do
pushd $DIR/fail > /dev/null;
if $SAILDIR/sail -no_memo_z3 $(basename $file) 2> result
then
- red "Expected failure, but $i $(basename $file) passed" "fail"
+ red "Expected failure, but $(basename $file) passed" "fail"
else
if diff ${file%.sail}.expect result;
then
- green "failing $i $(basename $file)" "pass"
+ green "failing $(basename $file)" "pass"
else
- yellow "failing $i $(basename $file)" "unexpected error"
+ yellow "failing $(basename $file)" "unexpected error"
fi
fi;
rm -f result;