diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/ada/errout.adb | 47 | ||||
| -rw-r--r-- | gcc/ada/errout.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/erroutc.adb | 25 | ||||
| -rw-r--r-- | gcc/ada/erroutc.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 18 |
6 files changed, 72 insertions, 38 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c9169fa..1f574e2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2011-11-23 Robert Dewar <dewar@adacore.com> + + * errout.adb: Minor reformattin (Finalize): Take templates into + account for warning suppression. + * errout.ads (Set_Specific_Warning_Off): Add Used parameter. + * erroutc.adb: Minor reformatting (Finalize): Take generic + templates into account for warning suppress. + * erroutc.ads (Set_Specific_Warning_Off): Add Used parameter. + * sem_prag.adb: Minor reformatting (Analyze_Pragma, + case Warnings): Provide Used parameter in call to + Set_Specific_Warnings_Off (to deal with generic template case). + 2011-11-23 Pascal Obry <obry@adacore.com> * sem_prag.adb (Process_Convention): Better error message for diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 5993132..c40179a 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -1286,30 +1286,37 @@ package body Errout is Cur := First_Error_Msg; while Cur /= No_Error_Msg loop - if not Errors.Table (Cur).Deleted - and then Warning_Specifically_Suppressed - (Errors.Table (Cur).Sptr, Errors.Table (Cur).Text) - then - Delete_Warning (Cur); + declare + CE : Error_Msg_Object renames Errors.Table (Cur); - -- If this is a continuation, delete previous messages + begin + if not CE.Deleted + and then + (Warning_Specifically_Suppressed (CE.Sptr, CE.Text) + or else + Warning_Specifically_Suppressed (CE.Optr, CE.Text)) + then + Delete_Warning (Cur); - F := Cur; - while Errors.Table (F).Msg_Cont loop - F := Errors.Table (F).Prev; - Delete_Warning (F); - end loop; + -- If this is a continuation, delete previous messages - -- Delete any following continuations + F := Cur; + while Errors.Table (F).Msg_Cont loop + F := Errors.Table (F).Prev; + Delete_Warning (F); + end loop; - F := Cur; - loop - F := Errors.Table (F).Next; - exit when F = No_Error_Msg; - exit when not Errors.Table (F).Msg_Cont; - Delete_Warning (F); - end loop; - end if; + -- Delete any following continuations + + F := Cur; + loop + F := Errors.Table (F).Next; + exit when F = No_Error_Msg; + exit when not Errors.Table (F).Msg_Cont; + Delete_Warning (F); + end loop; + end if; + end; Cur := Errors.Table (Cur).Next; end loop; diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 5c1c92c..ea83a8a 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -771,7 +771,8 @@ package Errout is procedure Set_Specific_Warning_Off (Loc : Source_Ptr; Msg : String; - Config : Boolean) + Config : Boolean; + Used : Boolean := False) renames Erroutc.Set_Specific_Warning_Off; -- This is called in response to the two argument form of pragma Warnings -- where the first argument is OFF, and the second argument is the prefix diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index 6492380..f58a49a 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -1081,7 +1081,8 @@ package body Erroutc is procedure Set_Specific_Warning_Off (Loc : Source_Ptr; Msg : String; - Config : Boolean) + Config : Boolean; + Used : Boolean := False) is begin Specific_Warnings.Append @@ -1089,7 +1090,7 @@ package body Erroutc is Msg => new String'(Msg), Stop => Source_Last (Current_Source_File), Open => True, - Used => False, + Used => Used, Config => Config)); end Set_Specific_Warning_Off; @@ -1135,16 +1136,16 @@ package body Erroutc is procedure Set_Warnings_Mode_Off (Loc : Source_Ptr) is begin - -- Don't bother with entries from instantiation copies, since we - -- will already have a copy in the template, which is what matters + -- Don't bother with entries from instantiation copies, since we will + -- already have a copy in the template, which is what matters. if Instantiation (Get_Source_File_Index (Loc)) /= No_Location then return; end if; - -- If last entry in table already covers us, this is a redundant - -- pragma Warnings (Off) and can be ignored. This also handles the - -- case where all warnings are suppressed by command line switch. + -- If last entry in table already covers us, this is a redundant pragma + -- Warnings (Off) and can be ignored. This also handles the case where + -- all warnings are suppressed by command line switch. if Warnings.Last >= Warnings.First and then Warnings.Table (Warnings.Last).Start <= Loc @@ -1152,9 +1153,9 @@ package body Erroutc is then return; - -- Otherwise establish a new entry, extending from the location of - -- the pragma to the end of the current source file. This ending - -- point will be adjusted by a subsequent pragma Warnings (On). + -- Otherwise establish a new entry, extending from the location of the + -- pragma to the end of the current source file. This ending point will + -- be adjusted by a subsequent pragma Warnings (On). else Warnings.Increment_Last; @@ -1170,8 +1171,8 @@ package body Erroutc is procedure Set_Warnings_Mode_On (Loc : Source_Ptr) is begin - -- Don't bother with entries from instantiation copies, since we - -- will already have a copy in the template, which is what matters + -- Don't bother with entries from instantiation copies, since we will + -- already have a copy in the template, which is what matters. if Instantiation (Get_Source_File_Index (Loc)) /= No_Location then return; diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads index a2ac463..6c077b0 100644 --- a/gcc/ada/erroutc.ads +++ b/gcc/ada/erroutc.ads @@ -445,7 +445,8 @@ package Erroutc is procedure Set_Specific_Warning_Off (Loc : Source_Ptr; Msg : String; - Config : Boolean); + Config : Boolean; + Used : Boolean := False); -- This is called in response to the two argument form of pragma Warnings -- where the first argument is OFF, and the second argument is a string -- which identifies a specific warning to be suppressed. The first argument @@ -453,6 +454,8 @@ package Erroutc is -- string from the pragma. Loc is the location of the pragma (which is the -- start of the range to suppress). Config is True for the configuration -- pragma case (where there is no requirement for a matching OFF pragma). + -- Used is set True to disable the check that the warning actually has + -- has the effect of suppressing a warning. procedure Set_Specific_Warning_On (Loc : Source_Ptr; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index c63e9da..a21358b 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14528,7 +14528,7 @@ package body Sem_Prag is end; end if; - -- Two or more arguments (must be two) + -- Two or more arguments (must be two) else Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off); @@ -14547,8 +14547,7 @@ package body Sem_Prag is -- the formal may be wrapped in a conversion if the -- actual is a conversion. Retrieve the real entity name. - if (In_Instance_Body - or else In_Inlined_Body) + if (In_Instance_Body or else In_Inlined_Body) and then Nkind (E_Id) = N_Unchecked_Type_Conversion then E_Id := Expression (E_Id); @@ -14612,10 +14611,21 @@ package body Sem_Prag is -- In any other case, an error will be signalled (ON -- with no matching OFF). + -- Note: We set Used if we are inside a generic to + -- disable the test that the non-config case actually + -- cancels a warning. That's because we can't be sure + -- there isn't an instantiation in some other unit + -- where a warning is suppressed. + + -- We could do a little better here by checking if the + -- 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), - Config => Is_Configuration_Pragma); + Config => Is_Configuration_Pragma, + Used => Inside_A_Generic or else In_Instance); elsif Chars (Argx) = Name_On then Set_Specific_Warning_On |