From e0709aaab25c6d4ff029e69256b11b967cd4f08f Mon Sep 17 00:00:00 2001 From: charlet Date: Wed, 21 May 2014 10:48:37 +0000 Subject: [PATCH] 2014-05-21 Robert Dewar * einfo.ads: Minor reformatting. * ceinfo.adb: Deal with slight format change of einfo.ads. 2014-05-21 Ed Schonberg * sem_prag.adb (Analyze_Part_Of): Further work on the proper implementation of the SPARK 2014 rule concerning private child units (LRM 7.2.6). 2014-05-21 Vincent Celier * makeusg.adb: Add switch -d to usage. 2014-05-21 Ed Schonberg * sem_util.adb (Find_Actual): If an actual that is the prefix of an enclosing prefixed call has been rewritten, use Nkind and Sloc to identify the corresponding formal, when handling deferred references. 2014-05-21 Robert Dewar * debug.adb: Document -gnatd.z switch. * sem_eval.adb (Why_Non_Static): Test -gnatd.z switch. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@210689 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 27 +++++++++++++ gcc/ada/ceinfo.adb | 9 ++++- gcc/ada/debug.adb | 9 ++++- gcc/ada/einfo.ads | 107 +++++++++++++++++++++++++-------------------------- gcc/ada/makeusg.adb | 7 +++- gcc/ada/sem_eval.adb | 9 +++-- gcc/ada/sem_prag.adb | 41 ++++++++++++++------ gcc/ada/sem_util.adb | 10 +++++ 8 files changed, 146 insertions(+), 73 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 31648c7..12038bf 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,32 @@ 2014-05-21 Robert Dewar + * einfo.ads: Minor reformatting. + * ceinfo.adb: Deal with slight format change of einfo.ads. + +2014-05-21 Ed Schonberg + + * sem_prag.adb (Analyze_Part_Of): Further work on the proper + implementation of the SPARK 2014 rule concerning private child + units (LRM 7.2.6). + +2014-05-21 Vincent Celier + + * makeusg.adb: Add switch -d to usage. + +2014-05-21 Ed Schonberg + + * sem_util.adb (Find_Actual): If an actual that is the prefix + of an enclosing prefixed call has been rewritten, use Nkind + and Sloc to identify the corresponding formal, when handling + deferred references. + +2014-05-21 Robert Dewar + + * debug.adb: Document -gnatd.z switch. + * sem_eval.adb (Why_Non_Static): Test -gnatd.z switch. + +2014-05-21 Robert Dewar + * einfo.ads (Can_Never_Be_Null): Minor comment update. * sem_prag.adb (Check_Arg_Is_Task_Dispatching_Policy): Minor error message change. diff --git a/gcc/ada/ceinfo.adb b/gcc/ada/ceinfo.adb index 3f073b3..9c3b6ea 100644 --- a/gcc/ada/ceinfo.adb +++ b/gcc/ada/ceinfo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-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- -- @@ -99,8 +99,15 @@ begin loop Next_Line; + + -- Old format of einfo.ads + exit when Match (Line, " -- Access Kinds --"); + -- New format of einfo.ads + + exit when Match (Line, "-- Access Kinds --"); + if Match (Line, Field_Def) then Set (Fields, Fieldnm, Accessfunc); end if; diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 11237e2..f2f118b 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.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- -- @@ -116,7 +116,7 @@ package body Debug is -- d.w Do not check for infinite loops -- d.x No exception handlers -- d.y - -- d.z + -- d.z Temporary ASIS kludge for why non-static messages -- d.A Read/write Aspect_Specifications hash table to tree -- d.B @@ -589,6 +589,11 @@ package body Debug is -- fully compiled and analyzed, they just get eliminated from the -- code generation step. + -- d.z Temporary debug switch for control of the why non-static messages + -- generated by Why_Non_Static. Normally these messages are suppressed + -- in ASIS mode (d2), but if d.z is set they are not suppressed. This + -- is a temporary switch to aid in updating ASIS base lines. + -- d.A There seems to be a problem with ASIS if we activate the circuit -- for reading and writing the aspect specification hash table, so -- for now, this is controlled by the debug flag d.A. The hash table diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index a007555..998be8b 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -4115,29 +4115,28 @@ package Einfo is -- Is_Primitive_Wrapper. Set to the entity being wrapper. --------------------------- --- Renaming and aliasing -- +-- Renaming and Aliasing -- --------------------------- --- Several entity attributes relate to renaming constructs, and to the use --- of different names to refer to the same entity. Here is a summary of +-- Several entity attributes relate to renaming constructs, and to the use of +-- different names to refer to the same entity. The following is a summary of -- these constructs and their prefered uses. -- There are three related attributes: --- --- Renamed_Entity --- Renamed_Object --- Alias --- + +-- Renamed_Entity +-- Renamed_Object +-- Alias + -- They all overlap because they are supposed to apply to different entity --- kinds, and are semantically related, but they have the following intended --- uses: --- +-- kinds. They are semantically related, and have the following intended uses: + -- a) Renamed_Entity appplies to entities in renaming declarations that rename -- an entity, so the value of the attribute IS an entity. This applies to -- generic renamings, package renamings, exception renamings, and subprograms -- renamings that rename a subprogram (rather than an attribute, an entry, a -- protected operation, etc). --- + -- b) Alias applies to overloadable entities, and the value is an overloadable -- entity. so this is a subset of the previous one. We use the term Alias to -- cover both renamings and inherited operations, because both cases are @@ -4195,56 +4194,56 @@ package Einfo is -- If a subprogram has an access parameter whose designated type is incomplete -- the subprogram has the flag set. - ------------------ - -- Access Kinds -- - ------------------ +------------------ +-- Access Kinds -- +------------------ - -- The following entity kinds are introduced by the corresponding type - -- definitions: +-- The following entity kinds are introduced by the corresponding type +-- definitions: - -- E_Access_Type, - -- E_General_Access_Type, - -- E_Access_Subprogram_Type, - -- E_Anonymous_Access_Subprogram_Type, - -- E_Access_Protected_Subprogram_Type, - -- E_Anonymous_Access_Protected_Subprogram_Type - -- E_Anonymous_Access_Type. +-- E_Access_Type, +-- E_General_Access_Type, +-- E_Access_Subprogram_Type, +-- E_Anonymous_Access_Subprogram_Type, +-- E_Access_Protected_Subprogram_Type, +-- E_Anonymous_Access_Protected_Subprogram_Type +-- E_Anonymous_Access_Type. - -- E_Access_Subtype is for an access subtype created by a subtype - -- declaration. +-- E_Access_Subtype is for an access subtype created by a subtype +-- declaration. - -- In addition, we define the kind E_Allocator_Type to label allocators. - -- This is because special resolution rules apply to this construct. - -- Eventually the constructs are labeled with the access type imposed by - -- the context. Gigi should never see the type E_Allocator. +-- In addition, we define the kind E_Allocator_Type to label allocators. +-- This is because special resolution rules apply to this construct. +-- Eventually the constructs are labeled with the access type imposed by +-- the context. Gigi should never see the type E_Allocator. - -- Similarly, the type E_Access_Attribute_Type is used as the initial kind - -- associated with an access attribute. After resolution a specific access - -- type will be established as determined by the context. +-- Similarly, the type E_Access_Attribute_Type is used as the initial kind +-- associated with an access attribute. After resolution a specific access +-- type will be established as determined by the context. - -- Finally, the type Any_Access is used to label -null- during type - -- resolution. Any_Access is also replaced by the context type after - -- resolution. +-- Finally, the type Any_Access is used to label -null- during type +-- resolution. Any_Access is also replaced by the context type after +-- resolution. - -------------------------------- - -- Classification of Entities -- - -------------------------------- +-------------------------------- +-- Classification of Entities -- +-------------------------------- - -- The classification of program entities which follows is a refinement of - -- the list given in RM 3.1(1). E.g., separate entities denote subtypes of - -- different type classes. Ada 95 entities include class wide types, - -- protected types, subprogram types, generalized access types, generic - -- formal derived types and generic formal packages. - - -- The order chosen for these kinds allows us to classify related entities - -- so that they are contiguous. As a result, they do not appear in the - -- exact same order as their order of first appearance in the LRM (For - -- example, private types are listed before packages). The contiguity - -- allows us to define useful subtypes (see below) such as type entities, - -- overloaded entities, etc. - - -- Each entity (explicitly or implicitly declared) has a kind, which is - -- a value of the following type: +-- The classification of program entities which follows is a refinement of +-- the list given in RM 3.1(1). E.g., separate entities denote subtypes of +-- different type classes. Ada 95 entities include class wide types, +-- protected types, subprogram types, generalized access types, generic +-- formal derived types and generic formal packages. + +-- The order chosen for these kinds allows us to classify related entities +-- so that they are contiguous. As a result, they do not appear in the +-- exact same order as their order of first appearance in the LRM (For +-- example, private types are listed before packages). The contiguity +-- allows us to define useful subtypes (see below) such as type entities, +-- overloaded entities, etc. + +-- Each entity (explicitly or implicitly declared) has a kind, which is +-- a value of the following type: type Entity_Kind is ( diff --git a/gcc/ada/makeusg.adb b/gcc/ada/makeusg.adb index 62cc703..16eb5f9 100644 --- a/gcc/ada/makeusg.adb +++ b/gcc/ada/makeusg.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, 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- -- @@ -86,6 +86,11 @@ begin "invoke compiler with mapping file mapp"); Write_Eol; + -- Line for -d + + Write_Str (" -d Display compilation progress"); + Write_Eol; + -- Line for -D Write_Str (" -D dir Specify dir as the object directory"); diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index bd1398a..35663b3 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.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- -- @@ -5488,7 +5488,6 @@ package body Sem_Eval is procedure Why_Not_Static_List (L : List_Id) is N : Node_Id; - begin if Is_Non_Empty_List (L) then N := First (L); @@ -5503,9 +5502,11 @@ package body Sem_Eval is begin -- If in ACATS mode (debug flag 2), then suppress all these messages, - -- this avoids massive updates to the ACATS base line. + -- this avoids massive updates to the ACATS base line. But if the flag + -- d.z is set, then don't suppress the messages. This is a temporary + -- kludge to aid in doing the necessary updates to the ACATS base line. - if Debug_Flag_2 then + if Debug_Flag_2 and then not Debug_Flag_Dot_Z then return; end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 05e29f7..c8ef01a 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -3444,9 +3444,10 @@ package body Sem_Prag is Indic : Node_Id; Legal : out Boolean) is - Pack_Id : Entity_Id; - Placement : State_Space_Kind; - State_Id : Entity_Id; + Pack_Id : Entity_Id; + Placement : State_Space_Kind; + Parent_Unit : Entity_Id; + State_Id : Entity_Id; begin -- Assume that the pragma/option is illegal @@ -3509,22 +3510,40 @@ package body Sem_Prag is if Is_Child_Unit (Pack_Id) and then Is_Private_Descendant (Pack_Id) then + -- A variable or state abstraction which is part of the + -- visible state of a private child unit (or a public + -- descendant thereof) shall have its Part_Of indicator + -- specified; the Part_Of indicator shall denote a state + -- abstraction declared by either the parent unit of the + -- private unit or by a public descendant of that parent unit. + + -- Find parent unit of nearest private ancestor. + + Parent_Unit := Pack_Id; + while Present (Parent_Unit) loop + exit when Private_Present + (Parent (Unit_Declaration_Node (Parent_Unit))); + Parent_Unit := Scope (Parent_Unit); + end loop; + + Parent_Unit := Scope (Parent_Unit); + if not Is_Child_Or_Sibling (Pack_Id, Scope (State_Id)) then Error_Msg_N ("indicator Part_Of must denote an abstract state of " & "parent unit or descendant (SPARK RM 7.2.6(3))", Indic); - -- If the unit is a public child of a private unit it cannot - -- refine the state of a private parent, only that of a - -- public ancestor or descendant thereof. - - elsif not Private_Present - (Parent (Unit_Declaration_Node (Pack_Id))) - and then Is_Private_Descendant (Scope (State_Id)) + elsif Scope (State_Id) = Parent_Unit + or else (Is_Ancestor_Package (Parent_Unit, Scope (State_Id)) + and then + not Is_Private_Descendant (Scope (State_Id))) then + null; + + else Error_Msg_N ("indicator Part_Of must denote the abstract state of " - & "a public ancestor", State); + & "parent of private ancestor", State); end if; -- Indicator Part_Of is not needed when the related package is not diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 6894a3a..a981960 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -5518,6 +5518,16 @@ package body Sem_Util is while Present (Formal) and then Present (Actual) loop if Actual = N then return; + + -- An actual that is the prefix in a prefixed call may have + -- been rewritten in the call, after the deferred reference + -- was collected. Check if sloc and kinds match. + + elsif Sloc (Actual) = Sloc (N) + and then Nkind (Actual) = Nkind (N) + then + return; + else Actual := Next_Actual (Actual); Formal := Next_Formal (Formal); -- 2.7.4