diff options
Diffstat (limited to 'bin')
| -rw-r--r-- | bin/qsp_parser.ml | 37 |
1 files changed, 23 insertions, 14 deletions
diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml index 30c0ac0..ebf4738 100644 --- a/bin/qsp_parser.ml +++ b/bin/qsp_parser.ml @@ -12,7 +12,7 @@ let filter_report : Args.filters -> Report.t list -> Report.t -> Report.t list = match is_ok with true -> r :: reports | _ -> reports -type ctx = { error_nb : int; warn_nb : int; debug_nb : int } +type ctx = { error_nb : int; warn_nb : int; debug_nb : int; fatal_error : bool } (* List all the controls to apply @@ -98,8 +98,9 @@ let parse_location : fun ~ctx (module Check) context lexbuf filters -> let result = Qparser.Analyzer.parse (module Check) lexbuf context - |> Result.map (fun (_, f) -> - List.fold_left f ~init:[] ~f:(filter_report filters) + |> Result.map (fun f -> + List.fold_left f.Qparser.Analyzer.report ~init:[] + ~f:(filter_report filters) |> List.sort ~cmp:Report.compare) in match result with @@ -120,7 +121,7 @@ let parse_location : let start_position, _ = Qparser.Lexbuf.positions lexbuf in Format.fprintf Format.std_formatter "Location@ %s@;@[%a]@." start_position.Lexing.pos_fname Report.pp e; - ctx := { !ctx with error_nb = succ !ctx.error_nb } + ctx := { !ctx with error_nb = succ !ctx.error_nb; fatal_error = true } let () = let file_names, parameters = @@ -156,7 +157,9 @@ let () = (* Initialize all the checkers before parsing the source *) let (module Check) = Lazy.force checkers in let check_context = Check.initialize () in - let ctx = ref { error_nb = 0; warn_nb = 0; debug_nb = 0 } in + let ctx = + ref { error_nb = 0; warn_nb = 0; debug_nb = 0; fatal_error = false } + in let () = try @@ -168,16 +171,22 @@ let () = with Qparser.Lexer.EOF -> () in - (* If the parsing was global, extract the result for the whole test *) - let global_report = Check.finalize check_context in - List.iter global_report ~f:(fun (f_name, report) -> - Format.fprintf Format.std_formatter "Location@ %s@;@[%a@]@." f_name - Report.pp report; + (match !ctx.fatal_error with + | true -> + Format.fprintf Format.std_formatter + "(Ignoring global checkers because of the previous syntax errors)@." + | false -> + (* If the parsing was global and we didn’t got parsing error, extract the + result for the whole test *) + let global_report = Check.finalize check_context in + List.iter global_report ~f:(fun (f_name, report) -> + Format.fprintf Format.std_formatter "Location@ %s@;@[%a@]@." f_name + Report.pp report; - match report.Report.level with - | Error -> ctx := { !ctx with error_nb = succ !ctx.error_nb } - | Warn -> ctx := { !ctx with warn_nb = succ !ctx.warn_nb } - | Debug -> ctx := { !ctx with debug_nb = succ !ctx.debug_nb }); + match report.Report.level with + | Error -> ctx := { !ctx with error_nb = succ !ctx.error_nb } + | Warn -> ctx := { !ctx with warn_nb = succ !ctx.warn_nb } + | Debug -> ctx := { !ctx with debug_nb = succ !ctx.debug_nb })); match (!ctx.error_nb, !ctx.warn_nb) with | 0, 0 -> ( |