From 715e529d70b264c2392fab72bb4b17ec18fb93fd Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 31 Oct 2014 12:43:09 +0100 Subject: [PATCH] [multiple changes] 2014-10-31 Ed Schonberg * sem_attr.adb (Analyze_Access_Attribute): Do not emit error message if reference does not come from source, as in the case for the controlling argument of a dispatching call. Error is diagnosed when call is resolved. * sem_ch4.adb (Complete_Object_Operation); Fix incorrect RM reference in error message. * sem_res.adb (Check_Prefixed_Call): ditto. 2014-10-31 Yannick Moy * sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings): Do not suppress checks when pragma Restrictions (No_Exception) is used in CodePeer or GNATprove mode. 2014-10-31 Yannick Moy * gnat1drv.adb (Adjust_Global_Switches): Explicitly mark language checks as not suppressed in GNATprove mode. 2014-10-31 Ed Schonberg * sem_elab.adb (Check_Elab_Call): Nothing to check if call is being pre-analyzed. * sem_ch3.adb (Complete_Private_Subtype): If all rep items of full view are those of the base, use rep_item chain of partial view, which may include aspects. * sem_cat.adb (Is_non_Remote_Access_Type): Use underlying type of base type, to handle properly declared subtypes. From-SVN: r216969 --- gcc/ada/ChangeLog | 31 +++++++++++++++++++++++++++++++ gcc/ada/gnat1drv.adb | 6 ++++++ gcc/ada/sem_attr.adb | 5 +++++ gcc/ada/sem_cat.adb | 6 ++++-- gcc/ada/sem_ch3.adb | 8 ++++++-- gcc/ada/sem_ch4.adb | 2 +- gcc/ada/sem_elab.adb | 6 ++++++ gcc/ada/sem_prag.adb | 10 +++++++++- gcc/ada/sem_res.adb | 2 +- 9 files changed, 69 insertions(+), 7 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index db5c68182f5..96f94e2f247 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,34 @@ +2014-10-31 Ed Schonberg + + * sem_attr.adb (Analyze_Access_Attribute): Do not emit error + message if reference does not come from source, as in the case + for the controlling argument of a dispatching call. Error is + diagnosed when call is resolved. + * sem_ch4.adb (Complete_Object_Operation); Fix incorrect RM + reference in error message. + * sem_res.adb (Check_Prefixed_Call): ditto. + +2014-10-31 Yannick Moy + + * sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings): Do not + suppress checks when pragma Restrictions (No_Exception) is used in + CodePeer or GNATprove mode. + +2014-10-31 Yannick Moy + + * gnat1drv.adb (Adjust_Global_Switches): Explicitly mark language + checks as not suppressed in GNATprove mode. + +2014-10-31 Ed Schonberg + + * sem_elab.adb (Check_Elab_Call): Nothing to check if call is + being pre-analyzed. + * sem_ch3.adb (Complete_Private_Subtype): If all rep items of full + view are those of the base, use rep_item chain of partial view, + which may include aspects. + * sem_cat.adb (Is_non_Remote_Access_Type): Use underlying type + of base type, to handle properly declared subtypes. + 2014-10-31 Ed Schonberg * sem_ch12.adb (Analyze_Generic_Package_Declaration): If there diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 7b8b5db2a70..0da8a51fe78 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -363,6 +363,12 @@ procedure Gnat1drv is -- happens anyway because this expansion is simply not done in the -- SPARK version of the expander. + -- On the contrary, we need to enable explicitly all language checks, + -- as they may have been marked as suppressed by the use of switch + -- -gnatp + + Suppress_Options.Suppress := (others => False); + -- Turn off dynamic elaboration checks: generates inconsistencies in -- trees between specs compiled as part of a main unit or as part of -- a with-clause. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 071399bbc14..ced9831a61f 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1041,12 +1041,17 @@ package body Sem_Attr is if not Is_Aliased_View (P) and then not In_Instance and then not In_Inlined_Body + and then Comes_From_Source (N) then -- Here we have a non-aliased view. This is illegal unless we -- have the case of Unrestricted_Access, where for now we allow -- this (we will reject later if expected type is access to an -- unconstrained array with a thin pointer). + -- No need for an error message on a generated access reference + -- for the controlling argument in a dispatching call: error will + -- be reported when resolving the call. + if Aname /= Name_Unrestricted_Access then Error_Attr_P ("prefix of % attribute must be aliased"); Check_No_Implicit_Aliasing (P); diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index 04638aaa8d0..06460fd5ecb 100644 --- a/gcc/ada/sem_cat.adb +++ b/gcc/ada/sem_cat.adb @@ -634,7 +634,9 @@ package body Sem_Cat is ------------------------------- function Is_Non_Remote_Access_Type (E : Entity_Id) return Boolean is - U_E : constant Entity_Id := Underlying_Type (E); + U_E : constant Entity_Id := Underlying_Type (Base_Type (E)); + -- Use full view of base type to handle subtypes properly. + begin if No (U_E) then @@ -1932,7 +1934,7 @@ package body Sem_Cat is Typ := First_Entity (Name_U); while Present (Typ) and then Typ /= First_Priv_Ent loop - U_Typ := Underlying_Type (Typ); + U_Typ := Underlying_Type (Base_Type (Typ)); if No (U_Typ) then U_Typ := Typ; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index c60f7c01281..9e79041a302 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -11555,9 +11555,13 @@ package body Sem_Ch3 is Item := First_Rep_Item (Full); -- If no existing rep items on full type, we can just link directly - -- to the list of items on the private type. + -- to the list of items on the private type. Same if the rep items + -- are only those inherited from the base - if No (Item) then + if No (Item) + or else Nkind (Item) /= N_Aspect_Specification + or else Entity (Item) = Full_Base + then Set_First_Rep_Item (Full, First_Rep_Item (Priv)); -- Otherwise, search to the end of items currently linked to the full diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 7df725d800f..6f58d001639 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -7585,7 +7585,7 @@ package body Sem_Ch4 is if not Is_Aliased_View (Obj) then Error_Msg_NE ("object in prefixed call to & must be aliased " - & "(RM-2005 4.3.1 (13))", Prefix (First_Actual), Subprog); + & "(RM 4.1.3 (13 1/2))", Prefix (First_Actual), Subprog); end if; Analyze (First_Actual); diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index e5e29bcce21..ad1b0493a96 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -1216,6 +1216,12 @@ package body Sem_Elab is and then No (Enclosing_Generic_Body (N)) then return; + + -- Nothing to do if call is being pre-analyzed, as when within a + -- pre/postcondition, a predicate, or an invariant. + + elsif In_Spec_Expression then + return; end if; -- Nothing to do if this is a call to a postcondition, which is always diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 0eddd64ee1a..3f0b9b83345 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -8952,7 +8952,15 @@ package body Sem_Prag is -- Atomic_Synchronization is not a real check, so it is not -- affected by this processing). - if R_Id = No_Exceptions and then not Warn then + -- Ignore the effect of pragma Restrictions (No_Exceptions) on + -- run-time checks in CodePeer and GNATprove modes: we want to + -- generate checks for analysis purposes, as set respectively + -- by -gnatC and -gnatd.F + + if not Warn + and then not (CodePeer_Mode or GNATprove_Mode) + and then R_Id = No_Exceptions + then for J in Scope_Suppress.Suppress'Range loop if J /= Atomic_Synchronization then Scope_Suppress.Suppress (J) := True; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 973c0d899a8..97f6ea12c38 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -3261,7 +3261,7 @@ package body Sem_Res is if not Is_Aliased_View (Act) then Error_Msg_NE ("object in prefixed call to& must be aliased " - & "(RM-2005 4.3.1 (13))", + & "(RM 4.1.3 (13 1/2))", Prefix (Act), Nam); end if; -- 2.30.2