[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Mon, 1 Aug 2011 09:25:46 +0000 (11:25 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Mon, 1 Aug 2011 09:25:46 +0000 (11:25 +0200)
2011-08-01  Robert Dewar  <dewar@adacore.com>

* aspects.ads (Boolean_Aspects): New subtype.
* exp_ch13.adb (Expand_Freeze_Entity): Fix errors in handling aspects
for derived types in cases where the parent type and derived type have
aspects.
* freeze.adb (Freeze_Entity): Fix problems in handling derived type
with aspects when parent type also has aspects.
(Freeze_Entity): Deal with delay of boolean aspects (must evaluate
boolean expression at this point).
* sem_ch13.adb (Analyze_Aspect_Specifications): Delay all aspects in
accordance with final decision on the Ada 2012 feature.
* sinfo.ads, sinfo.adb (Is_Boolean_Aspect): New flag.

2011-08-01  Matthew Heaney  <heaney@adacore.com>

* a-chtgbo.adb (Delete_Node_Sans_Free): Replace iterator with selector.

From-SVN: r177005

gcc/ada/ChangeLog
gcc/ada/a-chtgbo.adb
gcc/ada/aspects.ads
gcc/ada/exp_ch13.adb
gcc/ada/freeze.adb
gcc/ada/sem_ch13.adb
gcc/ada/sinfo.adb
gcc/ada/sinfo.ads

index 12ba03bd7717532ad7d577e2d1765361a2942b22..3d054405b6ca0189d4d75f93cbf01dfe90688473 100644 (file)
@@ -1,3 +1,21 @@
+2011-08-01  Robert Dewar  <dewar@adacore.com>
+
+       * aspects.ads (Boolean_Aspects): New subtype.
+       * exp_ch13.adb (Expand_Freeze_Entity): Fix errors in handling aspects
+       for derived types in cases where the parent type and derived type have
+       aspects.
+       * freeze.adb (Freeze_Entity): Fix problems in handling derived type
+       with aspects when parent type also has aspects.
+       (Freeze_Entity): Deal with delay of boolean aspects (must evaluate
+       boolean expression at this point).
+       * sem_ch13.adb (Analyze_Aspect_Specifications): Delay all aspects in
+       accordance with final decision on the Ada 2012 feature.
+       * sinfo.ads, sinfo.adb (Is_Boolean_Aspect): New flag.
+
+2011-08-01  Matthew Heaney  <heaney@adacore.com>
+
+       * a-chtgbo.adb (Delete_Node_Sans_Free): Replace iterator with selector.
+
 2011-08-01  Pascal Obry  <obry@adacore.com>
 
        * a-stzunb-shared.adb, a-strunb-shared.adb, a-stwiun-shared.adb:
index 700ca2ebd510490a45255f1aff9acb32b1adb592..b19668e1391ccce724210456da14163b2118523d 100644 (file)
@@ -78,7 +78,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is
       end if;
 
       if Prev = X then
-         HT.Buckets (Indx) := Next (HT, Prev);
+         HT.Buckets (Indx) := Next (HT.Nodes (Prev));
          HT.Length := HT.Length - 1;
          return;
       end if;
@@ -89,7 +89,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is
       end if;
 
       loop
-         Curr := Next (HT, Prev);
+         Curr := Next (HT.Nodes (Prev));
 
          if Curr = 0 then
             raise Program_Error with
@@ -97,7 +97,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is
          end if;
 
          if Curr = X then
-            Set_Next (HT.Nodes (Prev), Next => Next (HT, Curr));
+            Set_Next (HT.Nodes (Prev), Next => Next (HT.Nodes (Curr)));
             HT.Length := HT.Length - 1;
             return;
          end if;
index 9f44197dd42c3402168989a54804e683b399cd73..6dabef3dfcc6d2d9942b39994721ce01d7f73b5f 100755 (executable)
@@ -43,51 +43,56 @@ package Aspects is
 
    type Aspect_Id is
      (No_Aspect,                            -- Dummy entry for no aspect
-      Aspect_Ada_2005,                      -- GNAT
-      Aspect_Ada_2012,                      -- GNAT
       Aspect_Address,
       Aspect_Alignment,
-      Aspect_Atomic,
-      Aspect_Atomic_Components,
       Aspect_Bit_Order,
       Aspect_Component_Size,
-      Aspect_Discard_Names,
       Aspect_External_Tag,
-      Aspect_Favor_Top_Level,               -- GNAT
-      Aspect_Inline,
-      Aspect_Inline_Always,                 -- GNAT
       Aspect_Input,
       Aspect_Invariant,
       Aspect_Machine_Radix,
-      Aspect_No_Return,
       Aspect_Object_Size,                   -- GNAT
       Aspect_Output,
-      Aspect_Pack,
-      Aspect_Persistent_BSS,                -- GNAT
       Aspect_Post,
       Aspect_Pre,
-      Aspect_Predicate,                     -- GNAT???
-      Aspect_Preelaborable_Initialization,
-      Aspect_Pure_Function,                 -- GNAT
+      Aspect_Predicate,
       Aspect_Read,
-      Aspect_Shared,                        -- GNAT (equivalent to Atomic)
       Aspect_Size,
       Aspect_Storage_Pool,
       Aspect_Storage_Size,
       Aspect_Stream_Size,
       Aspect_Suppress,
+      Aspect_Unsuppress,
+      Aspect_Value_Size,                    -- GNAT
+      Aspect_Warnings,
+      Aspect_Write,
+
+      --  Remaining aspects have a static boolean value that turns the aspect
+      --  on or off. They all correspond to pragmas, and the flag Aspect_Cancel
+      --  is set on the pragma if the corresponding aspect is False.
+
+      Aspect_Ada_2005,                      -- GNAT
+      Aspect_Ada_2012,                      -- GNAT
+      Aspect_Atomic,
+      Aspect_Atomic_Components,
+      Aspect_Discard_Names,
+      Aspect_Favor_Top_Level,               -- GNAT
+      Aspect_Inline,
+      Aspect_Inline_Always,                 -- GNAT
+      Aspect_No_Return,
+      Aspect_Pack,
+      Aspect_Persistent_BSS,                -- GNAT
+      Aspect_Preelaborable_Initialization,
+      Aspect_Pure_Function,                 -- GNAT
+      Aspect_Shared,                        -- GNAT (equivalent to Atomic)
       Aspect_Suppress_Debug_Info,           -- GNAT
       Aspect_Unchecked_Union,
       Aspect_Universal_Aliasing,            -- GNAT
       Aspect_Unmodified,                    -- GNAT
       Aspect_Unreferenced,                  -- GNAT
       Aspect_Unreferenced_Objects,          -- GNAT
-      Aspect_Unsuppress,
-      Aspect_Value_Size,                    -- GNAT
       Aspect_Volatile,
-      Aspect_Volatile_Components,
-      Aspect_Warnings,
-      Aspect_Write);                        -- GNAT
+      Aspect_Volatile_Components);
 
    --  The following array indicates aspects that accept 'Class
 
@@ -98,6 +103,16 @@ package Aspects is
                         Aspect_Post          => True,
                         others               => False);
 
+   --  The following subtype defines aspects accepting an optional static
+   --  boolean parameter indicating if the aspect should be active or
+   --  cancelling. If the parameter is missing the effective value is True,
+   --  enabling the aspect. If the parameter is present it must be a static
+   --  expression of type Standard.Boolean. If the value is True, then the
+   --  aspect is enabled. If it is False, the aspect is disabled.
+
+   subtype Boolean_Aspects is
+     Aspect_Id range Aspect_Ada_2005 .. Aspect_Id'Last;
+
    --  The following type is used for indicating allowed expression forms
 
    type Aspect_Expression is
@@ -109,51 +124,30 @@ package Aspects is
 
    Aspect_Argument : constant array (Aspect_Id) of Aspect_Expression :=
                        (No_Aspect                           => Optional,
-                        Aspect_Ada_2005                     => Optional,
-                        Aspect_Ada_2012                     => Optional,
                         Aspect_Address                      => Expression,
                         Aspect_Alignment                    => Expression,
-                        Aspect_Atomic                       => Optional,
-                        Aspect_Atomic_Components            => Optional,
                         Aspect_Bit_Order                    => Expression,
                         Aspect_Component_Size               => Expression,
-                        Aspect_Discard_Names                => Optional,
                         Aspect_External_Tag                 => Expression,
-                        Aspect_Favor_Top_Level              => Optional,
-                        Aspect_Inline                       => Optional,
-                        Aspect_Inline_Always                => Optional,
                         Aspect_Input                        => Name,
                         Aspect_Invariant                    => Expression,
                         Aspect_Machine_Radix                => Expression,
-                        Aspect_No_Return                    => Optional,
                         Aspect_Object_Size                  => Expression,
                         Aspect_Output                       => Name,
-                        Aspect_Persistent_BSS               => Optional,
-                        Aspect_Pack                         => Optional,
                         Aspect_Post                         => Expression,
                         Aspect_Pre                          => Expression,
                         Aspect_Predicate                    => Expression,
-                        Aspect_Preelaborable_Initialization => Optional,
-                        Aspect_Pure_Function                => Optional,
                         Aspect_Read                         => Name,
-                        Aspect_Shared                       => Optional,
                         Aspect_Size                         => Expression,
                         Aspect_Storage_Pool                 => Name,
                         Aspect_Storage_Size                 => Expression,
                         Aspect_Stream_Size                  => Expression,
                         Aspect_Suppress                     => Name,
-                        Aspect_Suppress_Debug_Info          => Optional,
-                        Aspect_Unchecked_Union              => Optional,
-                        Aspect_Universal_Aliasing           => Optional,
-                        Aspect_Unmodified                   => Optional,
-                        Aspect_Unreferenced                 => Optional,
-                        Aspect_Unreferenced_Objects         => Optional,
                         Aspect_Unsuppress                   => Name,
                         Aspect_Value_Size                   => Expression,
-                        Aspect_Volatile                     => Optional,
-                        Aspect_Volatile_Components          => Optional,
                         Aspect_Warnings                     => Name,
-                        Aspect_Write                        => Name);
+                        Aspect_Write                        => Name,
+                        Boolean_Aspects                     => Optional);
 
    function Get_Aspect_Id (Name : Name_Id) return Aspect_Id;
    pragma Inline (Get_Aspect_Id);
index f3de66c6a12b7c467e71ba588604b251f0079756..47e39c4f38bf66f9b7a5c7ee47db3ddd5739a710 100644 (file)
@@ -232,9 +232,13 @@ package body Exp_Ch13 is
             Ritem : Node_Id;
 
          begin
+            --  Look for aspect specs for this entity
+
             Ritem := First_Rep_Item (E);
             while Present (Ritem) loop
-               if Nkind (Ritem) = N_Aspect_Specification then
+               if Nkind (Ritem) = N_Aspect_Specification
+                 and then Entity (Ritem) = E
+               then
                   Aitem := Aspect_Rep_Item (Ritem);
                   pragma Assert (Is_Delayed_Aspect (Aitem));
                   Insert_Before (N, Aitem);
@@ -288,7 +292,7 @@ package body Exp_Ch13 is
 
       if Ekind (E_Scope) = E_Protected_Type
         or else (Ekind (E_Scope) = E_Task_Type
-                   and then not Has_Completion (E_Scope))
+                  and then not Has_Completion (E_Scope))
       then
          E_Scope := Scope (E_Scope);
 
index 9ef3a55a508e3ade6390edfbd35e67ab4dd9b61a..545175f8ffd57f89614748d01ce6b33c3199cec8 100644 (file)
@@ -2370,24 +2370,58 @@ package body Freeze is
          end;
       end if;
 
-      --  Deal with delayed aspect specifications. At the point of occurrence
-      --  of the aspect definition, we preanalyzed the argument, to capture
-      --  the visibility at that point, but the actual analysis of the aspect
+      --  Deal with delayed aspect specifications. The analysis of the aspect
       --  is required to be delayed to the freeze point, so we evaluate the
       --  pragma or attribute definition clause in the tree at this point.
 
+      --  We also have to deal with the case of Boolean aspects, where the
+      --  value of the Boolean expression is represented by the setting of
+      --  the Aspect_Cancel flag on the pragma.
+
       if Has_Delayed_Aspects (E) then
          declare
             Ritem : Node_Id;
             Aitem : Node_Id;
 
          begin
+            --  Look for aspect specification entries for this entity
+
             Ritem := First_Rep_Item (E);
             while Present (Ritem) loop
-               if Nkind (Ritem) = N_Aspect_Specification then
+               if Nkind (Ritem) = N_Aspect_Specification
+                 and then Entity (Ritem) = E
+               then
                   Aitem := Aspect_Rep_Item (Ritem);
                   pragma Assert (Is_Delayed_Aspect (Aitem));
                   Set_Parent (Aitem, Ritem);
+
+                  --  Deal with Boolean case, if no expression, True, otherwise
+                  --  analyze the expression, check it is static, and if its
+                  --  value is False, set Aspect_Cancel for the related pragma.
+
+                  if Is_Boolean_Aspect (Ritem) then
+                     declare
+                        Expr : constant Node_Id := Expression (Ritem);
+
+                     begin
+                        if Present (Expr) then
+                           Analyze_And_Resolve (Expr, Standard_Boolean);
+
+                           if not Is_OK_Static_Expression (Expr) then
+                              Error_Msg_Name_1 := Chars (Identifier (Ritem));
+                              Error_Msg_N
+                                ("expression for % aspect must be static",
+                                 Expr);
+
+                           elsif Is_False (Expr_Value (Expr)) then
+                              Set_Aspect_Cancel (Aitem);
+                           end if;
+                        end if;
+                     end;
+                  end if;
+
+                  --  Analyze the pragma after possibly setting Aspect_Cancel
+
                   Analyze (Aitem);
                end if;
 
index 128b398bf7b1cf66be45c698f3f0ed45c430cf7e..dc4b03dcc982ec4309ef2ed94769f0e734bea8f5 100644 (file)
@@ -740,7 +740,6 @@ package body Sem_Ch13 is
             Nam  : constant Name_Id    := Chars (Id);
             A_Id : constant Aspect_Id  := Get_Aspect_Id (Nam);
             Anod : Node_Id;
-            T    : Entity_Id;
 
             Eloc : Source_Ptr := Sloc (Expr);
             --  Source location of expression, modified when we split PPC's
@@ -811,31 +810,12 @@ package body Sem_Ch13 is
                   raise Program_Error;
 
                --  Aspects taking an optional boolean argument. For all of
-               --  these we just create a matching pragma and insert it,
-               --  setting flag Cancel_Aspect if the expression is False.
-
-               when Aspect_Ada_2005                     |
-                    Aspect_Ada_2012                     |
-                    Aspect_Atomic                       |
-                    Aspect_Atomic_Components            |
-                    Aspect_Discard_Names                |
-                    Aspect_Favor_Top_Level              |
-                    Aspect_Inline                       |
-                    Aspect_Inline_Always                |
-                    Aspect_No_Return                    |
-                    Aspect_Pack                         |
-                    Aspect_Persistent_BSS               |
-                    Aspect_Preelaborable_Initialization |
-                    Aspect_Pure_Function                |
-                    Aspect_Shared                       |
-                    Aspect_Suppress_Debug_Info          |
-                    Aspect_Unchecked_Union              |
-                    Aspect_Universal_Aliasing           |
-                    Aspect_Unmodified                   |
-                    Aspect_Unreferenced                 |
-                    Aspect_Unreferenced_Objects         |
-                    Aspect_Volatile                     |
-                    Aspect_Volatile_Components          =>
+               --  these we just create a matching pragma and insert it. When
+               --  the aspect is processed to insert the pragma, the expression
+               --  is analyzed, setting Cancel_Aspect if the value is False.
+
+               when Boolean_Aspects =>
+                  Set_Is_Boolean_Aspect (Aspect);
 
                   --  Build corresponding pragma node
 
@@ -845,32 +825,17 @@ package body Sem_Ch13 is
                       Pragma_Identifier            =>
                         Make_Identifier (Sloc (Id), Chars (Id)));
 
-                  --  Deal with missing expression case, delay never needed
+                  --  No delay required if no expression (nothing to delay!)
 
                   if No (Expr) then
                      Delay_Required := False;
 
-                  --  Expression is present
+                  --  Expression is present, delay is required. Note that
+                  --  even if the expression is "True", some idiot might
+                  --  define True as False before the freeze point!
 
                   else
-                     Preanalyze_Spec_Expression (Expr, Standard_Boolean);
-
-                     --  If preanalysis gives a static expression, we don't
-                     --  need to delay (this will happen often in practice).
-
-                     if Is_OK_Static_Expression (Expr) then
-                        Delay_Required := False;
-
-                        if Is_False (Expr_Value (Expr)) then
-                           Set_Aspect_Cancel (Aitem);
-                        end if;
-
-                     --  If we don't get a static expression, then delay, the
-                     --  expression may turn out static by freeze time.
-
-                     else
-                        Delay_Required := True;
-                     end if;
+                     Delay_Required := True;
                   end if;
 
                --  Aspects corresponding to attribute definition clauses
@@ -880,30 +845,17 @@ package body Sem_Ch13 is
                     Aspect_Bit_Order      |
                     Aspect_Component_Size |
                     Aspect_External_Tag   |
+                    Aspect_Input          |
                     Aspect_Machine_Radix  |
                     Aspect_Object_Size    |
+                    Aspect_Output         |
+                    Aspect_Read           |
                     Aspect_Size           |
                     Aspect_Storage_Pool   |
                     Aspect_Storage_Size   |
                     Aspect_Stream_Size    |
-                    Aspect_Value_Size     =>
-
-                  --  Preanalyze the expression with the appropriate type
-
-                  case A_Id is
-                     when Aspect_Address      =>
-                        T := RTE (RE_Address);
-                     when Aspect_Bit_Order    =>
-                        T := RTE (RE_Bit_Order);
-                     when Aspect_External_Tag =>
-                        T := Standard_String;
-                     when Aspect_Storage_Pool =>
-                        T := Class_Wide_Type (RTE (RE_Root_Storage_Pool));
-                     when others              =>
-                        T := Any_Integer;
-                  end case;
-
-                  Preanalyze_Spec_Expression (Expr, T);
+                    Aspect_Value_Size     |
+                    Aspect_Write          =>
 
                   --  Construct the attribute definition clause
 
@@ -913,16 +865,9 @@ package body Sem_Ch13 is
                       Chars      => Chars (Id),
                       Expression => Relocate_Node (Expr));
 
-                  --  We do not need a delay if we have a static expression
-
-                  if Is_OK_Static_Expression (Expression (Aitem)) then
-                     Delay_Required := False;
-
                   --  Here a delay is required
 
-                  else
-                     Delay_Required := True;
-                  end if;
+                  Delay_Required := True;
 
                --  Aspects corresponding to pragmas with two arguments, where
                --  the first argument is a local name referring to the entity,
@@ -946,27 +891,6 @@ package body Sem_Ch13 is
 
                   Delay_Required := False;
 
-               --  Aspects corresponding to stream routines
-
-               when Aspect_Input  |
-                    Aspect_Output |
-                    Aspect_Read   |
-                    Aspect_Write  =>
-
-                  --  Construct the attribute definition clause
-
-                  Aitem :=
-                    Make_Attribute_Definition_Clause (Loc,
-                      Name       => Ent,
-                      Chars      => Chars (Id),
-                      Expression => Relocate_Node (Expr));
-
-                  --  These are always delayed (typically the subprogram that
-                  --  is referenced cannot have been declared yet, since it has
-                  --  a reference to the type for which this aspect is defined.
-
-                  Delay_Required := True;
-
                --  Aspects corresponding to pragmas with two arguments, where
                --  the second argument is a local name referring to the entity,
                --  and the first argument is the aspect definition expression.
@@ -985,7 +909,7 @@ package body Sem_Ch13 is
                       Class_Present                => Class_Present (Aspect));
 
                   --  We don't have to play the delay game here, since the only
-                  --  values are check names which don't get analyzed anyway.
+                  --  values are ON/OFF which don't get analyzed anyway.
 
                   Delay_Required := False;
 
@@ -1015,7 +939,7 @@ package body Sem_Ch13 is
                   --  these conditions together in a complex OR expression
 
                   if Pname = Name_Postcondition
-                       or else not Class_Present (Aspect)
+                    or else not Class_Present (Aspect)
                   then
                      while Nkind (Expr) = N_And_Then loop
                         Insert_After (Aspect,
index 64d06083292bfb2239be5a69c5d2f2a772b5f7c7..5729924cceb022cb6cfd8f0cee8766f54d844aae 100644 (file)
@@ -1696,6 +1696,14 @@ package body Sinfo is
       return Flag7 (N);
    end Is_Asynchronous_Call_Block;
 
+   function Is_Boolean_Aspect
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Aspect_Specification);
+      return Flag16 (N);
+   end Is_Boolean_Aspect;
+
    function Is_Component_Left_Opnd
       (N : Node_Id) return Boolean is
    begin
@@ -4716,6 +4724,14 @@ package body Sinfo is
       Set_Flag7 (N, Val);
    end Set_Is_Asynchronous_Call_Block;
 
+   procedure Set_Is_Boolean_Aspect
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Aspect_Specification);
+      Set_Flag16 (N, Val);
+   end Set_Is_Boolean_Aspect;
+
    procedure Set_Is_Component_Left_Opnd
       (N : Node_Id; Val : Boolean := True) is
    begin
index 8a6690360f270fe59782ef758328515fcef03aa1..e582d7bac08a9719a2b1029808b00142435ec40d 100644 (file)
@@ -1252,6 +1252,10 @@ package Sinfo is
    --    expansion of an asynchronous entry call. Such a block needs cleanup
    --    handler to assure that the call is cancelled.
 
+   --  Is_Boolean_Aspect (Flag16-Sem)
+   --    Present in N_Aspect_Specification node. Set if the aspect is for a
+   --    boolean aspect (i.e. Aspect_Id is in Boolean_Aspect subtype).
+
    --  Is_Component_Left_Opnd  (Flag13-Sem)
    --  Is_Component_Right_Opnd (Flag14-Sem)
    --    Present in concatenation nodes, to indicate that the corresponding
@@ -6543,6 +6547,7 @@ package Sinfo is
       --  Class_Present (Flag6) Set if 'Class present
       --  Next_Rep_Item (Node5-Sem)
       --  Split_PPC (Flag17) Set if split pre/post attribute
+      --  Is_Boolean_Aspect (Flag16-Sem)
 
       --  Note: Aspect_Specification is an Ada 2012 feature
 
@@ -8487,6 +8492,9 @@ package Sinfo is
    function Is_Asynchronous_Call_Block
      (N : Node_Id) return Boolean;    -- Flag7
 
+   function Is_Boolean_Aspect
+     (N : Node_Id) return Boolean;    -- Flag16
+
    function Is_Component_Left_Opnd
      (N : Node_Id) return Boolean;    -- Flag13
 
@@ -9450,6 +9458,9 @@ package Sinfo is
    procedure Set_Is_Asynchronous_Call_Block
      (N : Node_Id; Val : Boolean := True);    -- Flag7
 
+   procedure Set_Is_Boolean_Aspect
+     (N : Node_Id; Val : Boolean := True);    -- Flag16
+
    procedure Set_Is_Component_Left_Opnd
      (N : Node_Id; Val : Boolean := True);    -- Flag13
 
@@ -11793,6 +11804,7 @@ package Sinfo is
    pragma Inline (Iterator_Specification);
    pragma Inline (Is_Accessibility_Actual);
    pragma Inline (Is_Asynchronous_Call_Block);
+   pragma Inline (Is_Boolean_Aspect);
    pragma Inline (Is_Component_Left_Opnd);
    pragma Inline (Is_Component_Right_Opnd);
    pragma Inline (Is_Controlling_Actual);
@@ -12110,6 +12122,7 @@ package Sinfo is
    pragma Inline (Set_Iterator_Specification);
    pragma Inline (Set_Is_Accessibility_Actual);
    pragma Inline (Set_Is_Asynchronous_Call_Block);
+   pragma Inline (Set_Is_Boolean_Aspect);
    pragma Inline (Set_Is_Component_Left_Opnd);
    pragma Inline (Set_Is_Component_Right_Opnd);
    pragma Inline (Set_Is_Controlling_Actual);