Kinds, and the notes that point at the other place
A kind is a stable id per error, so a test can assert which error this is without matching on prose and a message can be reworded without breaking anything. The reader's fourteen refusals all have one; in the checker they go on the errors a test names and the handful that are common enough to be worth classifying. Not a hundred of them, because jank has a hundred from being mature and the number is not the feature. The notes are the part that could not be said before. A duplicate definition now points at the second and notes the first; a duplicate parameter and a duplicate field do the same; an unknown field, an unknown struct and a non-exhaustive match all note the declaration and list what is actually there, so the reader's next move arrives with the question instead of after it. The reader's unclosed bracket is the clearest case — the error sits on the bracket, because that is where the fix goes, and the note sits where the file ran out, because that is the surprise. No message text changed, so every existing needle still means what it meant. The new assertions are on kinds and on note positions, which is the house rule about asserting the reason, made stable.
This commit is contained in:
parent
e8aeb89282
commit
17892852f8
111
lib/check.ml
111
lib/check.ml
@ -89,6 +89,33 @@ let new_env () = {
|
||||
lifted = [];
|
||||
}
|
||||
|
||||
(* Where a named type was declared, and what it has, as a note.
|
||||
|
||||
This is the second half of the two-place messages: a refusal that says
|
||||
[Cursor has no field pos] is true, and the reader's next move is always to
|
||||
go and look at Cursor. Attaching the declaration's location and its actual
|
||||
field names means the answer arrives with the question, and [next-error]
|
||||
will take you there because a note prints as an entry of its own. Empty when
|
||||
the name is not one this environment placed, so it degrades to the message
|
||||
alone rather than to a wrong pointer. *)
|
||||
let declared_note env name =
|
||||
match Hashtbl.find_opt env.locs name with
|
||||
| None -> []
|
||||
| Some at ->
|
||||
let names =
|
||||
match Hashtbl.find_opt env.structs name with
|
||||
| Some s -> List.map (fun (f : Tast.field) -> f.Tast.fname) s.Tast.fields
|
||||
| None ->
|
||||
(match Hashtbl.find_opt env.unions name with
|
||||
| Some u -> List.map (fun (c : Tast.variant) -> c.Tast.vname) u.Tast.cases
|
||||
| None -> [])
|
||||
in
|
||||
let what =
|
||||
if names = [] then name ^ " is declared here"
|
||||
else name ^ " is declared here, with " ^ String.concat ", " names
|
||||
in
|
||||
[ Loc.note at what ]
|
||||
|
||||
(* What a [break] or a [continue] may be talking about, innermost first.
|
||||
|
||||
[Lloop] is a loop it is lexically inside, carrying its label if it was given
|
||||
@ -495,7 +522,7 @@ and resolve_name env ~seen loc n =
|
||||
below would otherwise report [f65] as unimplemented generics and send
|
||||
you to plan.org instead of to the character you mistyped. *)
|
||||
| _ when near_miss env n <> None ->
|
||||
fail loc "unknown type %s — did you mean %s?" n
|
||||
Loc.failk "check/unknown-type" loc "unknown type %s — did you mean %s?" n
|
||||
(Option.get (near_miss env n))
|
||||
(* Lowercase is a type variable, Capitalized is concrete — no sigil
|
||||
(plan.org, Types). A variable parses, but nothing at milestone 2 can
|
||||
@ -503,7 +530,7 @@ and resolve_name env ~seen loc n =
|
||||
| _ when n <> "" && n.[0] = Char.lowercase_ascii n.[0] ->
|
||||
unimplemented loc
|
||||
(Printf.sprintf "generic code over the type variable %s" n) 5
|
||||
| _ -> fail loc "unknown type %s" n
|
||||
| _ -> Loc.failk "check/unknown-type" loc "unknown type %s" n
|
||||
|
||||
and array_len env loc = function
|
||||
| Ast.Lint n -> n
|
||||
@ -1013,7 +1040,9 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
|
||||
let target, sname = struct_target ctx target in
|
||||
let s = Hashtbl.find ctx.env.structs sname in
|
||||
(match Tast.field_index s name with
|
||||
| None -> fail loc "%s has no field %s" sname name
|
||||
| None ->
|
||||
Loc.failk "check/unknown-field" loc ~notes:(declared_note ctx.env sname)
|
||||
"%s has no field %s" sname name
|
||||
| Some i ->
|
||||
let fty = (List.nth s.Tast.fields i).Tast.fty in
|
||||
expect loc ~want (mk loc fty (Tast.Field (target, i))))
|
||||
@ -1250,7 +1279,8 @@ and var ctx loc ~want name =
|
||||
and pass that" name;
|
||||
expect loc ~want
|
||||
(mk loc (Types.Fn (params, ret)) (Tast.FnAddr (Tast.Fnval name)))
|
||||
| None -> captured ctx loc name; fail loc "unknown name %s" name)
|
||||
| None -> captured ctx loc name;
|
||||
Loc.failk "check/unknown-name" loc "unknown name %s" name)
|
||||
|
||||
(* Reading a move-only local. Every read is a move unless the site said it was
|
||||
a borrow, which is the conservative direction: passing one to a function,
|
||||
@ -1775,15 +1805,23 @@ and check_struct ctx ~want loc name kvs =
|
||||
"%s is a union, and a union value names the case as well as the \
|
||||
type — write (%s.%s {.field value ...}) for one of %s"
|
||||
name name (first_case_name ctx.env name) (case_list ctx.env name)
|
||||
else fail loc "unknown struct %s" name)
|
||||
else
|
||||
Loc.failk "check/unknown-struct" loc ~notes:(declared_note ctx.env name)
|
||||
"unknown struct %s" name)
|
||||
| Some s ->
|
||||
let seen = Hashtbl.create 8 in
|
||||
List.iter
|
||||
(fun (k, (v : Ast.expr)) ->
|
||||
if Hashtbl.mem seen k then
|
||||
fail v.Ast.loc "field %s is given twice" k;
|
||||
(match Hashtbl.find_opt seen k with
|
||||
| Some (first : Ast.expr) ->
|
||||
Loc.failk "check/duplicate-field" v.Ast.loc
|
||||
~notes:[ Loc.note first.Ast.loc (k ^ " is given here first") ]
|
||||
"field %s is given twice" k
|
||||
| None -> ());
|
||||
if Tast.field_index s k = None then
|
||||
fail v.Ast.loc "%s has no field %s" name k;
|
||||
Loc.failk "check/unknown-field" v.Ast.loc
|
||||
~notes:(declared_note ctx.env name)
|
||||
"%s has no field %s" name k;
|
||||
Hashtbl.add seen k v)
|
||||
kvs;
|
||||
(* Omitted fields are zeroed — ZII, the same rule as a declaration with no
|
||||
@ -1821,9 +1859,16 @@ and check_case ctx ~want loc uname (c : Tast.variant) kvs =
|
||||
let seen = Hashtbl.create 8 in
|
||||
List.iter
|
||||
(fun (k, (v : Ast.expr)) ->
|
||||
if Hashtbl.mem seen k then fail v.Ast.loc "field %s is given twice" k;
|
||||
(match Hashtbl.find_opt seen k with
|
||||
| Some (first : Ast.expr) ->
|
||||
Loc.failk "check/duplicate-field" v.Ast.loc
|
||||
~notes:[ Loc.note first.Ast.loc (k ^ " is given here first") ]
|
||||
"field %s is given twice" k
|
||||
| None -> ());
|
||||
if Tast.vfield_index c k = None then
|
||||
fail v.Ast.loc "%s has no field %s" full k;
|
||||
Loc.failk "check/unknown-field" v.Ast.loc
|
||||
~notes:(declared_note ctx.env uname)
|
||||
"%s has no field %s" full k;
|
||||
Hashtbl.add seen k v)
|
||||
kvs;
|
||||
let fields =
|
||||
@ -2002,7 +2047,12 @@ and check_match ctx ?want loc scrutinee arms =
|
||||
u.Tast.cases
|
||||
in
|
||||
if not !saw_wild && missing <> [] then
|
||||
fail loc
|
||||
(* The union's declaration, because that is where the case list this match
|
||||
failed to cover actually lives, and because adding a case there is what
|
||||
makes a match non-exhaustive in the first place. *)
|
||||
Loc.failk "check/non-exhaustive-match" loc
|
||||
~notes:(match subject with `Union u -> declared_note ctx.env u.Tast.uname
|
||||
| _ -> [])
|
||||
"this match is not exhaustive — %s %s no arm. Add %s, or a _ arm for \
|
||||
the rest"
|
||||
(String.concat ", " missing)
|
||||
@ -2050,12 +2100,15 @@ and check_place ctx loc (p : Ast.place) : Tast.place * Types.t =
|
||||
match Hashtbl.find_opt ctx.env.globals name with
|
||||
| Some (_, true) -> fail loc "%s is a constant" name
|
||||
| Some (ty, false) -> Tast.Pglobal name, ty
|
||||
| None -> captured ctx loc name; fail loc "unknown name %s" name)
|
||||
| None -> captured ctx loc name;
|
||||
Loc.failk "check/unknown-name" loc "unknown name %s" name)
|
||||
| Ast.Pfield (target, name) ->
|
||||
let target, sname = struct_target ctx target in
|
||||
let s = Hashtbl.find ctx.env.structs sname in
|
||||
(match Tast.field_index s name with
|
||||
| None -> fail loc "%s has no field %s" sname name
|
||||
| None ->
|
||||
Loc.failk "check/unknown-field" loc ~notes:(declared_note ctx.env sname)
|
||||
"%s has no field %s" sname name
|
||||
| Some i -> Tast.Pfield (target, i), (List.nth s.Tast.fields i).Tast.fty)
|
||||
| Ast.Pindex (target, idx) ->
|
||||
let target = borrowed ctx target (fun () -> check ctx target) in
|
||||
@ -3624,7 +3677,7 @@ and named_call ctx ~want loc name args =
|
||||
else if String.contains name '/' then
|
||||
unimplemented loc
|
||||
(Printf.sprintf "the call %s into an imported package" name) 4
|
||||
else fail loc "unknown function %s" name
|
||||
else Loc.failk "check/unknown-function" loc "unknown function %s" name
|
||||
|
||||
and is_cast name =
|
||||
Types.ikind_of_name name <> None || Types.fkind_of_name name <> None
|
||||
@ -3703,9 +3756,16 @@ let collect env (decls : Ast.decl list) =
|
||||
match Ast.declared_name d with
|
||||
| None -> ()
|
||||
| Some n ->
|
||||
if Hashtbl.mem claimed n then
|
||||
fail d.Ast.dloc "%s is defined twice" n;
|
||||
Hashtbl.add claimed n ())
|
||||
(match Hashtbl.find_opt claimed n with
|
||||
| Some first ->
|
||||
(* The second one is the error, because it is the one to delete;
|
||||
the first is the note, because without it the message is a
|
||||
claim the reader has to go and verify. *)
|
||||
Loc.failk "check/defined-twice" d.Ast.dloc
|
||||
~notes:[ Loc.note first (n ^ " is already defined here") ]
|
||||
"%s is defined twice" n
|
||||
| None -> ());
|
||||
Hashtbl.add claimed n d.Ast.dloc)
|
||||
decls;
|
||||
(* Names first, so a struct may mention one declared below it. *)
|
||||
List.iter
|
||||
@ -3966,8 +4026,21 @@ let check_fn env (fn : Ast.fn) : Tast.fn =
|
||||
owner = fn.Ast.name } in
|
||||
List.iter2
|
||||
(fun (p : Ast.field) ty ->
|
||||
if List.mem_assoc p.Ast.fname ctx.scope then
|
||||
fail p.Ast.floc "%s has two parameters named %s" fn.Ast.name p.Ast.fname;
|
||||
if List.mem_assoc p.Ast.fname ctx.scope then begin
|
||||
let first =
|
||||
List.find_opt
|
||||
(fun (q : Ast.field) -> q.Ast.fname = p.Ast.fname)
|
||||
fn.Ast.params
|
||||
in
|
||||
let notes =
|
||||
match first with
|
||||
| Some q when q != p ->
|
||||
[ Loc.note q.Ast.floc ("the first " ^ p.Ast.fname ^ " is here") ]
|
||||
| _ -> []
|
||||
in
|
||||
Loc.failk "check/duplicate-parameter" p.Ast.floc ~notes
|
||||
"%s has two parameters named %s" fn.Ast.name p.Ast.fname
|
||||
end;
|
||||
ignore (bind ctx p.Ast.fname ty ~assignable:false))
|
||||
fn.Ast.params params;
|
||||
let body =
|
||||
|
||||
@ -89,7 +89,7 @@ let read_string st =
|
||||
advance st; (* opening quote *)
|
||||
let buf = Buffer.create 16 in
|
||||
let rec go () =
|
||||
if at_end st then Loc.fail loc "unterminated string"
|
||||
if at_end st then Loc.failk "reader/unterminated-string" loc "unterminated string"
|
||||
else match peek st with
|
||||
| '"' -> advance st
|
||||
| '\\' ->
|
||||
@ -100,7 +100,7 @@ let read_string st =
|
||||
(match c with
|
||||
| 'n' -> '\n' | 't' -> '\t' | 'r' -> '\r'
|
||||
| '\\' -> '\\' | '"' -> '"' | '0' -> '\000'
|
||||
| c -> Loc.fail loc "unknown string escape \\%c" c);
|
||||
| c -> Loc.failk "reader/unknown-string-escape" loc "unknown string escape \\%c" c);
|
||||
go ()
|
||||
| c -> advance st; Buffer.add_char buf c; go ()
|
||||
in
|
||||
@ -111,7 +111,7 @@ let read_string st =
|
||||
let read_byte st =
|
||||
let loc = here st in
|
||||
advance st; (* backslash *)
|
||||
if at_end st then Loc.fail loc "expected a character after \\";
|
||||
if at_end st then Loc.failk "reader/incomplete-character" loc "expected a character after \\";
|
||||
let first = peek st in
|
||||
advance st;
|
||||
let rest = take_while st (fun c -> not (is_delimiter c)) in
|
||||
@ -123,7 +123,7 @@ let read_byte st =
|
||||
| "return" -> 13
|
||||
| "nul" -> 0
|
||||
| n when String.length n = 1 -> Char.code n.[0]
|
||||
| n -> Loc.fail loc "unknown character literal \\%s" n
|
||||
| n -> Loc.failk "reader/unknown-character" loc "unknown character literal \\%s" n
|
||||
in
|
||||
spanned st loc (Form.Byte code)
|
||||
|
||||
@ -139,23 +139,26 @@ let read_number st =
|
||||
if is_hex then
|
||||
match Int64.of_string_opt text with
|
||||
| Some i -> spanned st loc (Form.Int i)
|
||||
| None -> Loc.fail (Loc.upto loc (here st)) "malformed hex literal %s" text
|
||||
| None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
|
||||
"malformed hex literal %s" text
|
||||
else if String.contains text '.' || String.contains text 'e' then
|
||||
match float_of_string_opt text with
|
||||
| Some f -> spanned st loc (Form.Float f)
|
||||
| None -> Loc.fail (Loc.upto loc (here st)) "malformed float literal %s" text
|
||||
| None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
|
||||
"malformed float literal %s" text
|
||||
else
|
||||
match Int64.of_string_opt text with
|
||||
| Some i -> spanned st loc (Form.Int i)
|
||||
| None -> Loc.fail (Loc.upto loc (here st)) "malformed integer literal %s" text
|
||||
| None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
|
||||
"malformed integer literal %s" text
|
||||
|
||||
let read_symbol_or_keyword st =
|
||||
let loc = here st in
|
||||
let text = take_while st (fun c -> not (is_delimiter c)) in
|
||||
if text = "" then Loc.fail loc "unexpected character %C" (peek st);
|
||||
if text = "" then Loc.failk "reader/unexpected-character" loc "unexpected character %C" (peek st);
|
||||
if text.[0] = ':' then begin
|
||||
if String.length text = 1 then
|
||||
Loc.fail (Loc.upto loc (here st)) "empty keyword";
|
||||
Loc.failk "reader/empty-keyword" (Loc.upto loc (here st)) "empty keyword";
|
||||
spanned st loc (Form.Kw (String.sub text 1 (String.length text - 1)))
|
||||
end else
|
||||
spanned st loc (Form.Sym text)
|
||||
@ -177,9 +180,9 @@ let rec read_form st =
|
||||
skip_ignorable st;
|
||||
let loc = here st in
|
||||
match peek st with
|
||||
| '\000' -> Loc.fail loc "unexpected end of input"
|
||||
| '\000' -> Loc.failk "reader/unexpected-eof" loc "unexpected end of input"
|
||||
| '(' | '[' | '{' as open_c -> read_seq st open_c loc
|
||||
| ')' | ']' | '}' as c -> Loc.fail loc "unbalanced %C" c
|
||||
| ')' | ']' | '}' as c -> Loc.failk "reader/unbalanced" loc "unbalanced %C" c
|
||||
| '"' -> read_string st
|
||||
| '\\' -> read_byte st
|
||||
| '\'' -> read_sugar st loc "quote"
|
||||
@ -189,7 +192,7 @@ let rec read_form st =
|
||||
if peek st = '@' then (advance st; read_wrapped st loc "unquote-splicing")
|
||||
else read_wrapped st loc "unquote"
|
||||
| '^' ->
|
||||
Loc.fail loc "metadata (^) is not supported yet"
|
||||
Loc.failk "reader/metadata" loc "metadata (^) is not supported yet"
|
||||
|
||||
| c when is_digit c -> read_number st
|
||||
| ('-' | '+') when is_digit (peek2 st) -> read_number st
|
||||
@ -231,12 +234,22 @@ and read_seq st open_c loc =
|
||||
sequence would try to read a form and find [)]. *)
|
||||
skip_ignorable st;
|
||||
if at_end st then
|
||||
Loc.fail loc "unclosed %C, expected %C" open_c want
|
||||
(* Two places, and the second is the one that is usually news. The error
|
||||
is at the bracket that is still open, because that is where the fix
|
||||
goes; the note is where the file ran out, because that is how far the
|
||||
reader got believing the form was still being written. *)
|
||||
Loc.failk "reader/unclosed" loc
|
||||
~notes:[ Loc.note (here st) "the input ends here, still inside it" ]
|
||||
"unclosed %C, expected %C" open_c want
|
||||
else
|
||||
let c = peek st in
|
||||
if c = want then (advance st; List.rev acc)
|
||||
else if c = ')' || c = ']' || c = '}' then
|
||||
Loc.fail (here st) "expected %C to close %C, found %C" want open_c c
|
||||
(* The wrong closer is where the mistake reads, and the opener is what
|
||||
makes it wrong. Neither alone says which bracket to change. *)
|
||||
Loc.failk "reader/mismatched-closer" (here st)
|
||||
~notes:[ Loc.note loc (Printf.sprintf "%C is opened here" open_c) ]
|
||||
"expected %C to close %C, found %C" want open_c c
|
||||
else go (read_form st :: acc)
|
||||
in
|
||||
let items = go [] in
|
||||
|
||||
@ -1618,6 +1618,117 @@ let () =
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
contains m "the prelude macro n calls a macro");
|
||||
|
||||
(* ── Diagnostics: kind, notes, and more than one ───────────────
|
||||
The house rule is that a test asserts the *reason* a thing is refused. A
|
||||
kind is that assertion made stable: the message may be reworded and the
|
||||
row still holds, and a row that matches on a kind is saying something a
|
||||
substring match on prose could only approximate. The messages themselves
|
||||
are unchanged, so every existing needle still means what it meant. *)
|
||||
|
||||
let diag_of src =
|
||||
match checked src with
|
||||
| _ -> None
|
||||
| exception Loc.Error d -> Some d
|
||||
in
|
||||
let kind_is name src k =
|
||||
check name (match diag_of src with Some d -> d.Loc.kind = k | None -> false)
|
||||
in
|
||||
kind_is "unknown name has a kind"
|
||||
"(defn f [] i32 nope)" "check/unknown-name";
|
||||
kind_is "unknown field has a kind"
|
||||
"(defstruct S [a i32])\n(defn f [s S] i32 (.b s))" "check/unknown-field";
|
||||
kind_is "a name defined twice has a kind"
|
||||
"(defn f [] i32 1)\n(defn f [] i32 2)" "check/defined-twice";
|
||||
|
||||
(* The note is the half a location and a string could never carry: the
|
||||
*other* place, with its own span and its own explanation. *)
|
||||
(match diag_of "(defn f [] i32 1)\n(defn f [] i32 2)" with
|
||||
| Some d ->
|
||||
check "defined twice points at the second" (d.Loc.dloc.Loc.line = 2);
|
||||
(match d.Loc.notes with
|
||||
| [ n ] ->
|
||||
check "and notes the first" (n.Loc.nloc.Loc.line = 1);
|
||||
check "and says what it is" (contains n.Loc.nmsg "already defined")
|
||||
| ns -> check "defined twice has one note" (ns = []))
|
||||
| None -> check "defined twice is refused" false);
|
||||
|
||||
(match diag_of "(defstruct S [a i32])\n(defn f [s S] i32 (.b s))" with
|
||||
| Some d ->
|
||||
(match d.Loc.notes with
|
||||
| [ n ] ->
|
||||
check "an unknown field notes the declaration"
|
||||
(n.Loc.nloc.Loc.line = 1);
|
||||
check "and lists the fields there" (contains n.Loc.nmsg "with a")
|
||||
| _ -> check "an unknown field has one note" false)
|
||||
| None -> check "an unknown field is refused" false);
|
||||
|
||||
(* The reader's own two-place error. The bracket that is open is the error
|
||||
and the end of input is the note, because the fix goes at the first and
|
||||
the surprise is at the second. *)
|
||||
(match read "(f\n bad" with
|
||||
| _ -> check "unclosed is refused" false
|
||||
| exception Loc.Error d ->
|
||||
check "unclosed has a kind" (d.Loc.kind = "reader/unclosed");
|
||||
check "unclosed notes where the input ran out"
|
||||
(match d.Loc.notes with [ n ] -> n.Loc.nloc.Loc.line = 2 | _ -> false));
|
||||
|
||||
(match read "(f x]" with
|
||||
| _ -> check "a mismatched closer is refused" false
|
||||
| exception Loc.Error d ->
|
||||
check "a mismatched closer has a kind"
|
||||
(d.Loc.kind = "reader/mismatched-closer");
|
||||
check "and notes the opener"
|
||||
(match d.Loc.notes with [ n ] -> n.Loc.nloc.Loc.col = 1 | _ -> false));
|
||||
|
||||
(* More than one per run, which is the point of the whole batch. Three bad
|
||||
bodies, three diagnostics, and the count is exact: a checker that reported
|
||||
the first and a checker that reported thirty pieces of wreckage would both
|
||||
fail this row. *)
|
||||
(match
|
||||
Check.program ~keep_going:true
|
||||
(Parse.program ~keep_going:true
|
||||
(read "(defn a [] i32 nope1)\n\
|
||||
(defn b [] i32 nope2)\n\
|
||||
(defn c [] i32 nope3)\n"))
|
||||
with
|
||||
| _ -> check "three bad bodies are refused" false
|
||||
| exception Loc.Errors ds ->
|
||||
check "three bad bodies give three errors" (List.length ds = 3);
|
||||
check "and they are in source order"
|
||||
(List.map (fun (d : Loc.diag) -> d.Loc.dloc.Loc.line) ds = [ 1; 2; 3 ]));
|
||||
|
||||
(* The parser resynchronises on a top-level form, so two bad declarations are
|
||||
two errors rather than one. *)
|
||||
(match Parse.program ~keep_going:true (read "(defn a)\n(defn b)\n") with
|
||||
| _ -> check "two bad declarations are refused" false
|
||||
| exception Loc.Errors ds ->
|
||||
check "two bad declarations give two errors" (List.length ds = 2));
|
||||
|
||||
(* One form at a time still raises one, which is what the daemon depends on:
|
||||
it catches [Loc.Error] and would not see a list. *)
|
||||
(match Check.program (Parse.program (read "(defn a [] i32 nope1)\n\
|
||||
(defn b [] i32 nope2)\n")) with
|
||||
| _ -> check "without keep_going it still refuses" false
|
||||
| exception Loc.Errors _ ->
|
||||
check "without keep_going there is no list" false
|
||||
| exception Loc.Error _ -> ());
|
||||
|
||||
(* The first line of a report is exactly the GNU format compilation-mode
|
||||
parses, and the squiggle is on an indented line under it, which that mode
|
||||
ignores. Both halves are load-bearing and neither is visible from the
|
||||
message alone. *)
|
||||
(match diag_of "(defn f [] i32 nope)" with
|
||||
| Some d ->
|
||||
let lines = String.split_on_char '\n' (Loc.report d) in
|
||||
(match lines with
|
||||
| head :: rest ->
|
||||
check "the first line is file:line:col: message"
|
||||
(head = Loc.to_string d.Loc.dloc ^ ": " ^ d.Loc.dmsg);
|
||||
check "and the rest is indented"
|
||||
(List.for_all (fun l -> l = "" || l.[0] = ' ') rest)
|
||||
| [] -> check "a report has a first line" false)
|
||||
| None -> check "a report needs a diagnostic" false);
|
||||
|
||||
(* ── The acceptance program checks end to end ──────────────────── *)
|
||||
accepts "calc-me.flan type checks"
|
||||
(In_channel.with_open_bin "../calc-me.flan" In_channel.input_all);
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user