From 18dae8141c435922e4571e399c99bda2af1f93b3 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Wed, 7 Jan 2015 08:49:42 +0000 Subject: [PATCH] prj.ads, [...]: Minor reformatting. 2015-01-07 Robert Dewar * prj.ads, i-cpoint.adb, freeze.adb, ghost.adb, prj-err.adb: Minor reformatting. 2015-01-07 Robert Dewar * restrict.adb (Check_Restriction_No_Use_Of_Attribute): New procedure. (OK_No_Use_Of_Entity_Name): New function. (Set_Restriction_No_Use_Of_Entity): New procedure. * restrict.ads (Check_Restriction_No_Use_Of_Attribute): New procedure. (OK_No_Use_Of_Entity_Name): New function. (Set_Restriction_No_Use_Of_Entity): New procedure. * sem_ch8.adb (Find_Direct_Name): Add check for violation of No_Use_Of_Entity. * sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings): Add processing for new restriction No_Use_Of_Entity. From-SVN: r219282 --- gcc/ada/ChangeLog | 20 +++++ gcc/ada/freeze.adb | 13 ++- gcc/ada/ghost.adb | 12 +-- gcc/ada/i-cpoint.adb | 8 +- gcc/ada/prj-err.adb | 2 + gcc/ada/prj.ads | 2 +- gcc/ada/restrict.adb | 189 +++++++++++++++++++++++++++++++++++++++++++ gcc/ada/restrict.ads | 42 +++++++--- gcc/ada/sem_ch8.adb | 16 ++-- gcc/ada/sem_prag.adb | 24 ++++-- 10 files changed, 288 insertions(+), 40 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bceb082d1fa..25920e38cd1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2015-01-07 Robert Dewar + + * prj.ads, i-cpoint.adb, freeze.adb, ghost.adb, prj-err.adb: Minor + reformatting. + +2015-01-07 Robert Dewar + + * restrict.adb (Check_Restriction_No_Use_Of_Attribute): + New procedure. + (OK_No_Use_Of_Entity_Name): New function. + (Set_Restriction_No_Use_Of_Entity): New procedure. + * restrict.ads (Check_Restriction_No_Use_Of_Attribute): + New procedure. + (OK_No_Use_Of_Entity_Name): New function. + (Set_Restriction_No_Use_Of_Entity): New procedure. + * sem_ch8.adb (Find_Direct_Name): Add check for violation of + No_Use_Of_Entity. + * sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings): + Add processing for new restriction No_Use_Of_Entity. + 2015-01-07 Eric Botcazou * freeze.adb (Freeze_Array_Type): Apply same handling to Is_Atomic diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index a8acdc33c60..ab128f242b7 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -2435,8 +2435,8 @@ package body Freeze is -- packing or explicit component size clause given. if (Has_Aliased_Components (Arr) - or else - Has_Atomic_Components (Arr) or else Is_Atomic (Ctyp)) + or else Has_Atomic_Components (Arr) + or else Is_Atomic (Ctyp)) and then (Has_Component_Size_Clause (Arr) or else Is_Packed (Arr)) then @@ -7801,11 +7801,16 @@ package body Freeze is if (SSO_Set_Low_By_Default (T) or else SSO_Set_High_By_Default (T)) -- For a record type, if bit order is specified explicitly, then - -- do not set SSO from default if not consistent. + -- do not set SSO from default if not consistent. Note that we + -- do not want to look at a Bit_Order attribute definition for + -- a parent: if we were to inherit Bit_Order, then both + -- SSO_Set_*_By_Default flags would have been cleared already + -- (by Inherit_Aspects_At_Freeze_Point). and then not (Is_Record_Type (T) - and then Has_Rep_Item (T, Name_Bit_Order) + and then Has_Rep_Item (T, + Name_Bit_Order, Check_Parents => False) and then Reverse_Bit_Order (T) /= Reversed) then -- If flags cause reverse storage order, then set the result. Note diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index b69c74ee68f..2c3be8f4e43 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -82,7 +82,7 @@ package body Ghost is for Index in reverse Ignored_Ghost_Units.First .. Ignored_Ghost_Units.Last loop - -- The unit is already present in the table, do not add it again + -- If the unit is already present in the table, do not add it again if Unit = Ignored_Ghost_Units.Table (Index) then return; @@ -260,11 +260,10 @@ package body Ghost is Ref : Node_Id; begin - Ref := N; - -- When the reference extracts a subcomponent, recover the -- related object (SPARK RM 6.9(1)). + Ref := N; while Nkind_In (Ref, N_Explicit_Dereference, N_Indexed_Component, N_Selected_Component, @@ -884,11 +883,10 @@ package body Ghost is elsif Nkind_In (N, N_Assignment_Statement, N_Procedure_Call_Statement) then - Nam := Name (N); - -- When the reference extracts a subcomponent, recover the related -- object (SPARK RM 6.9(1)). + Nam := Name (N); while Nkind_In (Nam, N_Explicit_Dereference, N_Indexed_Component, N_Selected_Component, @@ -922,10 +920,8 @@ package body Ghost is begin if Is_Checked_Ghost_Entity (Id) then Ghost_Mode := Check; - elsif Is_Ignored_Ghost_Entity (Id) then Ghost_Mode := Ignore; - Propagate_Ignored_Ghost_Code (N); end if; end Set_Ghost_Mode_For_Freeze; @@ -936,11 +932,9 @@ package body Ghost is procedure Set_Is_Ghost_Entity (Id : Entity_Id) is Policy : constant Name_Id := Policy_In_Effect (Name_Ghost); - begin if Policy = Name_Check then Set_Is_Checked_Ghost_Entity (Id); - elsif Policy = Name_Ignore then Set_Is_Ignored_Ghost_Entity (Id); end if; diff --git a/gcc/ada/i-cpoint.adb b/gcc/ada/i-cpoint.adb index 0f17bb25b38..afcb96b9d4c 100644 --- a/gcc/ada/i-cpoint.adb +++ b/gcc/ada/i-cpoint.adb @@ -109,22 +109,22 @@ package body Interfaces.C.Pointers is if Source = null or else Target = null then raise Dereference_Error; + -- Forward copy + elsif To_Addr (Target) <= To_Addr (Source) then - -- Forward copy T := Target; S := Source; - for J in 1 .. Length loop T.all := S.all; Increment (T); Increment (S); end loop; + -- Backward copy + else - -- Backward copy T := Target + Length; S := Source + Length; - for J in 1 .. Length loop Decrement (T); Decrement (S); diff --git a/gcc/ada/prj-err.adb b/gcc/ada/prj-err.adb index e6e6dd3b8e5..44ad905c21a 100644 --- a/gcc/ada/prj-err.adb +++ b/gcc/ada/prj-err.adb @@ -72,6 +72,8 @@ package body Prj.Err is Real_Location : Source_Ptr := Location; begin + -- Don't post message if incompleted with's (avoid junk cascaded errors) + if Flags.Incomplete_Withs then return; end if; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 935f3de510f..ac55681e657 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -2052,7 +2052,7 @@ private Missing_Source_Files : Error_Warning; Ignore_Missing_With : Boolean; - Incomplete_Withs : Boolean := False; + Incomplete_Withs : Boolean := False; -- This flag is set to True when the projects are parsed while ignoring -- missing withed project and some withed projects are not found. diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index 13732fb73a3..661a05ada53 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -128,6 +128,10 @@ package body Restrict is -- real violation, serious vs non-serious, implicit vs explicit, the second -- message giving the profile name if needed, and the location information. + function Same_Entity (E1, E2 : Node_Id) return Boolean; + -- Returns True iff E1 and E2 represent the same entity. Used for handling + -- of No_Use_Of_Entity => fully_qualified_ENTITY restriction case. + function Same_Unit (U1, U2 : Node_Id) return Boolean; -- Returns True iff U1 and U2 represent the same library unit. Used for -- handling of No_Dependence => Unit restriction case. @@ -680,6 +684,98 @@ package body Restrict is end if; end Check_Restriction_No_Use_Of_Attribute; + ---------------------------------------- + -- Check_Restriction_No_Use_Of_Entity -- + ---------------------------------------- + + procedure Check_Restriction_No_Use_Of_Entity (N : Node_Id) is + begin + -- Error defence (not clearly necessary, but better safe) + + if No (Entity (N)) then + return; + end if; + + -- If simple name of entity not flagged with Boolean2 flag, then there + -- cannot be a matching entry in the table, so skip the search. + + if Get_Name_Table_Boolean2 (Chars (Entity (N))) = False then + return; + end if; + + -- Restriction is only recognized within a configuration + -- pragma file, or within a unit of the main extended + -- program. Note: the test for Main_Unit is needed to + -- properly include the case of configuration pragma files. + + if Current_Sem_Unit /= Main_Unit + and then not In_Extended_Main_Source_Unit (N) + then + return; + end if; + + -- Here we must search the table + + for J in No_Use_Of_Entity.First .. No_Use_Of_Entity.Last loop + declare + NE_Ent : NE_Entry renames No_Use_Of_Entity.Table (J); + Ent : Entity_Id; + Expr : Node_Id; + + begin + Ent := Entity (N); + Expr := NE_Ent.Entity; + loop + -- Here if at outer level of entity name in reference + + if Scope (Ent) = Standard_Standard then + if Nkind_In (Expr, N_Identifier, N_Operator_Symbol) + and then Chars (Ent) = Chars (Expr) + then + Error_Msg_Node_1 := N; + Error_Msg_Warn := NE_Ent.Warn; + Error_Msg_Sloc := Sloc (NE_Ent.Entity); + Error_Msg_N + ("<*> null; + end loop; + end; + end loop; + end Check_Restriction_No_Use_Of_Entity; + ---------------------------------------- -- Check_Restriction_No_Use_Of_Pragma -- ---------------------------------------- @@ -864,6 +960,27 @@ package body Restrict is end if; end OK_No_Dependence_Unit_Name; + ------------------------------ + -- OK_No_Use_Of_Entity_Name -- + ------------------------------ + + function OK_No_Use_Of_Entity_Name (N : Node_Id) return Boolean is + begin + if Nkind (N) = N_Selected_Component then + return + OK_No_Use_Of_Entity_Name (Prefix (N)) + and then + OK_No_Use_Of_Entity_Name (Selector_Name (N)); + + elsif Nkind_In (N, N_Identifier, N_Operator_Symbol) then + return True; + + else + Error_Msg_N ("wrong form for entity name for No_Use_Of_Entity", N); + return False; + end if; + end OK_No_Use_Of_Entity_Name; + ---------------------------------- -- Process_Restriction_Synonyms -- ---------------------------------- @@ -1146,6 +1263,30 @@ package body Restrict is end if; end Restriction_Msg; + ----------------- + -- Same_Entity -- + ----------------- + + function Same_Entity (E1, E2 : Node_Id) return Boolean is + begin + if Nkind_In (E1, N_Identifier, N_Operator_Symbol) + and then + Nkind_In (E2, N_Identifier, N_Operator_Symbol) + then + return Chars (E1) = Chars (E2); + + elsif Nkind_In (E1, N_Selected_Component, N_Expanded_Name) + and then + Nkind_In (E2, N_Selected_Component, N_Expanded_Name) + then + return Same_Unit (Prefix (E1), Prefix (E2)) + and then + Same_Unit (Selector_Name (E1), Selector_Name (E2)); + else + return False; + end if; + end Same_Entity; + --------------- -- Same_Unit -- --------------- @@ -1360,6 +1501,54 @@ package body Restrict is No_Dependences.Append ((Unit, Warn, Profile)); end Set_Restriction_No_Dependence; + -------------------------------------- + -- Set_Restriction_No_Use_Of_Entity -- + -------------------------------------- + + procedure Set_Restriction_No_Use_Of_Entity + (Entity : Node_Id; + Warn : Boolean; + Profile : Profile_Name := No_Profile) + is + Nam : Node_Id; + + begin + -- Loop to check for duplicate entry + + for J in No_Use_Of_Entity.First .. No_Use_Of_Entity.Last loop + + -- Case of entry already in table + + if Same_Entity (Entity, No_Use_Of_Entity.Table (J).Entity) then + + -- Error has precedence over warning + + if not Warn then + No_Use_Of_Entity.Table (J).Warn := False; + end if; + + return; + end if; + end loop; + + -- Entry is not currently in table + + No_Use_Of_Entity.Append ((Entity, Warn, Profile)); + + -- Now we need to find the direct name and set Boolean2 flag + + if Nkind_In (Entity, N_Identifier, N_Operator_Symbol) then + Nam := Entity; + + else + pragma Assert (Nkind (Entity) = N_Selected_Component); + Nam := Selector_Name (Entity); + pragma Assert (Nkind_In (Nam, N_Identifier, N_Operator_Symbol)); + end if; + + Set_Name_Table_Boolean2 (Chars (Nam), True); + end Set_Restriction_No_Use_Of_Entity; + ------------------------------------------------ -- Set_Restriction_No_Specification_Of_Aspect -- ------------------------------------------------ diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index a25dceed1c5..e683a715480 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -273,16 +273,6 @@ package Restrict is -- Wrapper on Check_Restriction with Msg_Issued, with the out-parameter -- being ignored here. - procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id); - -- N is the node of an attribute definition clause. An error message - -- (warning) will be issued if a restriction (warning) was previously set - -- for this attribute using Set_No_Use_Of_Attribute. - - procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id); - -- N is the node of a pragma. An error message (warning) will be issued - -- if a restriction (warning) was previously set for this pragma using - -- Set_No_Use_Of_Pragma. - procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id); -- Called when a dependence on a unit is created (either implicitly, or by -- an explicit WITH clause). U is a node for the unit involved, and Err is @@ -293,6 +283,21 @@ package Restrict is -- (warning) will be issued if a restriction (warning) was previous set -- for this aspect using Set_No_Specification_Of_Aspect. + procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id); + -- N is the node of an attribute definition clause. An error message + -- (warning) will be issued if a restriction (warning) was previously set + -- for this attribute using Set_No_Use_Of_Attribute. + + procedure Check_Restriction_No_Use_Of_Entity (N : Node_Id); + -- N is the node id for an entity reference. An error message (warning) + -- will be issued if a restriction (warning) was previous set for this + -- entity name using Set_No_Use_Of_Entity. + + procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id); + -- N is the node of a pragma. An error message (warning) will be issued + -- if a restriction (warning) was previously set for this pragma using + -- Set_No_Use_Of_Pragma. + procedure Check_Elaboration_Code_Allowed (N : Node_Id); -- Tests to see if elaboration code is allowed by the current restrictions -- settings. This function is called by Gigi when it needs to define an @@ -356,6 +361,11 @@ package Restrict is -- pragma Restrictions_Warning, or attribute Restriction_Set. Returns -- True if N has the proper form for a unit name, False otherwise. + function OK_No_Use_Of_Entity_Name (N : Node_Id) return Boolean; + -- Used in checking No_Use_Of_Entity argument of pragma Restrictions or + -- pragma Restrictions_Warning, or attribute Restriction_Set. Returns + -- True if N has the proper form for an entity name, False otherwise. + function Is_In_Hidden_Part_In_SPARK (Loc : Source_Ptr) return Boolean; -- Determine if given location is covered by a hidden region range in the -- SPARK hides table. @@ -460,6 +470,18 @@ package Restrict is -- No_Use_Of_Attribute. Caller has verified that this is a valid attribute -- designator. + procedure Set_Restriction_No_Use_Of_Entity + (Entity : Node_Id; + Warn : Boolean; + Profile : Profile_Name := No_Profile); + -- Sets given No_Use_Of_Entity restriction in table if not there already. + -- Warn is True if from Restriction_Warnings, or for Restrictions if the + -- flag Treat_Restrictions_As_Warnings is set. False if from Restrictions + -- and this flag is not set. Profile is set to a non-default value if the + -- No_Dependence restriction comes from a Profile pragma. This procedure + -- also takes care of setting the Boolean2 flag of the simple name for + -- the entity (to optimize table searches). + procedure Set_Restriction_No_Use_Of_Pragma (N : Node_Id; Warning : Boolean); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 8c7731488a0..26b697f3c3a 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -5235,7 +5235,7 @@ package body Sem_Ch8 is Nvis_Messages; end if; - return; + goto Done; -- Processing for a potentially use visible entry found. We must search -- the rest of the homonym chain for two reasons. First, if there is a @@ -5345,7 +5345,7 @@ package body Sem_Ch8 is end loop; Nvis_Messages; - return; + goto Done; elsif Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit)) @@ -5372,7 +5372,7 @@ package body Sem_Ch8 is else Nvis_Messages; - return; + goto Done; end if; end if; end; @@ -5477,9 +5477,8 @@ package body Sem_Ch8 is and then Expander_Active and then Get_PCS_Name /= Name_No_DSA then - Rewrite (N, - New_Occurrence_Of (Equivalent_Type (E), Sloc (N))); - return; + Rewrite (N, New_Occurrence_Of (Equivalent_Type (E), Sloc (N))); + goto Done; end if; -- Set the entity. Note that the reason we call Set_Entity for the @@ -5634,6 +5633,11 @@ package body Sem_Ch8 is end if; end if; end; + + -- Come here with entity set + + <> + Check_Restriction_No_Use_Of_Entity (N); end Find_Direct_Name; ------------------------ diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index dd2bc1be43e..59a54ee332c 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -8895,12 +8895,25 @@ package body Sem_Prag is Set_Restriction_No_Use_Of_Attribute (Expr, Warn); end if; - -- Case of No_Use_Of_Entity => fully-qualified-name. Note that the - -- parser already processed this case commpletely, including error - -- checking and making an entry in the No_Use_Of_Entity table. + -- Case of No_Use_Of_Entity => fully-qualified-name elsif Id = Name_No_Use_Of_Entity then - null; + + -- Restriction is only recognized within a configuration + -- pragma file, or within a unit of the main extended + -- program. Note: the test for Main_Unit is needed to + -- properly include the case of configuration pragma files. + + if Current_Sem_Unit = Main_Unit + or else In_Extended_Main_Source_Unit (N) + then + if not OK_No_Dependence_Unit_Name (Expr) then + Error_Msg_N ("wrong form for entity name", Expr); + else + Set_Restriction_No_Use_Of_Entity + (Expr, Warn, No_Profile); + end if; + end if; -- Case of No_Use_Of_Pragma => pragma-identifier @@ -8909,7 +8922,6 @@ package body Sem_Prag is or else not Is_Pragma_Name (Chars (Expr)) then Error_Msg_N ("unknown pragma name??", Expr); - else Set_Restriction_No_Use_Of_Pragma (Expr, Warn); end if; @@ -14941,7 +14953,7 @@ package body Sem_Prag is -- Independent_Components -- ---------------------------- - -- pragma Atomic_Components (array_or_record_LOCAL_NAME); + -- pragma Independent_Components (array_or_record_LOCAL_NAME); when Pragma_Independent_Components => Independent_Components : declare E_Id : Node_Id;