2014-05-21 Robert Dewar <dewar@adacore.com>
+ * einfo.ads: Minor reformatting.
+ * ceinfo.adb: Deal with slight format change of einfo.ads.
+
+2014-05-21 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <celier@adacore.com>
+
+ * makeusg.adb: Add switch -d to usage.
+
+2014-05-21 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <dewar@adacore.com>
+
+ * debug.adb: Document -gnatd.z switch.
+ * sem_eval.adb (Why_Non_Static): Test -gnatd.z switch.
+
+2014-05-21 Robert Dewar <dewar@adacore.com>
+
* einfo.ads (Can_Never_Be_Null): Minor comment update.
* sem_prag.adb (Check_Arg_Is_Task_Dispatching_Policy): Minor
error message change.
-- --
-- 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- --
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;
-- --
-- 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- --
-- 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
-- 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
-- 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
-- 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 (
-- --
-- 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- --
"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");
-- --
-- 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- --
procedure Why_Not_Static_List (L : List_Id) is
N : Node_Id;
-
begin
if Is_Non_Empty_List (L) then
N := First (L);
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;
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
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
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);