From 6cd8f5b09415ec799f797e5b521afd18552cd747 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Tue, 20 Aug 2019 09:48:51 +0000 Subject: [PATCH] [Ada] Pragma Warning_As_Error works for style warnings Pragma Warning_As_Error now works for style warnings (messages that start with "(style)", enabled by -gnaty) the same way it works for regular warnings enabled by -gnatw. The following test should fail to build with style checks: gnat.adc: pragma Warning_As_Error ("two spaces required"); style.adb: procedure Style is X : Integer; begin null; --Hello end; gnatmake -q -f -g style.adb -gnaty should get: style.adb:2:04: warning: variable "X" is never read and never assigned style.adb:5:06: error: (style) two spaces required [warning-as-error] style.adb:6:01: (style) "end Style" required gnatmake: "style.adb" compilation error and no executable should be created. 2019-08-20 Bob Duff gcc/ada/ * errout.adb (Error_Msg_Internal): Set Warn_Err in case of Is_Style_Msg. * erroutc.adb (Output_Msg_Text): Do Warnings_Treated_As_Errors processing and [warning-as-error] modification for style messages. Clean up code, simplify, remove unnecessary block statement, add renaming of table entry. * erroutc.ads (Warning_Treated_As_Error): Fix comment: no such thing as Set_Warning_As_Error. * opt.ads: Clean up comments and move related declarations near each other. * par-prag.adb: Process Warning_As_Error. This is necessary because many style warning happen during parsing. * sem_prag.adb: Use new Acquire_Warning_Match_String. * sem_util.ads, sem_util.adb (Acquire_Warning_Match_String): New function shared by par-prag.adb and sem_prag.adb. Replaces the procedure in sem_prag.adb. Avoid use of global variables. * stringt.ads, stringt.adb (To_String): New function to convert String_Id to String. * doc/gnat_rm/implementation_defined_pragmas.rst: Document the new feature. * gnat_rm.texi: Regenerate. From-SVN: r274721 --- gcc/ada/ChangeLog | 24 +++ .../implementation_defined_pragmas.rst | 25 ++- gcc/ada/errout.adb | 2 +- gcc/ada/erroutc.adb | 200 +++++++++--------- gcc/ada/erroutc.ads | 2 +- gcc/ada/gnat_rm.texi | 25 ++- gcc/ada/opt.ads | 28 +-- gcc/ada/par-prag.adb | 16 +- gcc/ada/sem_prag.adb | 73 ++----- gcc/ada/sem_util.adb | 33 +++ gcc/ada/sem_util.ads | 6 + gcc/ada/stringt.adb | 11 + gcc/ada/stringt.ads | 3 + 13 files changed, 253 insertions(+), 195 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a91b8f51ddc..558d5e072d2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2019-08-20 Bob Duff + + * errout.adb (Error_Msg_Internal): Set Warn_Err in case of + Is_Style_Msg. + * erroutc.adb (Output_Msg_Text): Do Warnings_Treated_As_Errors + processing and [warning-as-error] modification for style + messages. Clean up code, simplify, remove unnecessary block + statement, add renaming of table entry. + * erroutc.ads (Warning_Treated_As_Error): Fix comment: no such + thing as Set_Warning_As_Error. + * opt.ads: Clean up comments and move related declarations near + each other. + * par-prag.adb: Process Warning_As_Error. This is necessary + because many style warning happen during parsing. + * sem_prag.adb: Use new Acquire_Warning_Match_String. + * sem_util.ads, sem_util.adb (Acquire_Warning_Match_String): New + function shared by par-prag.adb and sem_prag.adb. Replaces the + procedure in sem_prag.adb. Avoid use of global variables. + * stringt.ads, stringt.adb (To_String): New function to convert + String_Id to String. + * doc/gnat_rm/implementation_defined_pragmas.rst: Document the + new feature. + * gnat_rm.texi: Regenerate. + 2019-08-20 Eric Botcazou * lib.ads: Add with clause for GNAT.HTable. diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index baa13fce0dd..a6b7e1319c0 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -7467,18 +7467,21 @@ Syntax: This configuration pragma allows the programmer to specify a set -of warnings that will be treated as errors. Any warning which +of warnings that will be treated as errors. Any warning that matches the pattern given by the pragma argument will be treated -as an error. This gives much more precise control that -gnatwe -which treats all warnings as errors. - -The pattern may contain asterisks, which match zero or more characters in -the message. For example, you can use -``pragma Warning_As_Error ("bits of*unused")`` to treat the warning -message ``warning: 960 bits of "a" unused`` as an error. No other regular -expression notations are permitted. All characters other than asterisk in -these three specific cases are treated as literal characters in the match. -The match is case insensitive, for example XYZ matches xyz. +as an error. This gives more precise control than -gnatwe, +which treats warnings as errors. + +This pragma can apply to regular warnings (messages enabled by -gnatw) +and to style warnings (messages that start with "(style)", +enabled by -gnaty). + +The pattern may contain asterisks, which match zero or more characters +in the message. For example, you can use ``pragma Warning_As_Error +("bits of*unused")`` to treat the warning message ``warning: 960 bits of +"a" unused`` as an error. All characters other than asterisk are treated +as literal characters in the match. The match is case insensitive; for +example XYZ matches xyz. Note that the pattern matches if it occurs anywhere within the warning message string (it is not necessary to put an asterisk at the start and diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index f5a4925eabc..42c7cb90477 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -1100,7 +1100,7 @@ package body Errout is -- Test if warning to be treated as error Warn_Err := - Is_Warning_Msg + (Is_Warning_Msg or Is_Style_Msg) and then (Warning_Treated_As_Error (Msg_Buffer (1 .. Msglen)) or else Warning_Treated_As_Error (Get_Warning_Tag (Cur_Msg))); diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index 81e29107cfe..3bab3522096 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -624,155 +624,145 @@ package body Erroutc is Length : Nat; -- Maximum total length of lines - Text : constant String_Ptr := Errors.Table (E).Text; + E_Msg : Error_Msg_Object renames Errors.Table (E); + Text : constant String_Ptr := E_Msg.Text; Ptr : Natural; Split : Natural; Start : Natural; + Tag : constant String := Get_Warning_Tag (E); + Txt : String_Ptr; + Len : Natural; begin - declare - Tag : constant String := Get_Warning_Tag (E); - Txt : String_Ptr; - Len : Natural; + -- Postfix warning tag to message if needed - begin - -- Postfix warning tag to message if needed - - if Tag /= "" and then Warning_Doc_Switch then - if Include_Subprogram_In_Messages then - Txt := - new String' - (Subprogram_Name_Ptr (Errors.Table (E).Node) & - ": " & Text.all & ' ' & Tag); - else - Txt := new String'(Text.all & ' ' & Tag); - end if; - - elsif Include_Subprogram_In_Messages - and then (Errors.Table (E).Warn or else Errors.Table (E).Style) - then + if Tag /= "" and then Warning_Doc_Switch then + if Include_Subprogram_In_Messages then Txt := new String' - (Subprogram_Name_Ptr (Errors.Table (E).Node) & - ": " & Text.all); + (Subprogram_Name_Ptr (E_Msg.Node) & + ": " & Text.all & ' ' & Tag); else - Txt := Text; + Txt := new String'(Text.all & ' ' & Tag); end if; - -- Deal with warning case - - if Errors.Table (E).Warn or else Errors.Table (E).Info then + elsif Include_Subprogram_In_Messages + and then (E_Msg.Warn or else E_Msg.Style) + then + Txt := + new String'(Subprogram_Name_Ptr (E_Msg.Node) & ": " & Text.all); + else + Txt := Text; + end if; - -- For info messages, prefix message with "info: " + -- For info messages, prefix message with "info: " - if Errors.Table (E).Info then - Txt := new String'("info: " & Txt.all); + if E_Msg.Info then + Txt := new String'("info: " & Txt.all); - -- Warning treated as error + -- Warning treated as error - elsif Errors.Table (E).Warn_Err then + elsif E_Msg.Warn_Err then - -- We prefix with "error:" rather than warning: and postfix - -- [warning-as-error] at the end. + -- We prefix with "error:" rather than warning: and postfix + -- [warning-as-error] at the end. - Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1; - Txt := new String'("error: " & Txt.all & " [warning-as-error]"); + Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1; + Txt := new String'("error: " & Txt.all & " [warning-as-error]"); - -- Normal case, prefix with "warning: " + -- Normal warning, prefix with "warning: " - else - Txt := new String'("warning: " & Txt.all); - end if; + elsif E_Msg.Warn then + Txt := new String'("warning: " & Txt.all); - -- No prefix needed for style message, "(style)" is there already + -- No prefix needed for style message, "(style)" is there already - elsif Errors.Table (E).Style then - null; + elsif E_Msg.Style then + null; - -- No prefix needed for check message, severity is there already + -- No prefix needed for check message, severity is there already - elsif Errors.Table (E).Check then - null; + elsif E_Msg.Check then + null; - -- All other cases, add "error: " if unique error tag set + -- All other cases, add "error: " if unique error tag set - elsif Opt.Unique_Error_Tag then - Txt := new String'("error: " & Txt.all); - end if; + elsif Opt.Unique_Error_Tag then + Txt := new String'("error: " & Txt.all); + end if; - -- Set error message line length and length of message + -- Set error message line length and length of message - if Error_Msg_Line_Length = 0 then - Length := Nat'Last; - else - Length := Error_Msg_Line_Length; - end if; + if Error_Msg_Line_Length = 0 then + Length := Nat'Last; + else + Length := Error_Msg_Line_Length; + end if; - Max := Integer (Length - Column + 1); - Len := Txt'Length; + Max := Integer (Length - Column + 1); + Len := Txt'Length; - -- Here we have to split the message up into multiple lines + -- Here we have to split the message up into multiple lines - Ptr := 1; - loop - -- Make sure we do not have ludicrously small line + Ptr := 1; + loop + -- Make sure we do not have ludicrously small line - Max := Integer'Max (Max, 20); + Max := Integer'Max (Max, 20); - -- If remaining text fits, output it respecting LF and we are done + -- If remaining text fits, output it respecting LF and we are done - if Len - Ptr < Max then - for J in Ptr .. Len loop - if Txt (J) = ASCII.LF then - Write_Eol; - Write_Spaces (Offs); - else - Write_Char (Txt (J)); - end if; - end loop; + if Len - Ptr < Max then + for J in Ptr .. Len loop + if Txt (J) = ASCII.LF then + Write_Eol; + Write_Spaces (Offs); + else + Write_Char (Txt (J)); + end if; + end loop; - return; + return; - -- Line does not fit + -- Line does not fit - else - Start := Ptr; + else + Start := Ptr; - -- First scan forward looking for a hard end of line + -- First scan forward looking for a hard end of line - for Scan in Ptr .. Ptr + Max - 1 loop - if Txt (Scan) = ASCII.LF then - Split := Scan - 1; - Ptr := Scan + 1; - goto Continue; - end if; - end loop; + for Scan in Ptr .. Ptr + Max - 1 loop + if Txt (Scan) = ASCII.LF then + Split := Scan - 1; + Ptr := Scan + 1; + goto Continue; + end if; + end loop; - -- Otherwise scan backwards looking for a space + -- Otherwise scan backwards looking for a space - for Scan in reverse Ptr .. Ptr + Max - 1 loop - if Txt (Scan) = ' ' then - Split := Scan - 1; - Ptr := Scan + 1; - goto Continue; - end if; - end loop; + for Scan in reverse Ptr .. Ptr + Max - 1 loop + if Txt (Scan) = ' ' then + Split := Scan - 1; + Ptr := Scan + 1; + goto Continue; + end if; + end loop; - -- If we fall through, no space, so split line arbitrarily + -- If we fall through, no space, so split line arbitrarily - Split := Ptr + Max - 1; - Ptr := Split + 1; - end if; + Split := Ptr + Max - 1; + Ptr := Split + 1; + end if; - <> - if Start <= Split then - Write_Line (Txt (Start .. Split)); - Write_Spaces (Offs); - end if; + <> + if Start <= Split then + Write_Line (Txt (Start .. Split)); + Write_Spaces (Offs); + end if; - Max := Integer (Length - Column + 1); - end loop; - end; + Max := Integer (Length - Column + 1); + end loop; end Output_Msg_Text; --------------------- diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads index ff73fc46922..3b34753a41d 100644 --- a/gcc/ada/erroutc.ads +++ b/gcc/ada/erroutc.ads @@ -612,7 +612,7 @@ package Erroutc is function Warning_Treated_As_Error (Msg : String) return Boolean; -- Returns True if the warning message Msg matches any of the strings -- given by Warning_As_Error pragmas, as stored in the Warnings_As_Errors - -- table by Set_Warning_As_Error. + -- table. type Error_Msg_Proc is access procedure (Msg : String; Flag_Location : Source_Ptr); diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 3c561ed1b04..72eb22ca77d 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -8971,18 +8971,21 @@ pragma Warning_As_Error (static_string_EXPRESSION); @end example This configuration pragma allows the programmer to specify a set -of warnings that will be treated as errors. Any warning which +of warnings that will be treated as errors. Any warning that matches the pattern given by the pragma argument will be treated -as an error. This gives much more precise control that -gnatwe -which treats all warnings as errors. - -The pattern may contain asterisks, which match zero or more characters in -the message. For example, you can use -@code{pragma Warning_As_Error ("bits of*unused")} to treat the warning -message @code{warning: 960 bits of "a" unused} as an error. No other regular -expression notations are permitted. All characters other than asterisk in -these three specific cases are treated as literal characters in the match. -The match is case insensitive, for example XYZ matches xyz. +as an error. This gives more precise control than -gnatwe, +which treats warnings as errors. + +This pragma can apply to regular warnings (messages enabled by -gnatw) +and to style warnings (messages that start with "(style)", +enabled by -gnaty). + +The pattern may contain asterisks, which match zero or more characters +in the message. For example, you can use @code{pragma Warning_As_Error +("bits of*unused")} to treat the warning message @code{warning: 960 bits of +"a" unused} as an error. All characters other than asterisk are treated +as literal characters in the match. The match is case insensitive; for +example XYZ matches xyz. Note that the pattern matches if it occurs anywhere within the warning message string (it is not necessary to put an asterisk at the start and diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 3158899a4b7..d3cba61762f 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1944,10 +1944,6 @@ package Opt is -- which requires pragma Warnings to be stored for the formal verification -- backend. - Warnings_As_Errors_Count : Natural; - -- GNAT - -- Number of entries stored in Warnings_As_Errors table - Wide_Character_Encoding_Method : WC_Encoding_Method := WCEM_Brackets; -- GNAT, GNATBIND -- Method used for encoding wide characters in the source program. See @@ -2158,10 +2154,6 @@ package Opt is -- is ignored for internal and predefined units (which are always compiled -- with the standard Size semantics). - Warnings_As_Errors_Count_Config : Natural; - -- GNAT - -- Count of pattern strings stored from Warning_As_Error pragmas - type Config_Switches_Type is private; -- Type used to save values of the switches set from Config values @@ -2268,16 +2260,24 @@ package Opt is --------------------------- -- The following array would more reasonably be located in Err_Vars or - -- Errour, but we put them here to deal with licensing issues (we need + -- Errout, but we put them here to deal with licensing issues (we need -- this to have the GPL exception licensing, since these variables and -- subprograms are accessed from units with this licensing). Warnings_As_Errors : array (1 .. 10_000) of String_Ptr; - -- Table for recording Warning_As_Error pragmas as they are processed. - -- It would be nicer to use Table, but there are circular elaboration - -- problems if we try to do this, and an attempt to find some other - -- appropriately licensed unit to declare this as a Table failed with - -- various elaboration circularities. Memory is getting cheap these days! + -- Table for recording Warning_As_Error pragmas as they are processed. It + -- would be nicer to use Table, but there are circular elaboration problems + -- if we try to do this, and an attempt to find some other appropriately + -- licensed unit to declare this as a Table failed with various elaboration + -- circularities. + + Warnings_As_Errors_Count : Natural; + -- GNAT + -- Number of entries stored in Warnings_As_Errors table + + Warnings_As_Errors_Count_Config : Natural; + -- GNAT + -- Count of pattern strings stored from Warning_As_Error pragmas --------------- -- GNAT_Mode -- diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index bed22e198e2..87f97ea9439 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1088,6 +1088,21 @@ begin when Pragma_Suppress_All => Set_Has_Pragma_Suppress_All (Cunit (Current_Source_Unit)); + ---------------------- + -- Warning_As_Error -- + ---------------------- + + -- pragma Warning_As_Error (static_string_EXPRESSION); + + -- Further processing is done in Sem_Prag + + when Pragma_Warning_As_Error => + Check_Arg_Count (1); + Check_Arg_Is_String_Literal (Arg1); + Warnings_As_Errors_Count := Warnings_As_Errors_Count + 1; + Warnings_As_Errors (Warnings_As_Errors_Count) := + new String'(Acquire_Warning_Match_String (Get_Pragma_Arg (Arg1))); + --------------------- -- Warnings (GNAT) -- --------------------- @@ -1519,7 +1534,6 @@ begin | Pragma_Volatile_Components | Pragma_Volatile_Full_Access | Pragma_Volatile_Function - | Pragma_Warning_As_Error | Pragma_Weak_External | Pragma_Validity_Checks => diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 993a419df09..0e68bb13274 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -3768,12 +3768,6 @@ package body Sem_Prag is function Acc_Next (N : Node_Id) return Node_Id; -- Helper function to iterate over arguments given to OpenAcc pragmas - procedure Acquire_Warning_Match_String (Arg : Node_Id); - -- Used by pragma Warnings (Off, string), and Warn_As_Error (string) to - -- get the given string argument, and place it in Name_Buffer, adding - -- leading and trailing asterisks if they are not already present. The - -- caller has already checked that Arg is a static string expression. - procedure Ada_2005_Pragma; -- Called for pragmas defined in Ada 2005, that are not in Ada 95. In -- Ada 95 mode, these are implementation defined pragmas, so should be @@ -4400,32 +4394,6 @@ package body Sem_Prag is end if; end Acc_Next; - ---------------------------------- - -- Acquire_Warning_Match_String -- - ---------------------------------- - - procedure Acquire_Warning_Match_String (Arg : Node_Id) is - begin - String_To_Name_Buffer - (Strval (Expr_Value_S (Get_Pragma_Arg (Arg)))); - - -- Add asterisk at start if not already there - - if Name_Len > 0 and then Name_Buffer (1) /= '*' then - Name_Buffer (2 .. Name_Len + 1) := - Name_Buffer (1 .. Name_Len); - Name_Buffer (1) := '*'; - Name_Len := Name_Len + 1; - end if; - - -- Add asterisk at end if not already there - - if Name_Buffer (Name_Len) /= '*' then - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := '*'; - end if; - end Acquire_Warning_Match_String; - --------------------- -- Ada_2005_Pragma -- --------------------- @@ -25301,10 +25269,10 @@ package body Sem_Prag is -- OK static string expression else - Acquire_Warning_Match_String (Arg1); Warnings_As_Errors_Count := Warnings_As_Errors_Count + 1; Warnings_As_Errors (Warnings_As_Errors_Count) := - new String'(Name_Buffer (1 .. Name_Len)); + new String'(Acquire_Warning_Match_String + (Expr_Value_S (Get_Pragma_Arg (Arg1)))); end if; -------------- @@ -25609,8 +25577,6 @@ package body Sem_Prag is -- Static string expression case else - Acquire_Warning_Match_String (Arg2); - -- Note on configuration pragma case: If this is a -- configuration pragma, then for an OFF pragma, we -- just set Config True in the call, which is all @@ -25630,22 +25596,27 @@ package body Sem_Prag is -- generic unit we are inside is public, but for now -- we don't bother with that refinement. - if Chars (Argx) = Name_Off then - Set_Specific_Warning_Off - (Loc, Name_Buffer (1 .. Name_Len), Reason, - Config => Is_Configuration_Pragma, - Used => Inside_A_Generic or else In_Instance); - - elsif Chars (Argx) = Name_On then - Set_Specific_Warning_On - (Loc, Name_Buffer (1 .. Name_Len), Err); - - if Err then - Error_Msg - ("??pragma Warnings On with no matching " - & "Warnings Off", Loc); + declare + Message : constant String := + Acquire_Warning_Match_String + (Expr_Value_S (Get_Pragma_Arg (Arg2))); + begin + if Chars (Argx) = Name_Off then + Set_Specific_Warning_Off + (Loc, Message, Reason, + Config => Is_Configuration_Pragma, + Used => Inside_A_Generic or else In_Instance); + + elsif Chars (Argx) = Name_On then + Set_Specific_Warning_On (Loc, Message, Err); + + if Err then + Error_Msg + ("??pragma Warnings On with no matching " + & "Warnings Off", Loc); + end if; end if; - end if; + end; end if; end; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index dcef852d975..dcc8d64485c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -247,6 +247,39 @@ package body Sem_Util is return Interface_List (Nod); end Abstract_Interface_List; + ---------------------------------- + -- Acquire_Warning_Match_String -- + ---------------------------------- + + function Acquire_Warning_Match_String (Str_Lit : Node_Id) return String is + S : constant String := To_String (Strval (Str_Lit)); + begin + if S = "" then + return ""; + else + -- Put "*" before or after or both, if it's not already there + + declare + F : constant Boolean := S (S'First) = '*'; + L : constant Boolean := S (S'Last) = '*'; + begin + if F then + if L then + return S; + else + return S & "*"; + end if; + else + if L then + return "*" & S; + else + return "*" & S & "*"; + end if; + end if; + end; + end if; + end Acquire_Warning_Match_String; + -------------------------------- -- Add_Access_Type_To_Process -- -------------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 4d738da1de6..c9065e54eea 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -42,6 +42,12 @@ package Sem_Util is -- including the cases where there can't be any because e.g. the type is -- not tagged. + function Acquire_Warning_Match_String (Str_Lit : Node_Id) return String; + -- Used by pragma Warnings (Off, string), and Warn_As_Error (string) to get + -- the given string argument, adding leading and trailing asterisks if they + -- are not already present. Str_Lit is the static value of the pragma + -- argument. + procedure Add_Access_Type_To_Process (E : Entity_Id; A : Entity_Id); -- Add A to the list of access types to process when expanding the -- freeze node of E. diff --git a/gcc/ada/stringt.adb b/gcc/ada/stringt.adb index bacb5064f87..545705ad511 100644 --- a/gcc/ada/stringt.adb +++ b/gcc/ada/stringt.adb @@ -349,6 +349,17 @@ package body Stringt is return Strings.Table (First_String_Id)'Address; end Strings_Address; + --------------- + -- To_String -- + --------------- + + function To_String (S : String_Id) return String is + Buf : Bounded_String; + begin + Append (Buf, S); + return To_String (Buf); + end To_String; + --------------- -- Tree_Read -- --------------- diff --git a/gcc/ada/stringt.ads b/gcc/ada/stringt.ads index 6d887ea1d78..722d17f7bc2 100644 --- a/gcc/ada/stringt.ads +++ b/gcc/ada/stringt.ads @@ -127,6 +127,9 @@ package Stringt is -- out of Character range. Does not attempt to do any encoding of -- characters. + function To_String (S : String_Id) return String; + -- Return S as a String + procedure String_To_Name_Buffer (S : String_Id); -- Place characters of given string in Name_Buffer, setting Name_Len. -- Error if any characters are out of Character range. Does not attempt -- 2.30.2