diff options
Diffstat (limited to 'gcc/ada/sem_prag.adb')
| -rw-r--r-- | gcc/ada/sem_prag.adb | 47 |
1 files changed, 40 insertions, 7 deletions
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index bd75f02834f..2c99be19dd3 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -2781,6 +2781,16 @@ package body Sem_Prag is type Args_List is array (Natural range <>) of Node_Id; -- Types used for arguments to Check_Arg_Order and Gather_Associations + ----------------------- + -- Local Subprograms -- + ----------------------- + + 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 @@ -3341,8 +3351,33 @@ package body Sem_Prag is procedure Set_Ravenscar_Profile (N : Node_Id); -- Activate the set of configuration pragmas and restrictions that make -- up the Ravenscar Profile. N is the corresponding pragma node, which - -- is used for error messages on any constructs that violate the - -- profile. + -- is used for error messages on any constructs violating the profile. + + ---------------------------------- + -- 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 -- @@ -21209,8 +21244,7 @@ package body Sem_Prag is -- OK static string expression else - String_To_Name_Buffer - (Strval (Expr_Value_S (Get_Pragma_Arg (Arg1)))); + 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)); @@ -21364,7 +21398,7 @@ package body Sem_Prag is else Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off); - Check_At_Most_N_Arguments (2); + Check_Arg_Count (2); declare E_Id : Node_Id; @@ -21438,8 +21472,7 @@ package body Sem_Prag is -- Static string expression case else - String_To_Name_Buffer - (Strval (Expr_Value_S (Get_Pragma_Arg (Arg2)))); + Acquire_Warning_Match_String (Arg2); -- Note on configuration pragma case: If this is a -- configuration pragma, then for an OFF pragma, we |