diff options
| -rw-r--r-- | src/type_check.ml | 9 | ||||
| -rw-r--r-- | test/typecheck/fail/missing_tick.expect | 11 | ||||
| -rw-r--r-- | test/typecheck/fail/missing_tick.sail | 7 | ||||
| -rw-r--r-- | test/typecheck/fail/struct_incomplete_literal.expect | 8 | ||||
| -rw-r--r-- | test/typecheck/fail/struct_incomplete_literal.sail | 12 | ||||
| -rwxr-xr-x | test/typecheck/run_tests.sh | 6 |
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: +[[96mmissing_tick.sail[0m]:5:16-17 +5[96m |[0mtype foo = bits(x) + [91m |[0m [91m^[0m + [91m |[0m Undefined synonym x + [91m |[0m This error was caused by: + [91m |[0m [[96mmissing_tick.sail[0m]:5:0-18 + [91m |[0m 5[96m |[0mtype foo = bits(x) + [91m |[0m [91m |[0m[91m^----------------^[0m + [91m |[0m [91m |[0m Types are not well-formed within this type definition. Note that recursive types are forbidden. + [91m |[0m 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: +[[96mstruct_incomplete_literal.sail[0m]:10:20-12:1 +10[96m |[0mlet foo_val : foo = struct { + [91m |[0m [91m^-------[0m +12[96m |[0m} + [91m |[0m[91m^[0m + [91m |[0m struct literal missing fields: b + [91m |[0m 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; |
