From 26f36fc9f65e8bcc265d62996d65616e437fb3fa Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 4 Mar 2015 10:58:41 +0100 Subject: [PATCH] [multiple changes] 2015-03-04 Ed Schonberg * sem_warn.adb (Check_References): When checking for an unused in-out parameter of a class- wide type, use its type to determine whether it is private, in order to avoid a spurious warning when subprogram spec and body are in different units. 2015-03-04 Yannick Moy * sem_attr.adb: Improve warning messages. From-SVN: r221178 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/sem_attr.adb | 40 ++++++++++++++++++++++++++-------------- gcc/ada/sem_warn.adb | 7 +++++++ 3 files changed, 44 insertions(+), 14 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4ac44b3ca31..065a991727a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2015-03-04 Ed Schonberg + + * sem_warn.adb (Check_References): When checking for an unused + in-out parameter of a class- wide type, use its type to determine + whether it is private, in order to avoid a spurious warning when + subprogram spec and body are in different units. + +2015-03-04 Yannick Moy + + * sem_attr.adb: Improve warning messages. + 2015-03-04 Robert Dewar * exp_ch6.adb (Expand_N_Subprogram_Body): Avoid trying to unnest diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 21040ab97e8..01b0cd8e885 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1103,6 +1103,10 @@ package body Sem_Attr is -- Subsidiary to Check_Placemenet_In_XXX. Determine whether arbitrary -- node Nod is within enclosing node Encl_Nod. + procedure Placement_Error; + -- Emit a general error when the attributes does not appear in a + -- postcondition-like aspect or pragma. + ------------------------------ -- Check_Placement_In_Check -- ------------------------------ @@ -1124,17 +1128,7 @@ package body Sem_Attr is -- Otherwise the placement of the attribute is illegal else - if Aname = Name_Old then - Error_Attr - ("attribute % can only appear in postcondition", P); - - -- Specialize the error message for attribute 'Result - - else - Error_Attr - ("attribute % can only appear in postcondition of " - & "function", P); - end if; + Placement_Error; end if; end Check_Placement_In_Check; @@ -1236,6 +1230,24 @@ package body Sem_Attr is return False; end Is_Within; + --------------------- + -- Placement_Error -- + --------------------- + + procedure Placement_Error is + begin + if Aname = Name_Old then + Error_Attr ("attribute % can only appear in postcondition", P); + + -- Specialize the error message for attribute 'Result + + else + Error_Attr + ("attribute % can only appear in postcondition of function", + P); + end if; + end Placement_Error; + -- Local variables Prag : Node_Id; @@ -1294,14 +1306,14 @@ package body Sem_Attr is Check_Placement_In_Test_Case (Prag); else - Error_Attr ("attribute % can only appear in postcondition", P); + Placement_Error; return; end if; -- Otherwise the placement of the attribute is illegal else - Error_Attr ("attribute % can only appear in postcondition", P); + Placement_Error; return; end if; @@ -4797,7 +4809,7 @@ package body Sem_Attr is if Is_Constant_Object (Pref_Id) then Error_Msg_Name_1 := Name_Old; Error_Msg_N - ("??atribute % applied to constant has no effect", P); + ("??attribute % applied to constant has no effect", P); end if; -- Otherwise the prefix is not a simple name diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index b0e80116225..f3768621399 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1080,6 +1080,13 @@ package body Sem_Warn is (Ekind_In (E1, E_Out_Parameter, E_In_Out_Parameter) and then not Is_Protected_Type (Current_Scope)) then + -- If the formal has a class-wide type, retrieve its type + -- because checks below depend on its private nature. + + if Is_Class_Wide_Type (E1T) then + E1T := Etype (E1T); + end if; + -- Case of an unassigned variable -- First gather any Unset_Reference indication for E1. In the -- 2.30.2