[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 23 Apr 2013 09:50:31 +0000 (11:50 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 23 Apr 2013 09:50:31 +0000 (11:50 +0200)
2013-04-23  Robert Dewar  <dewar@adacore.com>

* sem_ch13.adb (Analyze_Aspect_Specifications): Significant
rewrite to make sure Is_Ignore is properly captured when aspect
is declared.
* sem_ch6.adb: Minor reformatting.
* sem_prag.adb (Analyze_Pragma): Do not test policy at time of
pragma for the case of a pragma coming from an aspect (already
tested when we analyzed the aspect).

2013-04-23  Vincent Celier  <celier@adacore.com>

* prj-conf.adb (Parse_Project_And_Apply_Config): New
Boolean parameter Implicit_Project, defaulted to False. Call
Prj.Part.Parse with Implicit_Project.
* prj-conf.ads (Parse_Project_And_Apply_Config): New Boolean
parameter Implicit_Project, defaulted to False.
* prj-part.adb (Parse_Single_Project): New Boolean parameter
Implicit_Project, defaulted to False. When Implicit_Project is
True, change the Directory of the project node to the Current_Dir.
* prj-part.ads (Parse): New Boolean parameter, defaulted to False

2013-04-23  Robert Dewar  <dewar@adacore.com>

* exp_util.adb: Minor reformatting.

From-SVN: r198184

gcc/ada/ChangeLog
gcc/ada/exp_util.adb
gcc/ada/prj-conf.adb
gcc/ada/prj-conf.ads
gcc/ada/prj-part.adb
gcc/ada/prj-part.ads
gcc/ada/sem_ch13.adb
gcc/ada/sem_ch6.adb
gcc/ada/sem_prag.adb

index c6d114da28b8ec80399753825fd35b5a104ad059..b81550c73383b5d8469d28cab99c8694233d1a98 100644 (file)
@@ -1,3 +1,29 @@
+2013-04-23  Robert Dewar  <dewar@adacore.com>
+
+       * sem_ch13.adb (Analyze_Aspect_Specifications): Significant
+       rewrite to make sure Is_Ignore is properly captured when aspect
+       is declared.
+       * sem_ch6.adb: Minor reformatting.
+       * sem_prag.adb (Analyze_Pragma): Do not test policy at time of
+       pragma for the case of a pragma coming from an aspect (already
+       tested when we analyzed the aspect).
+
+2013-04-23  Vincent Celier  <celier@adacore.com>
+
+       * prj-conf.adb (Parse_Project_And_Apply_Config): New
+       Boolean parameter Implicit_Project, defaulted to False. Call
+       Prj.Part.Parse with Implicit_Project.
+       * prj-conf.ads (Parse_Project_And_Apply_Config): New Boolean
+       parameter Implicit_Project, defaulted to False.
+       * prj-part.adb (Parse_Single_Project): New Boolean parameter
+       Implicit_Project, defaulted to False. When Implicit_Project is
+       True, change the Directory of the project node to the Current_Dir.
+       * prj-part.ads (Parse): New Boolean parameter, defaulted to False
+
+2013-04-23  Robert Dewar  <dewar@adacore.com>
+
+       * exp_util.adb: Minor reformatting.
+
 2013-04-23  Robert Dewar  <dewar@adacore.com>
 
        * xoscons.adb: Minor reformatting.
index c38b02317b439435ceb96f6cab832c4823124a6e..03442ac322e9d8e505bf8915cde88f19551ea988 100644 (file)
@@ -2586,9 +2586,11 @@ package body Exp_Util is
    begin
       Start_String;
       Internal_Full_Qualified_Name (E);
+
       if Append_NUL then
          Store_String_Char (Get_Char_Code (ASCII.NUL));
       end if;
+
       return End_String;
    end Fully_Qualified_Name_String;
 
index 9ba624cdc0d64fa32781b6a2be5e5e3221d76917..48241efbdd0b511ce2be712302d97adb508b2d8c 100644 (file)
@@ -1558,7 +1558,8 @@ package body Prj.Conf is
       Config_File_Path           : out String_Access;
       Target_Name                : String := "";
       Normalized_Hostname        : String;
-      On_Load_Config             : Config_File_Hook := null)
+      On_Load_Config             : Config_File_Hook := null;
+      Implicit_Project           : Boolean := False)
    is
    begin
       pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
@@ -1578,7 +1579,8 @@ package body Prj.Conf is
          Packages_To_Check => Packages_To_Check,
          Current_Directory => Current_Directory,
          Is_Config_File    => False,
-         Env               => Env);
+         Env               => Env,
+         Implicit_Project  => Implicit_Project);
 
       if User_Project_Node = Empty_Node then
          User_Project_Node := Empty_Node;
index 7154e55d23ae6040e38f4c2fc327075c2a5ed8b6..172356f48ec1ddfbe455f5bb233c079c9180e6ac 100644 (file)
@@ -55,7 +55,8 @@ package Prj.Conf is
       Config_File_Path           : out String_Access;
       Target_Name                : String := "";
       Normalized_Hostname        : String;
-      On_Load_Config             : Config_File_Hook := null);
+      On_Load_Config             : Config_File_Hook := null;
+      Implicit_Project           : Boolean := False);
    --  Find the main configuration project and parse the project tree rooted at
    --  this configuration project.
    --
@@ -85,6 +86,11 @@ package Prj.Conf is
    --  Any error in generating or parsing the config file is reported via the
    --  Invalid_Config exception, with an appropriate message. Any error while
    --  parsing the project file results in No_Project.
+   --
+   --  If Implicit_Project is True, the main project file being parsed is
+   --  deemed to be in the current working directory, even if it is not the
+   --  case.
+   --  Why is this ever useful???
 
    procedure Process_Project_And_Apply_Config
      (Main_Project               : out Prj.Project_Id;
index 5d09dbe6010bb820681c3c954fa780eda9b84b64..7f617a0e6dc881a402c1bcd3f6974378c4163718 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2013, 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- --
@@ -191,7 +191,8 @@ package body Prj.Part is
       Depth             : Natural;
       Current_Dir       : String;
       Is_Config_File    : Boolean;
-      Env               : in out Environment);
+      Env               : in out Environment;
+      Implicit_Project  : Boolean := False);
    --  Parse a project file. This is a recursive procedure: it calls itself for
    --  imported and extended projects. When From_Extended is not None, if the
    --  project has already been parsed and is an extended project A, return the
@@ -201,6 +202,10 @@ package body Prj.Part is
    --
    --  Is_Config_File should be set to True if the project represents a config
    --  file (.cgpr) since some specific checks apply.
+   --
+   --  If Implicit_Project is True, change the Directory of the project node
+   --  to be the Current_Dir. Recursive calls to Parse_Single_Project are
+   --  always done with the default False value for Implicit_Project.
 
    procedure Pre_Parse_Context_Clause
      (In_Tree        : Project_Node_Tree_Ref;
@@ -530,7 +535,8 @@ package body Prj.Part is
       Current_Directory : String := "";
       Is_Config_File    : Boolean;
       Env               : in out Prj.Tree.Environment;
-      Target_Name       : String := "")
+      Target_Name       : String := "";
+      Implicit_Project  : Boolean := False)
    is
       Dummy : Boolean;
       pragma Warnings (Off, Dummy);
@@ -598,7 +604,8 @@ package body Prj.Part is
             Depth             => 0,
             Current_Dir       => Current_Directory,
             Is_Config_File    => Is_Config_File,
-            Env               => Env);
+            Env               => Env,
+            Implicit_Project  => Implicit_Project);
 
       exception
          when Types.Unrecoverable_Error =>
@@ -1230,7 +1237,8 @@ package body Prj.Part is
       Depth             : Natural;
       Current_Dir       : String;
       Is_Config_File    : Boolean;
-      Env               : in out Environment)
+      Env               : in out Environment;
+      Implicit_Project  : Boolean := False)
    is
       Path_Name : constant String := Get_Name_String (Path_Name_Id);
 
@@ -1394,7 +1402,10 @@ package body Prj.Part is
       Tree.Reset_State;
       Scan (In_Tree);
 
-      if not Is_Config_File and then Name_From_Path = No_Name then
+      if not Is_Config_File
+        and then Name_From_Path = No_Name
+        and then not Implicit_Project
+      then
 
          --  The project file name is not correct (no or bad extension, or not
          --  following Ada identifier's syntax).
@@ -1977,6 +1988,13 @@ package body Prj.Part is
       Tree.Restore_And_Free (Project_Comment_State);
 
       Debug_Decrease_Indent;
+
+      if Project /= Empty_Node and then Implicit_Project then
+         Name_Len := 0;
+         Add_Str_To_Name_Buffer (Current_Dir);
+         Add_Char_To_Name_Buffer (Dir_Sep);
+         In_Tree.Project_Nodes.Table (Project).Directory := Name_Find;
+      end if;
    end Parse_Single_Project;
 
    -----------------------
index 708142ddb27dfe16a6d9aa599d331e97e073a451..438ec9dda945a868af519c7c85c256eefbc2b89b 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2000-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2013, 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- --
@@ -47,7 +47,8 @@ package Prj.Part is
       Current_Directory : String := "";
       Is_Config_File    : Boolean;
       Env               : in out Prj.Tree.Environment;
-      Target_Name       : String := "");
+      Target_Name       : String := "";
+      Implicit_Project  : Boolean := False);
    --  Parse project file and all its imported project files and create a tree.
    --  Return the node for the project (or Empty_Node if parsing failed). If
    --  Always_Errout_Finalize is True, Errout.Finalize is called in all cases,
@@ -66,5 +67,10 @@ package Prj.Part is
    --  Target_Name will be used to initialize the default project path, unless
    --  In_Tree.Project_Path has already been initialized (which is the
    --  recommended use).
+   --
+   --  If Implicit_Project is True, the main project file being parsed is
+   --  deemed to be in the current working directory, even if it is not the
+   --  case.
+   --  Why is this ever useful???
 
 end Prj.Part;
index b144411e7cd1937cef23670b7cad70698cb79960..24970f1aadf0cbe1ca7100a5bd2feeb14ea2ade8 100644 (file)
@@ -961,7 +961,7 @@ package body Sem_Ch13 is
 
       Aspect := First (L);
       Aspect_Loop : while Present (Aspect) loop
-         declare
+         Analyze_One_Aspect : declare
             Expr : constant Node_Id    := Expression (Aspect);
             Id   : constant Node_Id    := Identifier (Aspect);
             Loc  : constant Source_Ptr := Sloc (Aspect);
@@ -977,12 +977,22 @@ package body Sem_Ch13 is
             --  is set below when Expr is present.
 
             procedure Analyze_Aspect_External_Or_Link_Name;
-            --  This routine performs the analysis of the External_Name or
-            --  Link_Name aspects.
+            --  Perform analysis of the External_Name or Link_Name aspects
 
             procedure Analyze_Aspect_Implicit_Dereference;
-            --  This routine performs the analysis of the Implicit_Dereference
-            --  aspects.
+            --  Perform  analysis of the Implicit_Dereference aspects
+
+            procedure Make_Aitem_Pragma
+              (Pragma_Argument_Associations : List_Id;
+               Pragma_Name                  : Name_Id);
+            --  This is a wrapper for Make_Pragma used for converting aspects
+            --  to pragmas. It takes care of Sloc (set from Loc) and building
+            --  the pragma identifier from the given name. In addition the
+            --  flags Class_Present and Split_PPC are set from the aspect
+            --  node, as well as Is_Ignored. This routine also sets the
+            --  From_Aspect_Specification in the resulting pragma node to
+            --  True, and sets Corresponding_Aspect to point to the aspect.
+            --  The resulting pragma is assigned to Aitem.
 
             ------------------------------------------
             -- Analyze_Aspect_External_Or_Link_Name --
@@ -1051,6 +1061,42 @@ package body Sem_Ch13 is
                end if;
             end Analyze_Aspect_Implicit_Dereference;
 
+            -----------------------
+            -- Make_Aitem_Pragma --
+            -----------------------
+
+            procedure Make_Aitem_Pragma
+              (Pragma_Argument_Associations : List_Id;
+               Pragma_Name                  : Name_Id)
+            is
+            begin
+               --  We should never get here if aspect was disabled
+
+               pragma Assert (not Is_Disabled (Aspect));
+
+               --  Build the pragma
+
+               Aitem :=
+                 Make_Pragma (Loc,
+                   Pragma_Argument_Associations =>
+                     Pragma_Argument_Associations,
+                   Pragma_Identifier =>
+                     Make_Identifier (Sloc (Id), Pragma_Name),
+                     Class_Present     => Class_Present (Aspect),
+                     Split_PPC         => Split_PPC (Aspect));
+
+               --  Set additional semantic fields
+
+               if Is_Ignored (Aspect) then
+                  Set_Is_Ignored (Aitem);
+               end if;
+
+               Set_Corresponding_Aspect (Aitem, Aspect);
+               Set_From_Aspect_Specification (Aitem, True);
+            end Make_Aitem_Pragma;
+
+         --  Start of processing for Analyze_One_Aspect
+
          begin
             --  Skip aspect if already analyzed (not clear if this is needed)
 
@@ -1059,7 +1105,8 @@ package body Sem_Ch13 is
             end if;
 
             --  Skip looking at aspect if it is totally disabled. Just mark
-            --  it as such for later reference in the tree.
+            --  it as such for later reference in the tree. This also sets
+            --  the Is_Ignored flag appropriately.
 
             Check_Applicable_Policy (Aspect);
 
@@ -1218,36 +1265,32 @@ package body Sem_Ch13 is
                --  referring to the entity, and the second argument is the
                --  aspect definition expression.
 
+               --  Suppress/Unsuppress
+
                when Aspect_Suppress   |
                     Aspect_Unsuppress =>
 
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Argument_Associations => New_List (
-                        Make_Pragma_Argument_Association (Loc,
-                          Expression => New_Occurrence_Of (E, Loc)),
-
-                        Make_Pragma_Argument_Association (Sloc (Expr),
-                          Expression => Relocate_Node (Expr))),
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Loc,
+                         Expression => New_Occurrence_Of (E, Loc)),
+                       Make_Pragma_Argument_Association (Sloc (Expr),
+                         Expression => Relocate_Node (Expr))),
+                     Pragma_Name                  => Chars (Id));
 
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Chars (Id)));
+               --  Synchronization
 
-               --  The aspect corresponds to pragma Implemented. Construct the
-               --  pragma.
+               --  Corresponds to pragma Implemented, construct the pragma
 
                when Aspect_Synchronization =>
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Argument_Associations => New_List (
-                        Make_Pragma_Argument_Association (Loc,
-                          Expression => New_Occurrence_Of (E, Loc)),
-
-                        Make_Pragma_Argument_Association (Sloc (Expr),
-                          Expression => Relocate_Node (Expr))),
 
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Name_Implemented));
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Loc,
+                         Expression => New_Occurrence_Of (E, Loc)),
+                       Make_Pragma_Argument_Association (Sloc (Expr),
+                         Expression => Relocate_Node (Expr))),
+                     Pragma_Name                  => Name_Implemented);
 
                   --  No delay is required since the only values are: By_Entry
                   --  | By_Protected_Procedure | By_Any | Optional which don't
@@ -1255,16 +1298,18 @@ package body Sem_Ch13 is
 
                   Delay_Required := False;
 
+               --  Attach Handler
+
                when Aspect_Attach_Handler =>
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Name_Attach_Handler),
-                          Pragma_Argument_Associations => New_List (
-                            Make_Pragma_Argument_Association (Sloc (Ent),
-                              Expression => Ent),
-                            Make_Pragma_Argument_Association (Sloc (Expr),
-                              Expression => Relocate_Node (Expr))));
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Sloc (Ent),
+                         Expression => Ent),
+                       Make_Pragma_Argument_Association (Sloc (Expr),
+                         Expression => Relocate_Node (Expr))),
+                     Pragma_Name                  => Name_Attach_Handler);
+
+               --  Dynamic_Predicate, Predicate, Static_Predicate
 
                when Aspect_Dynamic_Predicate |
                     Aspect_Predicate         |
@@ -1274,16 +1319,13 @@ package body Sem_Ch13 is
                   --  flags recording whether it is static/dynamic). We also
                   --  set flags recording this in the type itself.
 
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Argument_Associations => New_List (
-                         Make_Pragma_Argument_Association (Sloc (Ent),
-                           Expression => Ent),
-                         Make_Pragma_Argument_Association (Sloc (Expr),
-                           Expression => Relocate_Node (Expr))),
-                      Class_Present                => Class_Present (Aspect),
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Name_Predicate));
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Sloc (Ent),
+                         Expression => Ent),
+                       Make_Pragma_Argument_Association (Sloc (Expr),
+                         Expression => Relocate_Node (Expr))),
+                     Pragma_Name                  => Name_Predicate);
 
                   --  Mark type has predicates, and remember what kind of
                   --  aspect lead to this predicate (we need this to access
@@ -1301,9 +1343,7 @@ package body Sem_Ch13 is
                   --  has a freeze node, because that is the one that will be
                   --  visible at freeze time.
 
-                  if Is_Private_Type (E)
-                    and then Present (Full_View (E))
-                  then
+                  if Is_Private_Type (E) and then Present (Full_View (E)) then
                      Set_Has_Predicates (Full_View (E));
 
                      if A_Id = Aspect_Dynamic_Predicate then
@@ -1321,6 +1361,8 @@ package body Sem_Ch13 is
                --  referring to the entity, and the first argument is the
                --  aspect definition expression.
 
+               --  Convention
+
                when Aspect_Convention  =>
 
                   --  The aspect may be part of the specification of an import
@@ -1387,30 +1429,28 @@ package body Sem_Ch13 is
                         Append_To (Arg_List, E_Assoc);
                      end if;
 
-                     Aitem :=
-                       Make_Pragma (Loc,
-                         Pragma_Argument_Associations => Arg_List,
-                         Pragma_Identifier            =>
-                            Make_Identifier (Loc, P_Name));
+                     Make_Aitem_Pragma
+                       (Pragma_Argument_Associations => Arg_List,
+                        Pragma_Name                  => P_Name);
                   end;
 
-               --  The following three aspects can be specified for a
-               --  subprogram body, in which case we generate pragmas for them
-               --  and insert them ahead of local declarations, rather than
-               --  after the body.
+               --  CPU, Interrupt_Priority, Priority
+
+               --  These three aspects can be specified for a subprogram body,
+               --  in which case we generate pragmas for them and insert them
+               --  ahead of local declarations, rather than after the body.
 
                when Aspect_CPU                |
                     Aspect_Interrupt_Priority |
                     Aspect_Priority           =>
 
                   if Nkind (N) = N_Subprogram_Body then
-                     Aitem :=
-                       Make_Pragma (Loc,
-                         Pragma_Argument_Associations => New_List (
-                           Make_Pragma_Argument_Association (Sloc (Expr),
-                             Expression => Relocate_Node (Expr))),
-                         Pragma_Identifier            =>
-                           Make_Identifier (Sloc (Id), Chars (Id)));
+                     Make_Aitem_Pragma
+                       (Pragma_Argument_Associations => New_List (
+                          Make_Pragma_Argument_Association (Sloc (Expr),
+                            Expression => Relocate_Node (Expr))),
+                        Pragma_Name                  => Chars (Id));
+
                   else
                      Aitem :=
                        Make_Attribute_Definition_Clause (Loc,
@@ -1419,17 +1459,17 @@ package body Sem_Ch13 is
                          Expression => Relocate_Node (Expr));
                   end if;
 
+               --  Warnings
+
                when Aspect_Warnings =>
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Argument_Associations => New_List (
-                        Make_Pragma_Argument_Association (Sloc (Expr),
-                          Expression => Relocate_Node (Expr)),
-                        Make_Pragma_Argument_Association (Loc,
-                          Expression => New_Occurrence_Of (E, Loc))),
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Chars (Id)),
-                      Class_Present                => Class_Present (Aspect));
+
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Sloc (Expr),
+                         Expression => Relocate_Node (Expr)),
+                       Make_Pragma_Argument_Association (Loc,
+                         Expression => New_Occurrence_Of (E, Loc))),
+                     Pragma_Name                  => Chars (Id));
 
                   --  We don't have to play the delay game here, since the only
                   --  values are ON/OFF which don't get analyzed anyway.
@@ -1443,6 +1483,8 @@ package body Sem_Ch13 is
                --  entity, a second argument that is the expression and a third
                --  argument that is an appropriate message.
 
+               --  Invariant, Type_Invariant
+
                when Aspect_Invariant      |
                     Aspect_Type_Invariant =>
 
@@ -1450,16 +1492,13 @@ package body Sem_Ch13 is
                   --  an invariant must apply to a private type, or appear in
                   --  the private part of a spec and apply to a completion.
 
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Argument_Associations => New_List (
-                        Make_Pragma_Argument_Association (Sloc (Ent),
-                          Expression => Ent),
-                        Make_Pragma_Argument_Association (Sloc (Expr),
-                          Expression => Relocate_Node (Expr))),
-                      Class_Present                => Class_Present (Aspect),
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Name_Invariant));
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Sloc (Ent),
+                         Expression => Ent),
+                       Make_Pragma_Argument_Association (Sloc (Expr),
+                         Expression => Relocate_Node (Expr))),
+                     Pragma_Name                  => Name_Invariant);
 
                   --  Add message unless exception messages are suppressed
 
@@ -1482,50 +1521,49 @@ package body Sem_Ch13 is
                --  Case 2d : Aspects that correspond to a pragma with one
                --  argument.
 
-               when Aspect_Abstract_State =>
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Name_Abstract_State),
-                      Pragma_Argument_Associations => New_List (
-                        Make_Pragma_Argument_Association (Loc,
-                          Expression => Relocate_Node (Expr))));
+               --  Abstract_State
 
+               when Aspect_Abstract_State =>
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Loc,
+                         Expression => Relocate_Node (Expr))),
+                     Pragma_Name                  => Name_Abstract_State);
                   Delay_Required := False;
 
+               --  Depends
+
                --  Aspect Depends must be delayed because it mentions names
                --  of inputs and output that are classified by aspect Global.
 
                when Aspect_Depends =>
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Name_Depends),
-                      Pragma_Argument_Associations => New_List (
-                        Make_Pragma_Argument_Association (Loc,
-                          Expression => Relocate_Node (Expr))));
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Loc,
+                         Expression => Relocate_Node (Expr))),
+                     Pragma_Name                  => Name_Depends);
+
+               --  Global
 
                --  Aspect Global must be delayed because it can mention names
                --  and benefit from the forward visibility rules applicable to
                --  aspects of subprograms.
 
                when Aspect_Global =>
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Name_Global),
-                      Pragma_Argument_Associations => New_List (
-                        Make_Pragma_Argument_Association (Loc,
-                          Expression => Relocate_Node (Expr))));
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Loc,
+                         Expression => Relocate_Node (Expr))),
+                     Pragma_Name                  => Name_Global);
+
+               --  Relative_Deadline
 
                when Aspect_Relative_Deadline =>
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Argument_Associations => New_List (
-                        Make_Pragma_Argument_Association (Loc,
-                          Expression => Relocate_Node (Expr))),
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Name_Relative_Deadline));
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Loc,
+                         Expression => Relocate_Node (Expr))),
+                      Pragma_Name                 => Name_Relative_Deadline);
 
                   --  If the aspect applies to a task, the corresponding pragma
                   --  must appear within its declarations, not after.
@@ -1562,6 +1600,8 @@ package body Sem_Ch13 is
                --  Case 3a: The aspects listed below don't correspond to
                --  pragmas/attributes but do require delayed analysis.
 
+               --  Default_Value, Default_Component_Value
+
                when Aspect_Default_Value           |
                     Aspect_Default_Component_Value =>
                   Aitem := Empty;
@@ -1569,6 +1609,8 @@ package body Sem_Ch13 is
                --  Case 3b: The aspects listed below don't correspond to
                --  pragmas/attributes and don't need delayed analysis.
 
+               --  Implicit_Dereference
+
                --  For Implicit_Dereference, External_Name and Link_Name, only
                --  the legality checks are done during the analysis, thus no
                --  delay is required.
@@ -1577,15 +1619,21 @@ package body Sem_Ch13 is
                   Analyze_Aspect_Implicit_Dereference;
                   goto Continue;
 
+               --  External_Name, Link_Name
+
                when Aspect_External_Name |
                     Aspect_Link_Name     =>
                   Analyze_Aspect_External_Or_Link_Name;
                   goto Continue;
 
+               --  Dimension
+
                when Aspect_Dimension =>
                   Analyze_Aspect_Dimension (N, Id, Expr);
                   goto Continue;
 
+               --  Dimension_System
+
                when Aspect_Dimension_System =>
                   Analyze_Aspect_Dimension_System (N, Id, Expr);
                   goto Continue;
@@ -1595,6 +1643,8 @@ package body Sem_Ch13 is
                --  Pre/Post/Test_Case/Contract_Cases whose corresponding
                --  pragmas take care of the delay.
 
+               --  Pre/Post
+
                --  Aspects Pre/Post generate Precondition/Postcondition pragmas
                --  with a first argument that is the expression, and a second
                --  argument that is an informative message if the test fails.
@@ -1648,16 +1698,12 @@ package body Sem_Ch13 is
 
                   --  Build the precondition/postcondition pragma
 
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Pname),
-                      Class_Present                => Class_Present (Aspect),
-                      Split_PPC                    => Split_PPC (Aspect),
-                      Pragma_Argument_Associations => New_List (
-                        Make_Pragma_Argument_Association (Eloc,
-                          Chars      => Name_Check,
-                          Expression => Relocate_Node (Expr))));
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Eloc,
+                         Chars      => Name_Check,
+                         Expression => Relocate_Node (Expr))),
+                       Pragma_Name                => Pname);
 
                   --  Add message unless exception messages are suppressed
 
@@ -1726,6 +1772,8 @@ package body Sem_Ch13 is
                   goto Continue;
                end;
 
+               --  Test_Case
+
                when Aspect_Test_Case => Test_Case : declare
                   Args      : List_Id;
                   Comp_Expr : Node_Id;
@@ -1786,15 +1834,15 @@ package body Sem_Ch13 is
 
                   --  Build the test-case pragma
 
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Nam),
-                      Pragma_Argument_Associations => Args);
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => Args,
+                     Pragma_Name                  => Nam);
 
                   Delay_Required := False;
                end Test_Case;
 
+               --  Contract_Cases
+
                when Aspect_Contract_Cases => Contract_Cases : declare
                   Case_Guard  : Node_Id;
                   Extra       : Node_Id;
@@ -1860,13 +1908,11 @@ package body Sem_Ch13 is
 
                   --  Transform the aspect into a pragma
 
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Identifier            =>
-                        Make_Identifier (Loc, Nam),
-                      Pragma_Argument_Associations => New_List (
-                        Make_Pragma_Argument_Association (Loc,
-                          Expression => Relocate_Node (Expr))));
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Loc,
+                         Expression => Relocate_Node (Expr))),
+                     Pragma_Name                  => Nam);
 
                   Delay_Required := False;
                end Contract_Cases;
@@ -1875,8 +1921,10 @@ package body Sem_Ch13 is
                --  boolean argument.
 
                --  In the general case, the corresponding pragma cannot be
-               --  generated yet because the evaluation of the boolean needs to
-               --  be delayed til the freeze point.
+               --  generated yet because the evaluation of the boolean needs
+               --  to be delayed till the freeze point.
+
+               --  Boolwn_Aspects
 
                when Boolean_Aspects      |
                     Library_Unit_Aspects =>
@@ -1954,13 +2002,11 @@ package body Sem_Ch13 is
                   --  simply insert the pragma, no delay is required.
 
                   if No (Expr) then
-                     Aitem :=
-                       Make_Pragma (Loc,
-                         Pragma_Argument_Associations => New_List (
-                           Make_Pragma_Argument_Association (Sloc (Ent),
-                             Expression => Ent)),
-                         Pragma_Identifier            =>
-                           Make_Identifier (Sloc (Id), Chars (Id)));
+                     Make_Aitem_Pragma
+                       (Pragma_Argument_Associations => New_List (
+                          Make_Pragma_Argument_Association (Sloc (Ent),
+                            Expression => Ent)),
+                        Pragma_Name                  => Chars (Id));
 
                      Delay_Required := False;
 
@@ -1979,8 +2025,16 @@ package body Sem_Ch13 is
             if Present (Aitem) then
                Set_From_Aspect_Specification (Aitem, True);
 
+               --  For a pragma, keep pointer to aspect
+
                if Nkind (Aitem) = N_Pragma then
                   Set_Corresponding_Aspect (Aitem, Aspect);
+
+                  --  Also set Is_Ignored flag. No need to set Is_Disabled.
+                  --  We checked that right away, and would not get here.
+
+                  Set_Is_Ignored (Aitem, Is_Ignored (Aspect));
+                  pragma Assert (not Is_Disabled (Aspect));
                end if;
             end if;
 
@@ -2000,9 +2054,9 @@ package body Sem_Ch13 is
                goto Continue;
 
             --  In the context of a compilation unit, we directly put the
-            --  pragma in the Pragmas_After list of the
-            --  N_Compilation_Unit_Aux node (no delay is required here)
-            --  except for aspects on a subprogram body (see below).
+            --  pragma in the Pragmas_After list of the N_Compilation_Unit_Aux
+            --  node (no delay is required here) except for aspects on a
+            --  subprogram body (see below).
 
             elsif Nkind (Parent (N)) = N_Compilation_Unit
               and then (Present (Aitem) or else Is_Boolean_Aspect (Aspect))
@@ -2018,13 +2072,11 @@ package body Sem_Ch13 is
 
                   if Is_Boolean_Aspect (Aspect) and then No (Aitem) then
                      if Is_True (Static_Boolean (Expr)) then
-                        Aitem :=
-                          Make_Pragma (Loc,
-                            Pragma_Argument_Associations => New_List (
-                              Make_Pragma_Argument_Association (Sloc (Ent),
-                                Expression => Ent)),
-                            Pragma_Identifier            =>
-                              Make_Identifier (Sloc (Id), Chars (Id)));
+                        Make_Aitem_Pragma
+                          (Pragma_Argument_Associations => New_List (
+                             Make_Pragma_Argument_Association (Sloc (Ent),
+                               Expression => Ent)),
+                           Pragma_Name                  => Chars (Id));
 
                         Set_From_Aspect_Specification (Aitem, True);
                         Set_Corresponding_Aspect (Aitem, Aspect);
@@ -2097,7 +2149,7 @@ package body Sem_Ch13 is
                Insert_After (Ins_Node, Aitem);
                Ins_Node := Aitem;
             end if;
-         end;
+         end Analyze_One_Aspect;
 
       <<Continue>>
          Next (Aspect);
index 68f1d41703b1248d73115351b728eb3811352803..43f94e11b0e21536520980c3b7c0d5988fea2c5d 100644 (file)
@@ -12082,16 +12082,12 @@ package body Sem_Ch6 is
 
                      declare
                         New_Expr : constant Node_Id :=
-                                     Get_Pragma_Arg
-                                       (Next
-                                         (First
-                                           (Pragma_Argument_Associations
-                                             (Inherited_Precond))));
+                          Get_Pragma_Arg
+                            (Next (First (Pragma_Argument_Associations
+                                            (Inherited_Precond))));
                         Old_Expr : constant Node_Id :=
-                                     Get_Pragma_Arg
-                                       (Next
-                                         (First
-                                           (Pragma_Argument_Associations
+                          Get_Pragma_Arg
+                            (Next (First (Pragma_Argument_Associations
                                              (Precond))));
 
                      begin
@@ -12404,8 +12400,7 @@ package body Sem_Ch6 is
 
          declare
             Post_Proc : constant Entity_Id :=
-                          Make_Defining_Identifier (Loc,
-                            Chars => Name_uPostconditions);
+              Make_Defining_Identifier (Loc, Chars => Name_uPostconditions);
             --  The entity for the _Postconditions procedure
 
          begin
index 373828e491e94f07b3f9827796eea24020e9aa30..bacb34066157b8361fea7ffd328abfdbba9a580a 100644 (file)
@@ -2138,12 +2138,7 @@ package body Sem_Prag is
          --  For a pragma PPC in the extended main source unit, record enabled
          --  status in SCO.
 
-         --  This may seem redundant with the call to Check_Kind test that
-         --  occurs later on when the pragma is rewritten into a pragma Check
-         --  but is actually required in the case of a postcondition within a
-         --  generic.
-
-         if Check_Kind (Pname) = Name_Check and then not Split_PPC (N) then
+         if not Is_Ignored (N) and then not Split_PPC (N) then
             Set_SCO_Pragma_Enabled (Loc);
          end if;
 
@@ -6775,14 +6770,20 @@ package body Sem_Prag is
          Pname := Chars (Identifier (Corresponding_Aspect (N)));
       end if;
 
-      Check_Applicable_Policy (N);
+      --  Check applicable policy. We skip this for a pragma that came from
+      --  an aspect, since we already dealt with the Disable case, and we set
+      --  the Is_Ignored flag at the time the aspect was analyzed.
 
-      --  If pragma is disabled, rewrite as Null statement and skip analysis
+      if not From_Aspect_Specification (N) then
+         Check_Applicable_Policy (N);
 
-      if Is_Disabled (N) then
-         Rewrite (N, Make_Null_Statement (Loc));
-         Analyze (N);
-         raise Pragma_Exit;
+         --  If pragma is disabled, rewrite as NULL and skip analysis
+
+         if Is_Disabled (N) then
+            Rewrite (N, Make_Null_Statement (Loc));
+            Analyze (N);
+            raise Pragma_Exit;
+         end if;
       end if;
 
       --  Preset arguments
@@ -8109,26 +8110,37 @@ package body Sem_Prag is
 
             --  Set Check_On to indicate check status
 
-            case Check_Kind (Cname) is
-               when Name_Ignore =>
-                  Check_On := False;
+            --  If this comes from an aspect, we have already taken care of
+            --  the policy active when the aspect was analyzed, and Is_Ignore
+            --  is set appriately already.
 
-               when Name_Check =>
-                  Check_On := True;
+            if From_Aspect_Specification (N) then
+               Check_On := not Is_Ignored (N);
 
-               --  For disable, rewrite pragma as null statement and skip
-               --  rest of the analysis of the pragma.
+            --  Otherwise check the status right now
 
-               when Name_Disable =>
-                  Rewrite (N, Make_Null_Statement (Loc));
-                  Analyze (N);
-                  raise Pragma_Exit;
+            else
+               case Check_Kind (Cname) is
+                  when Name_Ignore =>
+                     Check_On := False;
 
-               --  No other possibilities
+                  when Name_Check =>
+                     Check_On := True;
 
-               when others =>
-                  raise Program_Error;
-            end case;
+                  --  For disable, rewrite pragma as null statement and skip
+                  --  rest of the analysis of the pragma.
+
+                  when Name_Disable =>
+                     Rewrite (N, Make_Null_Statement (Loc));
+                     Analyze (N);
+                     raise Pragma_Exit;
+
+                     --  No other possibilities
+
+                  when others =>
+                     raise Program_Error;
+               end case;
+            end if;
 
             --  If check kind was not Disable, then continue pragma analysis