A new restriction No_Use_Of_Entity is implemented. The form of this is
pragma Restriction[_Warning]s (No_Use_Of_Entity => NAME), where NAME is
a fully qualified entity name. The effect is to forbid references to
this entity in the main unit, its spec, and any subunits.
The following is compiled with -gnatl -gnatj55
1. pragma Restrictions
2. (No_Use_Of_Entity => Ada.Text_IO.Put_Line);
3. with Ada.Text_IO; use Ada.Text_IO;
4. procedure NUOE is
5. begin
6. Put ("Hello");
7. Put_Line ("Hello_World!");
|
>>> reference to "Put_Line" violates
restriction No_Use_Of_Entity at line 2
8. end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2015-01-07 Robert Dewar <de...@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.
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 219280)
+++ sem_prag.adb (working copy)
@@ -8895,13 +8895,26 @@
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
elsif Id = Name_No_Use_Of_Pragma then
@@ -8909,7 +8922,6 @@
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 @@
-- 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;
Index: restrict.adb
===================================================================
--- restrict.adb (revision 219191)
+++ restrict.adb (working copy)
@@ -128,6 +128,10 @@
-- 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.
@@ -681,6 +685,98 @@
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 @@
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 @@
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 @@
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 --
------------------------------------------------
Index: restrict.ads
===================================================================
--- restrict.ads (revision 219235)
+++ restrict.ads (working copy)
@@ -273,26 +273,31 @@
-- Wrapper on Check_Restriction with Msg_Issued, with the out-parameter
-- being ignored here.
+ 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
+ -- the node to which an error will be attached if necessary.
+
+ procedure Check_Restriction_No_Specification_Of_Aspect (N : Node_Id);
+ -- N is the node id for an N_Aspect_Specification. An error message
+ -- (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_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
- -- the node to which an error will be attached if necessary.
-
- procedure Check_Restriction_No_Specification_Of_Aspect (N : Node_Id);
- -- N is the node id for an N_Aspect_Specification. An error message
- -- (warning) will be issued if a restriction (warning) was previous set
- -- for this aspect using Set_No_Specification_Of_Aspect.
-
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 @@
-- 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 @@
-- 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);
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb (revision 219280)
+++ sem_ch8.adb (working copy)
@@ -5235,7 +5235,7 @@
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 @@
end loop;
Nvis_Messages;
- return;
+ goto Done;
elsif
Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
@@ -5372,7 +5372,7 @@
else
Nvis_Messages;
- return;
+ goto Done;
end if;
end if;
end;
@@ -5477,9 +5477,8 @@
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 @@
end if;
end if;
end;
+
+ -- Come here with entity set
+
+ <<Done>>
+ Check_Restriction_No_Use_Of_Entity (N);
end Find_Direct_Name;
------------------------
