From e7ba564fca6cb914e202ed4807142b7008bcde0c Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Tue, 25 Feb 2014 15:52:52 +0000 Subject: [PATCH] rtsfind.adb (Is_RTE): Protect against entity with no scope field (previously this call blew up on the... 2014-02-25 Robert Dewar * 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 * exp_ch9.adb (Expand_Entry_Barrier): Add comment that call to Check_Restriction is OK. From-SVN: r208148 --- gcc/ada/ChangeLog | 19 ++++++++++++++++++ gcc/ada/exp_ch6.adb | 17 +---------------- gcc/ada/exp_ch9.adb | 19 ++++++++++++++---- gcc/ada/rtsfind.adb | 4 ++-- gcc/ada/sem_attr.adb | 19 ++---------------- gcc/ada/sem_ch10.adb | 8 ++++---- gcc/ada/sem_ch4.adb | 16 ++++++++-------- gcc/ada/sem_ch8.adb | 12 ++++++------ gcc/ada/sem_res.adb | 23 ++++++---------------- gcc/ada/sem_util.adb | 54 +++++++++++++++++++++++++++++++++++++++++++++------- gcc/ada/sem_util.ads | 23 ++++++++++++++++------ 11 files changed, 127 insertions(+), 87 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6863929..98c8cec 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2014-02-25 Robert Dewar + + * 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 + + * exp_ch9.adb (Expand_Entry_Barrier): Add comment that call to + Check_Restriction is OK. + 2014-02-25 Ed Schonberg * sem_ch3.adb (Process_Full_View): Better error message when diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 58e945e..46cc9ca 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -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 diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index e1b0267..0103cfa 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -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 diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index 60e47f8..ad37133 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -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; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 6a0c892..a561f066 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -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 diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index df4aacf..49f7df1 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -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 diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 62d714e..b3da4ad 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -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)); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index ce63626..a727679 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index cbb4de9..5a70b2d 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 791bc2e..6894a3a 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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 -- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 0578ca3..4e55734 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -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); -- 2.7.4