OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

prj.ads, [...]: Minor reformatting. 

2015-01-07  Robert Dewar  <dewar@adacore.com>

	* prj.ads, i-cpoint.adb, freeze.adb, ghost.adb, prj-err.adb: Minor
	reformatting.

2015-01-07  Robert Dewar  <dewar@adacore.com>

	* 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
This commit is contained in:
Robert Dewar 2015-01-07 08:49:42 +00:00 committed by Arnaud Charlet
parent 7806a9ed84
commit 18dae8141c
10 changed files with 288 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/ada/ChangeLog
View File

@ -1,3 +1,23 @@
2015-01-07 Robert Dewar <dewar@adacore.com>
* prj.ads, i-cpoint.adb, freeze.adb, ghost.adb, prj-err.adb: Minor
reformatting.
2015-01-07 Robert Dewar <dewar@adacore.com>
* 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 <ebotcazou@adacore.com>
* freeze.adb (Freeze_Array_Type): Apply same handling to Is_Atomic

13
gcc/ada/freeze.adb
View File

@ -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

12
gcc/ada/ghost.adb
View File

@ -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;

8
gcc/ada/i-cpoint.adb
View File

@ -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);

2
gcc/ada/prj-err.adb
View File

@ -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;

2
gcc/ada/prj.ads
View File

@ -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.

189
gcc/ada/restrict.adb
View File

@ -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
("<*<reference to & violates restriction "
& "No_Use_Of_Entity #", N);
return;
else
goto Continue;
end if;
-- Here if at outer level of entity name in table
elsif Nkind_In (Expr, N_Identifier, N_Operator_Symbol) then
goto Continue;
-- Here if neither at the outer level
else
pragma Assert (Nkind (Expr) = N_Selected_Component);
if Chars (Selector_Name (Expr)) /= Chars (Ent) then
goto Continue;
end if;
end if;
-- Move up a level
loop
Ent := Scope (Ent);
exit when not Is_Internal_Name (Chars (Ent));
end loop;
Expr := Prefix (Expr);
-- Entry did not match
<<Continue>> 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 --
------------------------------------------------

42
gcc/ada/restrict.ads
View File

@ -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);

16
gcc/ada/sem_ch8.adb
View File

@ -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
<<Done>>
Check_Restriction_No_Use_Of_Entity (N);
end Find_Direct_Name;
------------------------

24
gcc/ada/sem_prag.adb
View File

@ -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;