[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Wed, 21 May 2014 10:48:37 +0000 (12:48 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 21 May 2014 10:48:37 +0000 (12:48 +0200)
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.

From-SVN: r210689

gcc/ada/ChangeLog
gcc/ada/ceinfo.adb
gcc/ada/debug.adb
gcc/ada/einfo.ads
gcc/ada/makeusg.adb
gcc/ada/sem_eval.adb
gcc/ada/sem_prag.adb
gcc/ada/sem_util.adb

index 31648c7..12038bf 100644 (file)
@@ -1,5 +1,32 @@
 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.
index 3f073b3..9c3b6ea 100644 (file)
@@ -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;
index 11237e2..f2f118b 100644 (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- --
@@ -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
index a007555..998be8b 100644 (file)
@@ -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 (
 
index 62cc703..16eb5f9 100644 (file)
@@ -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");
index bd1398a..35663b3 100644 (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- --
@@ -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;
 
index 05e29f7..c8ef01a 100644 (file)
@@ -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
index 6894a3a..a981960 100644 (file)
@@ -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);