changing the display of warnings-as-errors

parsing/location.ml

@@ -312,7 +312,9 @@ let default_warning_printer loc ppf w =
   if Warnings.is_active w then begin
     setup_colors ();
     print ppf loc;
-    fprintf ppf "@{<warning>%s@} %a@." warning_prefix Warnings.print w
+    if Warnings.is_error w
+    then fprintf ppf "%t %s %a@." print_error_prefix warning_prefix Warnings.print w
+    else fprintf ppf "@{<warning>%s@} %a@." warning_prefix Warnings.print w
   end
 ;;
 
@@ -346,6 +348,14 @@ type error =
     if_highlight: string; (* alternative message if locations are highlighted *)
   }
 
+let non_displayed_error =
+  {
+    loc = none;
+    msg = "";
+    sub = [];
+    if_highlight = ""
+  }
+
 let pp_ksprintf ?before k fmt =
   let buf = Buffer.create 64 in
   let ppf = Format.formatter_of_buffer buf in
@@ -390,21 +400,24 @@ let error_of_exn exn =
   loop !error_of_exn
 
 let rec default_error_reporter ppf ({loc; msg; sub; if_highlight} as err) =
-  let highlighted =
-    if if_highlight <> "" && loc.loc_start.pos_fname = "//toplevel//" then
-      let rec collect_locs locs {loc; sub; _} =
-        List.fold_left collect_locs (loc :: locs) sub
-      in
-      let locs = collect_locs [] err in
-      highlight_locations ppf locs
-    else
-      false
-  in
-  if highlighted then
-    Format.pp_print_string ppf if_highlight
-  else begin
-    fprintf ppf "%a%t %s" print loc print_error_prefix msg;
-    List.iter (Format.fprintf ppf "@\n@[<2>%a@]" default_error_reporter) sub
+  if msg <> "" then begin
+    let highlighted =
+      if if_highlight <> "" && loc.loc_start.pos_fname = "//toplevel//" then
+        let rec collect_locs locs {loc; sub; _} =
+          List.fold_left collect_locs (loc :: locs) sub
+        in
+        let locs = collect_locs [] err in
+        highlight_locations ppf locs
+      else
+        false
+    in
+    if highlighted then
+      Format.pp_print_string ppf if_highlight
+    else begin
+      fprintf ppf "%a%t %s" print loc print_error_prefix msg;
+      List.iter (Format.fprintf ppf "@\n@[<2>%a@]" default_error_reporter) sub
+    end;
+    Format.pp_print_newline ppf ();
   end
 
 let error_reporter = ref default_error_reporter
@@ -425,10 +438,8 @@ let () =
       | Sys_error msg ->
           Some (errorf ~loc:(in_file !input_name)
                 "I/O error: %s" msg)
-      | Warnings.Errors n ->
-          Some
-            (errorf ~loc:(in_file !input_name)
-             "Some fatal warnings were triggered (%d occurrences)" n)
+
+      | Warnings.Errors _ -> Some non_displayed_error
 
       | Misc.HookExnWrapper {error = e; hook_name;
                              hook_info={Misc.sourcefile}} ->
@@ -448,7 +459,7 @@ external reraise : exn -> 'a = "%reraise"
 let rec report_exception_rec n ppf exn =
   try match error_of_exn exn with
   | Some err ->
-      fprintf ppf "@[%a@]@." report_error err
+      fprintf ppf "@[%a@]@?" report_error err
   | None -> reraise exn
   with exn when n > 0 ->
     report_exception_rec (n-1) ppf exn

testsuite/tests/messages/precise_locations.ml

@@ -40,18 +40,14 @@ Foo ();;
 [%%expect{|
 type t = Foo of unit | Bar
 Line _, characters 0-6:
-Warning 3: deprecated: Foo
-Line _:
-Error: Some fatal warnings were triggered (1 occurrences)
+Error: Warning 3: deprecated: Foo
 |}];;
 function
 Foo _ -> () | Bar -> ();;
 (* "Foo _", the whole construct is deprecated *)
 [%%expect{|
 Line _, characters 0-5:
-Warning 3: deprecated: Foo
-Line _:
-Error: Some fatal warnings were triggered (1 occurrences)
+Error: Warning 3: deprecated: Foo
 |}];;
 
 
@@ -70,9 +66,7 @@ end);;
    on "open List" as whole rather than "List" *)
 [%%expect{|
 Line _, characters 0-9:
-Warning 33: unused open List.
-Line _:
-Error: Some fatal warnings were triggered (1 occurrences)
+Error: Warning 33: unused open List.
 |}];;
 
 type unknown += Foo;;