mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 10:50:51 +08:00
Code Issues Packages Projects Releases Wiki Activity

rtsfind.adb (Is_RTE): Protect against entity with no scope field (previously this call blew up on the...

Browse Source 
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.

From-SVN: r208148
This commit is contained in:
Robert Dewar 2014-02-25 15:52:52 +00:00 committed by Arnaud Charlet
parent 2886a49530
commit e7ba564fca
11 changed files with 127 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/ChangeLog
View File

@ -1,3 +1,22 @@
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

17
gcc/ada/exp_ch6.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -3641,21 +3641,6 @@ package body Exp_Ch6 is
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

19
gcc/ada/exp_ch9.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -6330,11 +6330,16 @@ package body Exp_Ch9 is
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;
@ -9079,6 +9084,12 @@ package body Exp_Ch9 is
-- 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

4
gcc/ada/rtsfind.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -464,7 +464,7 @@ package body Rtsfind is
S := Scope (Ent);
if Ekind (S) /= E_Package then
if No (S) or else Ekind (S) /= E_Package then
return False;
end if;

19
gcc/ada/sem_attr.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -9645,9 +9645,7 @@ package body Sem_Attr is
| 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);
@ -9692,7 +9690,6 @@ package body Sem_Attr is
-- 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
@ -9700,18 +9697,6 @@ package body Sem_Attr is
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

8
gcc/ada/sem_ch10.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -2632,7 +2632,7 @@ package body Sem_Ch10 is
-- 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
@ -2657,7 +2657,7 @@ package body Sem_Ch10 is
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);
@ -2697,7 +2697,7 @@ package body Sem_Ch10 is
-- 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

16
gcc/ada/sem_ch4.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1298,7 +1298,7 @@ package body Sem_Ch4 is
-- 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)));
@ -3503,7 +3503,7 @@ package body Sem_Ch4 is
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;
@ -4002,7 +4002,7 @@ package body Sem_Ch4 is
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;
@ -4239,7 +4239,7 @@ package body Sem_Ch4 is
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
@ -4420,7 +4420,7 @@ package body Sem_Ch4 is
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));
@ -4497,7 +4497,7 @@ package body Sem_Ch4 is
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
@ -4706,7 +4706,7 @@ package body Sem_Ch4 is
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));

12
gcc/ada/sem_ch8.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -3664,7 +3664,7 @@ package body Sem_Ch8 is
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
@ -5058,16 +5058,16 @@ package body Sem_Ch8 is
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
@ -6579,7 +6579,7 @@ package body Sem_Ch8 is
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;

23
gcc/ada/sem_res.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -5406,18 +5406,7 @@ package body Sem_Res is
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
@ -5433,7 +5422,7 @@ package body Sem_Res is
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;
@ -6235,7 +6224,7 @@ package body Sem_Res is
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;
@ -6507,7 +6496,7 @@ package body Sem_Res is
-- 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
@ -9226,7 +9215,7 @@ package body Sem_Res is
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

54
gcc/ada/sem_util.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -15805,19 +15805,59 @@ package body Sem_Util is
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
@ -15834,7 +15874,7 @@ package body Sem_Util is
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;
@ -15877,7 +15917,7 @@ package body Sem_Util is
end if;
Set_Entity (N, Val);
end Set_Entity_With_Style_Check;
end Set_Entity_With_Checks;
------------------------
-- Set_Name_Entity_Id --

23
gcc/ada/sem_util.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1765,11 +1765,22 @@ package Sem_Util is
-- 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);