+2014-02-25 Robert Dewar <dewar@adacore.com>
+
+ * rtsfind.adb (Is_RTE): Protect against entity with no scope
+ field (previously this call blew up on the Standard entity).
+ * sem_attr.adb (Analyze_Attribute, case Access): Remove
+ test for No_Abort_Statements, this is now handled in
+ Set_Entity_With_Checks.
+ * exp_ch6.adb, sem_ch10.adb, sem_ch4.adb, sem_ch8.adb, sem_res.adb:
+ Change name Set_Entity_With_Style_Check => Set_Entity_With_Checks.
+ * sem_util.ads, sem_util.adb: Change name Set_Entity_With_Style_Check =>
+ Set_Entity_With_Checks.
+ (Set_Entity_With_Checks): Add checks for No_Dynamic_Attachment,
+ Add checks for No_Abort_Statements.
+
+2014-02-25 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch9.adb (Expand_Entry_Barrier): Add comment that call to
+ Check_Restriction is OK.
+
2014-02-25 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Process_Full_View): Better error message when
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Subp := Parent_Subp;
end if;
- -- Check for violation of No_Dynamic_Attachment
-
- if Restriction_Check_Required (No_Dynamic_Attachment)
- and then RTU_Loaded (Ada_Interrupts)
- and then (Is_RTE (Subp, RE_Is_Reserved) or else
- Is_RTE (Subp, RE_Is_Attached) or else
- Is_RTE (Subp, RE_Current_Handler) or else
- Is_RTE (Subp, RE_Attach_Handler) or else
- Is_RTE (Subp, RE_Exchange_Handler) or else
- Is_RTE (Subp, RE_Detach_Handler) or else
- Is_RTE (Subp, RE_Reference))
- then
- Check_Restriction (No_Dynamic_Attachment, Call_Node);
- end if;
-
-- Deal with case where call is an explicit dereference
if Nkind (Name (Call_Node)) = N_Explicit_Dereference then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
end if;
end if;
- -- It is not a boolean variable or literal, so check the restriction
- -- and otherwise emit warning if barrier contains global entities and
- -- is thus potentially unsynchronized.
+ -- It is not a boolean variable or literal, so check the restriction.
+ -- Note that it is safe to be calling Check_Restriction from here, even
+ -- though this is part of the expander, since Expand_Entry_Barrier is
+ -- called from Sem_Ch9 even in -gnatc mode.
Check_Restriction (Simple_Barriers, Cond);
+
+ -- Emit warning if barrier contains global entities and is thus
+ -- potentially unsynchronized.
+
Check_Unprotected_Barrier (Cond);
end Expand_Entry_Barrier;
-- warning on a protected type declaration.
if not Comes_From_Source (Prot_Typ) then
+
+ -- It's ok to be checking this restriction at expansion
+ -- time, because this is only for the restricted profile,
+ -- which is not subject to strict RM conformance, so it
+ -- is OK to miss this check in -gnatc mode.
+
Check_Restriction (No_Implicit_Heap_Allocations, Priv);
elsif Restriction_Active (No_Implicit_Heap_Allocations) then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
S := Scope (Ent);
- if Ekind (S) /= E_Package then
+ if No (S) or else Ekind (S) /= E_Package then
return False;
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
| Attribute_Unchecked_Access
| Attribute_Unrestricted_Access =>
- Access_Attribute : declare
- Nam : Entity_Id;
-
+ Access_Attribute :
begin
if Is_Variable (P) then
Note_Possible_Modification (P, Sure => False);
-- If it is an object, complete its resolution.
elsif Is_Overloadable (Entity (P)) then
- Nam := Entity (P);
-- Avoid insertion of freeze actions in spec expression mode
Freeze_Before (N, Entity (P));
end if;
- -- Forbid access to Abort_Task if restriction active
-
- if Restriction_Check_Required (No_Abort_Statements)
- and then
- (Is_RTE (Nam, RE_Abort_Task)
- or else
- (Present (Alias (Nam))
- and then Is_RTE (Alias (Nam), RE_Abort_Task)))
- then
- Check_Restriction (No_Abort_Statements, N);
- end if;
-
elsif Is_Type (Entity (P)) then
null;
else
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- to consider the unit as unreferenced if this is the only reference
-- that occurs.
- Set_Entity_With_Style_Check (Name (N), E_Name);
+ Set_Entity_With_Checks (Name (N), E_Name);
Generate_Reference (E_Name, Name (N), 'w', Set_Ref => False);
-- Generate references and check No_Dependence restriction for parents
exit;
end if;
- Set_Entity_With_Style_Check (Pref, Par_Name);
+ Set_Entity_With_Checks (Pref, Par_Name);
Generate_Reference (Par_Name, Pref);
Check_Restriction_No_Dependence (Pref, N);
-- Guard against missing or misspelled child units
if Present (Par_Name) then
- Set_Entity_With_Style_Check (Pref, Par_Name);
+ Set_Entity_With_Checks (Pref, Par_Name);
Generate_Reference (Par_Name, Pref);
else
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- Resolution yields a single interpretation. Verify that the
-- reference has capitalization consistent with the declaration.
- Set_Entity_With_Style_Check (Nam, Entity (Nam));
+ Set_Entity_With_Checks (Nam, Entity (Nam));
Generate_Reference (Entity (Nam), Nam);
Set_Etype (Nam, Etype (Entity (Nam)));
if Is_Overloadable (Comp) then
Add_One_Interp (Sel, Comp, Etype (Comp));
else
- Set_Entity_With_Style_Check (Sel, Comp);
+ Set_Entity_With_Checks (Sel, Comp);
Generate_Reference (Comp, Sel);
end if;
Comp := First_Component (Rec);
while Present (Comp) loop
if Chars (Comp) = Chars (Sel) then
- Set_Entity_With_Style_Check (Sel, Comp);
+ Set_Entity_With_Checks (Sel, Comp);
Set_Etype (Sel, Etype (Comp));
Set_Etype (N, Etype (Comp));
return;
if Chars (Comp) = Chars (Sel)
and then Is_Visible_Component (Comp, N)
then
- Set_Entity_With_Style_Check (Sel, Comp);
+ Set_Entity_With_Checks (Sel, Comp);
Set_Etype (Sel, Etype (Comp));
if Ekind (Comp) = E_Discriminant then
while Present (Comp) loop
if Chars (Comp) = Chars (Sel) then
if Ekind (Comp) = E_Discriminant then
- Set_Entity_With_Style_Check (Sel, Comp);
+ Set_Entity_With_Checks (Sel, Comp);
Generate_Reference (Comp, Sel);
Set_Etype (Sel, Etype (Comp));
and then not Is_Protected_Type (Prefix_Type)
and then Is_Entity_Name (Name))
then
- Set_Entity_With_Style_Check (Sel, Comp);
+ Set_Entity_With_Checks (Sel, Comp);
Generate_Reference (Comp, Sel);
-- The selector is not overloadable, so we have a candidate
if Chars (Comp) = Chars (Sel)
and then Is_Visible_Component (Comp)
then
- Set_Entity_With_Style_Check (Sel, Comp);
+ Set_Entity_With_Checks (Sel, Comp);
Generate_Reference (Comp, Sel);
Set_Etype (Sel, Etype (Comp));
Set_Etype (N, Etype (Comp));
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
or else Ekind (E) /= E_Discriminant
or else Inside_A_Generic
then
- Set_Entity_With_Style_Check (N, E);
+ Set_Entity_With_Checks (N, E);
-- The replacement of a discriminant by the corresponding discriminal
-- is not done for a task discriminant that appears in a default
end if;
-- Set the entity. Note that the reason we call Set_Entity for the
- -- overloadable case, as opposed to Set_Entity_With_Style_Check is
+ -- overloadable case, as opposed to Set_Entity_With_Checks is
-- that in the overloaded case, the initial call can set the wrong
-- homonym. The call that sets the right homonym is in Sem_Res and
- -- that call does use Set_Entity_With_Style_Check, so we don't miss
+ -- that call does use Set_Entity_With_Checks, so we don't miss
-- a style check.
if Is_Overloadable (E) then
Set_Entity (N, E);
else
- Set_Entity_With_Style_Check (N, E);
+ Set_Entity_With_Checks (N, E);
end if;
if Is_Type (E) then
C := Class_Wide_Type (Entity (Prefix (N)));
end if;
- Set_Entity_With_Style_Check (N, C);
+ Set_Entity_With_Checks (N, C);
Generate_Reference (C, N);
Set_Etype (N, C);
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
elsif not (Is_Type (Entity (Subp))) then
Nam := Entity (Subp);
- Set_Entity_With_Style_Check (Subp, Nam);
-
- -- Check restriction No_Abort_Statements, which is triggered by a
- -- call to Ada.Task_Identification.Abort_Task.
-
- if Restriction_Check_Required (No_Abort_Statements)
- and then (Is_RTE (Nam, RE_Abort_Task)
- or else (Present (Alias (Nam))
- and then Is_RTE (Alias (Nam), RE_Abort_Task)))
- then
- Check_Restriction (No_Abort_Statements, N);
- end if;
+ Set_Entity_With_Checks (Subp, Nam);
-- Otherwise we must have the case of an overloaded call
while Present (It.Typ) loop
if Covers (Typ, It.Typ) then
Nam := It.Nam;
- Set_Entity_With_Style_Check (Subp, Nam);
+ Set_Entity_With_Checks (Subp, Nam);
exit;
end if;
C := Current_Entity (N);
while Present (C) loop
if Etype (C) = B_Typ then
- Set_Entity_With_Style_Check (N, C);
+ Set_Entity_With_Checks (N, C);
Generate_Reference (C, N);
return;
end if;
-- not do a style check during the first phase of analysis.
elsif Ekind (E) = E_Enumeration_Literal then
- Set_Entity_With_Style_Check (N, E);
+ Set_Entity_With_Checks (N, E);
Eval_Entity_Name (N);
-- Case of subtype name appearing as an operand in expression
Resolve (P, It1.Typ);
Set_Etype (N, Typ);
- Set_Entity_With_Style_Check (S, Comp1);
+ Set_Entity_With_Checks (S, Comp1);
else
-- Resolve prefix with its type
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
end if;
end Set_Debug_Info_Needed;
- ---------------------------------
- -- Set_Entity_With_Style_Check --
- ---------------------------------
+ ----------------------------
+ -- Set_Entity_With_Checks --
+ ----------------------------
- procedure Set_Entity_With_Style_Check (N : Node_Id; Val : Entity_Id) is
+ procedure Set_Entity_With_Checks (N : Node_Id; Val : Entity_Id) is
Val_Actual : Entity_Id;
Nod : Node_Id;
+ Post_Node : Node_Id;
begin
-- Unconditionally set the entity
Set_Entity (N, Val);
+ -- Remaining checks are only done on source nodes
+
+ if not Comes_From_Source (N) then
+ return;
+ end if;
+
+ -- The node to post on is the selector in the case of an expanded name,
+ -- and otherwise the node itself.
+
+ if Nkind (N) = N_Expanded_Name then
+ Post_Node := Selector_Name (N);
+ else
+ Post_Node := N;
+ end if;
+
+ -- Check for violation of No_Abort_Statements, which is triggered by
+ -- call to Ada.Task_Identification.Abort_Task.
+
+ if Restriction_Check_Required (No_Abort_Statements)
+ and then (Is_RTE (Val, RE_Abort_Task))
+ then
+ Check_Restriction (No_Abort_Statements, Post_Node);
+ end if;
+
+ -- Check for violation of No_Dynamic_Attachment
+
+ if Restriction_Check_Required (No_Dynamic_Attachment)
+ and then RTU_Loaded (Ada_Interrupts)
+ and then (Is_RTE (Val, RE_Is_Reserved) or else
+ Is_RTE (Val, RE_Is_Attached) or else
+ Is_RTE (Val, RE_Current_Handler) or else
+ Is_RTE (Val, RE_Attach_Handler) or else
+ Is_RTE (Val, RE_Exchange_Handler) or else
+ Is_RTE (Val, RE_Detach_Handler) or else
+ Is_RTE (Val, RE_Reference))
+ then
+ Check_Restriction (No_Dynamic_Attachment, Post_Node);
+ end if;
+
-- Check for No_Implementation_Identifiers
if Restriction_Check_Required (No_Implementation_Identifiers) then
and then not (Ekind_In (Val, E_Package, E_Generic_Package)
and then Is_Library_Level_Entity (Val))
then
- Check_Restriction (No_Implementation_Identifiers, N);
+ Check_Restriction (No_Implementation_Identifiers, Post_Node);
end if;
end if;
end if;
Set_Entity (N, Val);
- end Set_Entity_With_Style_Check;
+ end Set_Entity_With_Checks;
------------------------
-- Set_Name_Entity_Id --
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- This routine should always be used instead of Set_Needs_Debug_Info to
-- ensure that subsidiary entities are properly handled.
- procedure Set_Entity_With_Style_Check (N : Node_Id; Val : Entity_Id);
- -- This procedure has the same calling sequence as Set_Entity, but
- -- if Style_Check is set, then it calls a style checking routine which
- -- can check identifier spelling style. This procedure also takes care
- -- of checking the restriction No_Implementation_Identifiers.
+ procedure Set_Entity_With_Checks (N : Node_Id; Val : Entity_Id);
+ -- This procedure has the same calling sequence as Set_Entity, but it
+ -- performs additional checks as follows:
+ --
+ -- If Style_Check is set, then it calls a style checking routine which
+ -- can check identifier spelling style. This procedure also takes care
+ -- of checking the restriction No_Implementation_Identifiers.
+ --
+ -- If restriction No_Abort_Statements is set, then it checks that the
+ -- entity is not Ada.Task_Identification.Abort_Task.
+ --
+ -- If restriction No_Dynamic_Attachment is set, then it checks that the
+ -- entity is not one of the restricted names for this restriction.
+ --
+ -- If restriction No_Implementation_Identifiers is set, then it checks
+ -- that the entity is not implementation defined.
procedure Set_Name_Entity_Id (Id : Name_Id; Val : Entity_Id);
pragma Inline (Set_Name_Entity_Id);
projects / platform / upstream / gcc.git / commitdiff