From 5ad0303141a1632004ef0ba7f57e6a0253db0923 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Thu, 9 Jul 2020 11:52:49 +0200 Subject: [PATCH] [Ada] Alternative display of multi-line messages for GNATprove gcc/ada/ * debug.adb: Use debug switch -gnatdF for this alternative display of messages. * errout.adb (Output_Messages): Alternative display when -gnatdF is used. * erroutc.adb (Output_Msg_Text): Likewise. --- gcc/ada/debug.adb | 2 +- gcc/ada/errout.adb | 43 ++++++++++++++++++++++++++++++------------- gcc/ada/erroutc.adb | 9 ++++++++- 3 files changed, 39 insertions(+), 15 deletions(-) diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 4eb3d5b5c16..f00f7471de1 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -69,7 +69,7 @@ package body Debug is -- dC Output debugging information on check suppression -- dD Delete elaboration checks in inner level routines -- dE Apply elaboration checks to predefined units - -- dF + -- dF Alternative display for messages over multiple lines -- dG Generate all warnings including those normally suppressed -- dH Hold (kill) call to gigi -- dI Inhibit internal name numbering in gnatG listing diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 1063d7d0548..36e8f6a9c32 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -2052,24 +2052,41 @@ package body Errout is E := First_Error_Msg; while E /= No_Error_Msg loop if not Errors.Table (E).Deleted and then not Debug_Flag_KK then - if Full_Path_Name_For_Brief_Errors then - Write_Name (Full_Ref_Name (Errors.Table (E).Sfile)); - else - Write_Name (Reference_Name (Errors.Table (E).Sfile)); + + -- If -gnatdF is used, separate main messages from previous + -- messages with a newline and make continuation messages + -- follow the main message with only an indentation of two + -- space characters, without repeating file:line:col: prefix. + + if Debug_Flag_FF then + if Errors.Table (E).Msg_Cont then + Write_Str (" "); + else + Write_Eol; + end if; end if; - Write_Char (':'); - Write_Int (Int (Physical_To_Logical - (Errors.Table (E).Line, - Errors.Table (E).Sfile))); - Write_Char (':'); + if not (Debug_Flag_FF and then Errors.Table (E).Msg_Cont) then + if Full_Path_Name_For_Brief_Errors then + Write_Name (Full_Ref_Name (Errors.Table (E).Sfile)); + else + Write_Name (Reference_Name (Errors.Table (E).Sfile)); + end if; + + Write_Char (':'); + Write_Int (Int (Physical_To_Logical + (Errors.Table (E).Line, + Errors.Table (E).Sfile))); + Write_Char (':'); + + if Errors.Table (E).Col < 10 then + Write_Char ('0'); + end if; - if Errors.Table (E).Col < 10 then - Write_Char ('0'); + Write_Int (Int (Errors.Table (E).Col)); + Write_Str (": "); end if; - Write_Int (Int (Errors.Table (E).Col)); - Write_Str (": "); Output_Msg_Text (E); Write_Eol; end if; diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index 0c5d98ce146..df174f6abe6 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -689,9 +689,16 @@ package body Erroutc is Txt := Text; end if; + -- If -gnatdF is used, continuation messages follow the main message + -- with only an indentation of two space characters, without repeating + -- any prefix. + + if Debug_Flag_FF and then E_Msg.Msg_Cont then + null; + -- For info messages, prefix message with "info: " - if E_Msg.Info then + elsif E_Msg.Info then Txt := new String'("info: " & Txt.all); -- Warning treated as error -- 2.30.2