sem_ch12.adb, [...]: New calling sequence for Analyze_Aspect_Specifications
authorRobert Dewar <dewar@adacore.com>
Tue, 2 Aug 2011 08:58:37 +0000 (08:58 +0000)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 2 Aug 2011 08:58:37 +0000 (10:58 +0200)
2011-08-02  Robert Dewar  <dewar@adacore.com>

* sem_ch12.adb, sem_ch11.adb: New calling sequence for
Analyze_Aspect_Specifications
* sem_ch13.adb
(Analyze_Aspect_Specifications): New handling for boolean aspects
* sem_ch13.ads (Analyze_Aspect_Specifications): New calling sequence
* sem_ch3.adb, sem_ch6.adb, sem_ch7.adb, sem_ch9.adb: New calling
sequence for Analyze_Aspect_Specifications
* sem_prag.adb (Analyze_Pragma): Remove use of Aspect_Cancel entirely
* sinfo.ads, sinfo.adb (Aspect_Cancel): Remove, no longer used

2011-08-02  Robert Dewar  <dewar@adacore.com>

* freeze.adb (Freeze_Entity): Remove handling of delayed boolean
aspects, since these no longer exist.

2011-08-02  Robert Dewar  <dewar@adacore.com>

* par-ch13.adb (Aspect_Specifications_Present): Always return false on
semicolon, do not try to see if there are aspects following it.
* par-ch3.adb (P_Declarative_Items): Better message for unexpected
aspect spec.

From-SVN: r177095

15 files changed:
gcc/ada/ChangeLog
gcc/ada/freeze.adb
gcc/ada/par-ch13.adb
gcc/ada/par-ch3.adb
gcc/ada/sem_ch11.adb
gcc/ada/sem_ch12.adb
gcc/ada/sem_ch13.adb
gcc/ada/sem_ch13.ads
gcc/ada/sem_ch3.adb
gcc/ada/sem_ch6.adb
gcc/ada/sem_ch7.adb
gcc/ada/sem_ch9.adb
gcc/ada/sem_prag.adb
gcc/ada/sinfo.adb
gcc/ada/sinfo.ads

index 886bad566de3822b67d9867aa28886d728bc7569..02238304889968c81aaafe783619f973ce900fb9 100644 (file)
@@ -1,3 +1,27 @@
+2011-08-02  Robert Dewar  <dewar@adacore.com>
+
+       * sem_ch12.adb, sem_ch11.adb: New calling sequence for
+       Analyze_Aspect_Specifications
+       * sem_ch13.adb
+       (Analyze_Aspect_Specifications): New handling for boolean aspects
+       * sem_ch13.ads (Analyze_Aspect_Specifications): New calling sequence
+       * sem_ch3.adb, sem_ch6.adb, sem_ch7.adb, sem_ch9.adb: New calling
+       sequence for Analyze_Aspect_Specifications
+       * sem_prag.adb (Analyze_Pragma): Remove use of Aspect_Cancel entirely
+       * sinfo.ads, sinfo.adb (Aspect_Cancel): Remove, no longer used
+
+2011-08-02  Robert Dewar  <dewar@adacore.com>
+
+       * freeze.adb (Freeze_Entity): Remove handling of delayed boolean
+       aspects, since these no longer exist.
+
+2011-08-02  Robert Dewar  <dewar@adacore.com>
+
+       * par-ch13.adb (Aspect_Specifications_Present): Always return false on
+       semicolon, do not try to see if there are aspects following it.
+       * par-ch3.adb (P_Declarative_Items): Better message for unexpected
+       aspect spec.
+
 2011-08-02  Robert Dewar  <dewar@adacore.com>
 
        * sem_ch8.adb, aspects.ads: Minor reformatting.
index c84468536de4d6e00f3a16df62f296f514f858a4..98a6571abdfbf607f032c0d20fffa47255eef281 100644 (file)
@@ -2395,10 +2395,6 @@ package body Freeze is
       --  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;
@@ -2415,34 +2411,6 @@ package body Freeze is
                then
                   Aitem := Aspect_Rep_Item (Ritem);
                   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 95da89c19f9b84b5b0b2146d1e15700a6cdc50bf..55dd75fb701af1cd9cd19e452109f3eca4bdd876 100644 (file)
@@ -46,30 +46,18 @@ package body Ch13 is
       Result     : Boolean;
 
    begin
-      Save_Scan_State (Scan_State);
-
-      --  If we have a semicolon, test for semicolon followed by Aspect
-      --  Specifications, in which case we decide the semicolon is accidental.
-
-      if Token = Tok_Semicolon then
-         Scan; -- past semicolon
+      --  Definitely must have WITH to consider aspect specs to be present
 
-         --  The recursive test is set Strict, since we already have one
-         --  error (the unexpected semicolon), so we will ignore that semicolon
-         --  only if we absolutely definitely have an aspect specification
-         --  following it.
+      --  Note that this means that if we have a semicolon, we immediately
+      --  return False. There is a case in which this is not optimal, namely
+      --  something like
 
-         if Aspect_Specifications_Present (Strict => True) then
-            Error_Msg_SP ("|extra "";"" ignored");
-            return True;
+      --    type R is new Integer;
+      --      with bla bla;
 
-         else
-            Restore_Scan_State (Scan_State);
-            return False;
-         end if;
-      end if;
-
-      --  Definitely must have WITH to consider aspect specs to be present
+      --  where the semicolon is redundant, but scanning forward for it would
+      --  be too expensive. Instead we pick up the aspect specifications later
+      --  as a bogus declaration, and diagnose the semicolon at that point.
 
       if Token /= Tok_With then
          return False;
index 4ae03fd213b845e94352583c16391965f99b18cd..89617e61cc14abac07fcf5d940c40e10f7a7076c 100644 (file)
@@ -4274,8 +4274,42 @@ package body Ch3 is
 
          when Tok_With =>
             Check_Bad_Layout;
-            Error_Msg_SC ("WITH can only appear in context clause");
-            raise Error_Resync;
+
+            if Aspect_Specifications_Present then
+
+               --  If we are after a semicolon, complain that it was ignored.
+               --  But we don't really ignore it, since we dump the aspects,
+               --  so we make the error message a normal fatal message which
+               --  will inhibit semantic analysis anyway).
+
+               if Prev_Token = Tok_Semicolon then
+                  Error_Msg_SP -- CODEFIX
+                    ("extra "";"" ignored");
+
+               --  If not just past semicolon, just complain that aspects are
+               --  not allowed at this point.
+
+               else
+                  Error_Msg_SC ("aspect specifications not allowed here");
+               end if;
+
+               declare
+                  Dummy_Node : constant Node_Id :=
+                                 New_Node (N_Package_Specification, Token_Ptr);
+                  pragma Warnings (Off, Dummy_Node);
+                  --  Dummy node to attach aspect specifications to. We will
+                  --  then throw them away.
+
+               begin
+                  P_Aspect_Specifications (Dummy_Node, Semicolon => True);
+               end;
+
+            --  Here if not aspect specifications case
+
+            else
+               Error_Msg_SC ("WITH can only appear in context clause");
+               raise Error_Resync;
+            end if;
 
          --  BEGIN terminates the scan of a sequence of declarations unless
          --  there is a missing subprogram body, see section on handling
index 1b0c182713a906218e6c5834f086590adf332c36..35d55599d7cd8826ce23009b30e99c6cc491a8f0 100644 (file)
@@ -23,7 +23,6 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Einfo;    use Einfo;
@@ -65,7 +64,10 @@ package body Sem_Ch11 is
       Set_Etype                   (Id, Standard_Exception_Type);
       Set_Is_Statically_Allocated (Id);
       Set_Is_Pure                 (Id, PF);
-      Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
    end Analyze_Exception_Declaration;
 
    --------------------------------
index 697ec53441c5041352275503b162ccc0e0c4a224..e688485fb597b3a7345430f18821ef2f909fb9fb 100644 (file)
@@ -1925,7 +1925,9 @@ package body Sem_Ch12 is
          end if;
       end if;
 
-      Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
    end Analyze_Formal_Object_Declaration;
 
    ----------------------------------------------
@@ -2280,8 +2282,10 @@ package body Sem_Ch12 is
       Set_Scope (Pack_Id, Scope (Formal));
       Set_Has_Completion (Pack_Id, True);
 
-      <<Leave>>
-         Analyze_Aspect_Specifications (N, Pack_Id, Aspect_Specifications (N));
+   <<Leave>>
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Pack_Id);
+      end if;
    end Analyze_Formal_Package_Declaration;
 
    ---------------------------------
@@ -2501,8 +2505,11 @@ package body Sem_Ch12 is
          end if;
       end if;
 
-      <<Leave>>
-         Analyze_Aspect_Specifications (N, Nam, Aspect_Specifications (N));
+   <<Leave>>
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Nam);
+      end if;
+
    end Analyze_Formal_Subprogram_Declaration;
 
    -------------------------------------
@@ -2576,7 +2583,10 @@ package body Sem_Ch12 is
       end case;
 
       Set_Is_Generic_Type (T);
-      Analyze_Aspect_Specifications (N, T, Aspect_Specifications (N));
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, T);
+      end if;
    end Analyze_Formal_Type_Declaration;
 
    ------------------------------------
@@ -2754,7 +2764,9 @@ package body Sem_Ch12 is
          end if;
       end if;
 
-      Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
    end Analyze_Generic_Package_Declaration;
 
    --------------------------------------------
@@ -2882,7 +2894,10 @@ package body Sem_Ch12 is
       Generate_Reference_To_Formals (Id);
 
       List_Inherited_Pre_Post_Aspects (Id);
-      Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
    end Analyze_Generic_Subprogram_Declaration;
 
    -----------------------------------
@@ -3556,9 +3571,10 @@ package body Sem_Ch12 is
          Set_Defining_Identifier (N, Act_Decl_Id);
       end if;
 
-      <<Leave>>
-         Analyze_Aspect_Specifications
-           (N, Act_Decl_Id, Aspect_Specifications (N));
+   <<Leave>>
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Act_Decl_Id);
+      end if;
 
    exception
       when Instantiation_Error =>
@@ -4336,9 +4352,10 @@ package body Sem_Ch12 is
          Generic_Renamings_HTable.Reset;
       end if;
 
-      <<Leave>>
-         Analyze_Aspect_Specifications
-           (N, Act_Decl_Id, Aspect_Specifications (N));
+   <<Leave>>
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Act_Decl_Id);
+      end if;
 
    exception
       when Instantiation_Error =>
index ac03bd91ab737feaca0e34cab7abb72bf30f6073..d5d7bfac18bb71882ad3fc44cc204bc0e20c0f88 100644 (file)
@@ -78,16 +78,6 @@ package body Sem_Ch13 is
    --  inherited from a derived type that is no longer appropriate for the
    --  new Esize value. In this case, we reset the Alignment to unknown.
 
-   procedure Analyze_Non_Null_Aspect_Specifications
-     (N : Node_Id;
-      E : Entity_Id;
-      L : List_Id);
-   --  This procedure is called to analyze aspect specifications for node N.
-   --  E is the corresponding entity declared by the declaration node N, and
-   --  L is the list of aspect specifications for this node. This procedure
-   --  does the real work, as opposed to Analyze_Aspect_Specifications which
-   --  is inlined to fast-track the common case.
-
    procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id);
    --  If Typ has predicates (indicated by Has_Predicates being set for Typ,
    --  then either there are pragma Invariant entries on the rep chain for the
@@ -693,34 +683,13 @@ package body Sem_Ch13 is
    -- Analyze_Aspect_Specifications --
    -----------------------------------
 
-   procedure Analyze_Aspect_Specifications
-     (N : Node_Id;
-      E : Entity_Id;
-      L : List_Id)
-   is
-   begin
-      --  Return if no aspects
-
-      if L = No_List then
-         return;
-      end if;
-
-      Analyze_Non_Null_Aspect_Specifications (N, E, L);
-   end Analyze_Aspect_Specifications;
-
-   --------------------------------------------
-   -- Analyze_Non_Null_Aspect_Specifications --
-   --------------------------------------------
-
-   procedure Analyze_Non_Null_Aspect_Specifications
-     (N : Node_Id;
-      E : Entity_Id;
-      L : List_Id)
-   is
+   procedure Analyze_Aspect_Specifications (N : Node_Id; E : Entity_Id) is
       Aspect : Node_Id;
       Aitem  : Node_Id;
       Ent    : Node_Id;
 
+      L : constant List_Id := Aspect_Specifications (N);
+
       Ins_Node : Node_Id := N;
       --  Insert pragmas (except Pre/Post/Invariant/Predicate) after this node
 
@@ -744,10 +713,12 @@ package body Sem_Ch13 is
       --  Set True if delay is required
 
    begin
+      pragma Assert (Present (L));
+
       --  Loop through aspects
 
       Aspect := First (L);
-      while Present (Aspect) loop
+      Aspect_Loop : while Present (Aspect) loop
          declare
             Loc  : constant Source_Ptr := Sloc (Aspect);
             Id   : constant Node_Id    := Identifier (Aspect);
@@ -759,6 +730,72 @@ package body Sem_Ch13 is
             Eloc : Source_Ptr := Sloc (Expr);
             --  Source location of expression, modified when we split PPC's
 
+            procedure Check_False_Aspect_For_Derived_Type;
+            --  This procedure checks for the case of a false aspect for a
+            --  derived type, which improperly tries to cancel an aspect
+            --  inherited from the parent;
+
+            -----------------------------------------
+            -- Check_False_Aspect_For_Derived_Type --
+            -----------------------------------------
+
+            procedure Check_False_Aspect_For_Derived_Type is
+            begin
+               --  We are only checking derived types
+
+               if not Is_Derived_Type (E) then
+                  return;
+               end if;
+
+               case A_Id is
+                  when Aspect_Atomic | Aspect_Shared =>
+                     if not Is_Atomic (E) then
+                        return;
+                     end if;
+
+                  when Aspect_Atomic_Components =>
+                     if not Has_Atomic_Components (E) then
+                        return;
+                     end if;
+
+                  when Aspect_Discard_Names =>
+                     if not Discard_Names (E) then
+                        return;
+                     end if;
+
+                  when Aspect_Pack =>
+                     if not Is_Packed (E) then
+                        return;
+                     end if;
+
+                  when Aspect_Unchecked_Union =>
+                     if not Is_Unchecked_Union (E) then
+                        return;
+                     end if;
+
+                  when Aspect_Volatile =>
+                     if not Is_Volatile (E) then
+                        return;
+                     end if;
+
+                  when Aspect_Volatile_Components =>
+                     if not Has_Volatile_Components (E) then
+                        return;
+                     end if;
+
+                  when others =>
+                     return;
+               end case;
+
+               --  Fall through means we are canceling an inherited aspect
+
+               Error_Msg_Name_1 := Nam;
+               Error_Msg_NE
+                 ("derived type& inherits aspect%, cannot cancel", Expr, E);
+            end Check_False_Aspect_For_Derived_Type;
+
+         --  Start of processing for Aspect_Loop
+
          begin
             --  Skip aspect if already analyzed (not clear if this is needed)
 
@@ -837,14 +874,23 @@ 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. When
-               --  the aspect is processed to insert the pragma, the expression
-               --  is analyzed, setting Cancel_Aspect if the value is False.
+               --  these we just create a matching pragma and insert it, if
+               --  the expression is missing or set to True. If the expression
+               --  is False, we can ignore the aspect with the exception that
+               --  in the case of a derived type, we must check for an illegal
+               --  attempt to cancel an inherited aspect.
 
                when Boolean_Aspects =>
                   Set_Is_Boolean_Aspect (Aspect);
 
-                  --  Build corresponding pragma node
+                  if Present (Expr)
+                    and then Is_False (Static_Boolean (Expr))
+                  then
+                     Check_False_Aspect_For_Derived_Type;
+                     goto Continue;
+                  end if;
+
+                  --  If True, build corresponding pragma node
 
                   Aitem :=
                     Make_Pragma (Loc,
@@ -852,24 +898,13 @@ package body Sem_Ch13 is
                       Pragma_Identifier            =>
                         Make_Identifier (Sloc (Id), Chars (Id)));
 
-                  --  No delay required if no expression (nothing to delay!)
-
-                  if No (Expr) then
-                     Delay_Required := False;
-
-                  --  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!
+                  --  Never need to delay for boolean aspects
 
-                  else
-                     Delay_Required := True;
-                     Set_Is_Delayed_Aspect (Aspect);
-                  end if;
+                  Delay_Required := False;
 
                --  Library unit aspects. These are boolean aspects, but we
-               --  always evaluate the expression right away if it is present
-               --  and just ignore the aspect if the expression is False. We
-               --  never delay expression evaluation in this case.
+               --  have to do special things with the insertion, since the
+               --  pragma belongs inside the declarations of a package.
 
                when Library_Unit_Aspects =>
                   if Present (Expr)
@@ -1220,8 +1255,8 @@ package body Sem_Ch13 is
 
          <<Continue>>
             Next (Aspect);
-      end loop;
-   end Analyze_Non_Null_Aspect_Specifications;
+      end loop Aspect_Loop;
+   end Analyze_Aspect_Specifications;
 
    -----------------------
    -- Analyze_At_Clause --
index a2726fd44ac78d06be2a2eda5f09beed3fcc89df..742b88dc7d83bd6fa55ee2cd02ca07cf8def75e9 100644 (file)
@@ -36,17 +36,10 @@ package Sem_Ch13 is
    procedure Analyze_Record_Representation_Clause       (N : Node_Id);
    procedure Analyze_Code_Statement                     (N : Node_Id);
 
-   procedure Analyze_Aspect_Specifications
-     (N : Node_Id;
-      E : Entity_Id;
-      L : List_Id);
-   --  This procedure is called to analyze aspect specifications for node N.
-   --  E is the corresponding entity declared by the declaration node N, and
-   --  L is the list of aspect specifications for this node. If L is No_List,
-   --  the call is ignored. Note that we can't use a simpler interface of just
-   --  passing the node N, since the analysis of the node may cause it to be
-   --  rewritten to a node not permitting aspect specifications.
-   pragma Inline (Analyze_Aspect_Specifications);
+   procedure Analyze_Aspect_Specifications (N : Node_Id; E : Entity_Id);
+   --  This procedure is called to analyze aspect specifications for node N. E
+   --  is the corresponding entity declared by the declaration node N. Callers
+   --  should check that Has_Aspects (N) is True before calling this routine.
 
    procedure Adjust_Record_For_Reverse_Bit_Order (R : Entity_Id);
    --  Called from Freeze where R is a record entity for which reverse bit
index 04919c004bde64c550625aae0ba0927d0c75f7c8..ec1ff216080269d5ff48b5cb4e7d08315759ca8e 100644 (file)
@@ -23,7 +23,6 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Debug;    use Debug;
@@ -2016,7 +2015,10 @@ package body Sem_Ch3 is
       end if;
 
       Set_Original_Record_Component (Id, Id);
-      Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
    end Analyze_Component_Declaration;
 
    --------------------------
@@ -2491,7 +2493,9 @@ package body Sem_Ch3 is
       Set_Optimize_Alignment_Flags (Def_Id);
       Check_Eliminated (Def_Id);
 
-      Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Def_Id);
+      end if;
    end Analyze_Full_Type_Declaration;
 
    ----------------------------------
@@ -3704,7 +3708,9 @@ package body Sem_Ch3 is
       end if;
 
    <<Leave>>
-      Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
    end Analyze_Object_Declaration;
 
    ---------------------------
@@ -3943,8 +3949,10 @@ package body Sem_Ch3 is
          end if;
       end if;
 
-      <<Leave>>
-         Analyze_Aspect_Specifications (N, T, Aspect_Specifications (N));
+   <<Leave>>
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, T);
+      end if;
    end Analyze_Private_Extension_Declaration;
 
    ---------------------------------
@@ -4413,7 +4421,9 @@ package body Sem_Ch3 is
       Check_Eliminated (Id);
 
    <<Leave>>
-      Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
    end Analyze_Subtype_Declaration;
 
    --------------------------------
index 61ce6f60f403bee180ab8407921f473e193811e6..8d0edcc2128749f7de11214a79324a7fad597a7c 100644 (file)
@@ -23,7 +23,6 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Debug;    use Debug;
@@ -263,7 +262,10 @@ package body Sem_Ch6 is
 
       Generate_Reference_To_Formals (Designator);
       Check_Eliminated (Designator);
-      Analyze_Aspect_Specifications (N, Designator, Aspect_Specifications (N));
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Designator);
+      end if;
    end Analyze_Abstract_Subprogram_Declaration;
 
    ---------------------------------
@@ -3067,7 +3069,10 @@ package body Sem_Ch6 is
       end if;
 
       List_Inherited_Pre_Post_Aspects (Designator);
-      Analyze_Aspect_Specifications (N, Designator, Aspect_Specifications (N));
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Designator);
+      end if;
    end Analyze_Subprogram_Declaration;
 
    --------------------------------------
index 255edbe1b947cafae916a9d91e2ae74fdd70d95f..b36c60069a565bdcebf6331f4bf71e1bc3427265 100644 (file)
@@ -28,7 +28,6 @@
 --  handling of private and full declarations, and the construction of dispatch
 --  tables for tagged types.
 
-with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
@@ -763,7 +762,9 @@ package body Sem_Ch7 is
       --  Analye aspect specifications immediately, since we need to recognize
       --  things like Pure early enough to diagnose violations during analysis.
 
-      Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
 
       --  Ada 2005 (AI-217): Check if the package has been erroneously named
       --  in a limited-with clause of its own context. In this case the error
@@ -1405,7 +1406,10 @@ package body Sem_Ch7 is
 
       New_Private_Type (N, Id, N);
       Set_Depends_On_Private (Id);
-      Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
    end Analyze_Private_Type_Declaration;
 
    ----------------------------------
index 9d1a84d4fbd1c1aa6735f9627c511c8c413ab487..280c0e91fcb66120bfeeae25cfd2ce6979b8ec36 100644 (file)
@@ -976,7 +976,10 @@ package body Sem_Ch9 is
       end if;
 
       Generate_Reference_To_Formals (Def_Id);
-      Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Def_Id);
+      end if;
    end Analyze_Entry_Declaration;
 
    ---------------------------------------
@@ -1336,8 +1339,10 @@ package body Sem_Ch9 is
          end if;
       end if;
 
-      <<Leave>>
-         Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
+   <<Leave>>
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Def_Id);
+      end if;
    end Analyze_Protected_Type_Declaration;
 
    ---------------------
@@ -1806,7 +1811,10 @@ package body Sem_Ch9 is
       --  disastrous result.
 
       Analyze_Protected_Type_Declaration (N);
-      Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
    end Analyze_Single_Protected_Declaration;
 
    -------------------------------------
@@ -1873,7 +1881,10 @@ package body Sem_Ch9 is
       --  disastrous result.
 
       Analyze_Task_Type_Declaration (N);
-      Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
    end Analyze_Single_Task_Declaration;
 
    -----------------------
@@ -2152,7 +2163,9 @@ package body Sem_Ch9 is
          end if;
       end if;
 
-      Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Def_Id);
+      end if;
    end Analyze_Task_Type_Declaration;
 
    -----------------------------------
index c42f8bbd9998e70f98b85d79e83b317fce9a07e6..9b68124181ffe938c4fd971650ee48dfb7802d93 100644 (file)
@@ -270,13 +270,6 @@ package body Sem_Prag is
       Pname   : constant Name_Id    := Pragma_Name (N);
       Prag_Id : Pragma_Id;
 
-      Sense : constant Boolean := not Aspect_Cancel (N);
-      --  Sense is True if we have the normal case of a pragma that is active
-      --  and turns the corresponding aspect on. It is false only for the case
-      --  of a pragma coming from an aspect which is explicitly turned off by
-      --  using aspect => False. If Sense is False, the effect of the pragma
-      --  is to turn the corresponding aspect off.
-
       Pragma_Exit : exception;
       --  This exception is used to exit pragma processing completely. It is
       --  used when an error is detected, and no further processing is
@@ -2461,9 +2454,9 @@ package body Sem_Prag is
 
          procedure Set_Atomic (E : Entity_Id) is
          begin
-            Set_Is_Atomic (E, Sense);
+            Set_Is_Atomic (E);
 
-            if Sense and then not Has_Alignment_Clause (E) then
+            if not Has_Alignment_Clause (E) then
                Set_Alignment (E, Uint_0);
             end if;
          end Set_Atomic;
@@ -2510,11 +2503,11 @@ package body Sem_Prag is
             --  Attribute belongs on the base type. If the view of the type is
             --  currently private, it also belongs on the underlying type.
 
-            Set_Is_Volatile (Base_Type (E), Sense);
-            Set_Is_Volatile (Underlying_Type (E), Sense);
+            Set_Is_Volatile (Base_Type (E));
+            Set_Is_Volatile (Underlying_Type (E));
 
-            Set_Treat_As_Volatile (E, Sense);
-            Set_Treat_As_Volatile (Underlying_Type (E), Sense);
+            Set_Treat_As_Volatile (E);
+            Set_Treat_As_Volatile (Underlying_Type (E));
 
          elsif K = N_Object_Declaration
            or else (K = N_Component_Declaration
@@ -2525,7 +2518,7 @@ package body Sem_Prag is
             end if;
 
             if Prag_Id /= Pragma_Volatile then
-               Set_Is_Atomic (E, Sense);
+               Set_Is_Atomic (E);
 
                --  If the object declaration has an explicit initialization, a
                --  temporary may have to be created to hold the expression, to
@@ -2533,7 +2526,6 @@ package body Sem_Prag is
 
                if Nkind (Parent (E)) = N_Object_Declaration
                  and then Present (Expression (Parent (E)))
-                 and then Sense
                then
                   Set_Has_Delayed_Freeze (E);
                end if;
@@ -2554,7 +2546,7 @@ package body Sem_Prag is
                    Get_Source_File_Index (Sloc (E)) =
                    Get_Source_File_Index (Sloc (Underlying_Type (Etype (E))))
                then
-                  Set_Is_Atomic (Underlying_Type (Etype (E)), Sense);
+                  Set_Is_Atomic (Underlying_Type (Etype (E)));
                end if;
             end if;
 
@@ -4155,7 +4147,10 @@ package body Sem_Prag is
          Subp_Id   : Node_Id;
          Subp      : Entity_Id;
          Applies   : Boolean;
+
          Effective : Boolean := False;
+         --  Set True if inline has some effect, i.e. if there is at least one
+         --  subprogram set as inlined as a result of the use of the pragma.
 
          procedure Make_Inline (Subp : Entity_Id);
          --  Subp is the defining unit name of the subprogram declaration. Set
@@ -4299,11 +4294,6 @@ package body Sem_Prag is
             --  entity (if declared in the same unit) is inlined.
 
             if Is_Subprogram (Subp) then
-
-               if not Sense then
-                  return;
-               end if;
-
                Inner_Subp := Ultimate_Alias (Inner_Subp);
 
                if In_Same_Source_Unit (Subp, Inner_Subp) then
@@ -4364,16 +4354,16 @@ package body Sem_Prag is
          procedure Set_Inline_Flags (Subp : Entity_Id) is
          begin
             if Active then
-               Set_Is_Inlined (Subp, Sense);
+               Set_Is_Inlined (Subp);
             end if;
 
             if not Has_Pragma_Inline (Subp) then
-               Set_Has_Pragma_Inline (Subp, Sense);
+               Set_Has_Pragma_Inline (Subp);
                Effective := True;
             end if;
 
             if Prag_Id = Pragma_Inline_Always then
-               Set_Has_Pragma_Inline_Always (Subp, Sense);
+               Set_Has_Pragma_Inline_Always (Subp);
             end if;
          end Set_Inline_Flags;
 
@@ -5846,12 +5836,7 @@ package body Sem_Prag is
 
                --  Now set appropriate Ada mode
 
-               if Sense then
-                  Ada_Version := Ada_2005;
-               else
-                  Ada_Version := Ada_Version_Default;
-               end if;
-
+               Ada_Version          := Ada_2005;
                Ada_Version_Explicit := Ada_2005;
             end if;
          end;
@@ -5899,12 +5884,7 @@ package body Sem_Prag is
 
                --  Now set appropriate Ada mode
 
-               if Sense then
-                  Ada_Version := Ada_2012;
-               else
-                  Ada_Version := Ada_Version_Default;
-               end if;
-
+               Ada_Version          := Ada_2012;
                Ada_Version_Explicit := Ada_2012;
             end if;
          end;
@@ -6378,10 +6358,10 @@ package body Sem_Prag is
                   E := Base_Type (E);
                end if;
 
-               Set_Has_Volatile_Components (E, Sense);
+               Set_Has_Volatile_Components (E);
 
                if Prag_Id = Pragma_Atomic_Components then
-                  Set_Has_Atomic_Components (E, Sense);
+                  Set_Has_Atomic_Components (E);
                end if;
 
             else
@@ -7398,7 +7378,7 @@ package body Sem_Prag is
                   --  defined in the current declarative part, and recursively
                   --  to any nested scope.
 
-                  Set_Discard_Names (Current_Scope, Sense);
+                  Set_Discard_Names (Current_Scope);
                   return;
 
                else
@@ -7419,7 +7399,7 @@ package body Sem_Prag is
                         (Is_Enumeration_Type (E) or else Is_Tagged_Type (E)))
                     or else Ekind (E) = E_Exception
                   then
-                     Set_Discard_Names (E, Sense);
+                     Set_Discard_Names (E);
                   else
                      Error_Pragma_Arg
                        ("inappropriate entity for pragma%", Arg1);
@@ -8256,9 +8236,7 @@ package body Sem_Prag is
             --  subtype), set the flag on that type.
 
             if Is_Access_Subprogram_Type (Named_Entity) then
-               if Sense then
-                  Set_Can_Use_Internal_Rep (Named_Entity, False);
-               end if;
+               Set_Can_Use_Internal_Rep (Named_Entity, False);
 
             --  Otherwise it's an error (name denotes the wrong sort of entity)
 
@@ -10928,43 +10906,11 @@ package body Sem_Prag is
 
                   else
                      if not Ignore then
-                        Set_Is_Packed            (Base_Type (Typ), Sense);
-                        Set_Has_Non_Standard_Rep (Base_Type (Typ), Sense);
+                        Set_Is_Packed            (Base_Type (Typ));
+                        Set_Has_Non_Standard_Rep (Base_Type (Typ));
                      end if;
 
-                     Set_Has_Pragma_Pack (Base_Type (Typ), Sense);
-
-                     --  Complete reset action for Aspect_Cancel case
-
-                     if Sense = False then
-
-                        --  Cancel size unless explicitly set
-
-                        if not Has_Size_Clause (Typ)
-                           and then not Has_Object_Size_Clause (Typ)
-                        then
-                           Set_Esize     (Typ, Uint_0);
-                           Set_RM_Size   (Typ, Uint_0);
-                           Set_Alignment (Typ, Uint_0);
-                           Set_Packed_Array_Type (Typ, Empty);
-                        end if;
-
-                        --  Reset component size unless explicitly set
-
-                        if not Has_Component_Size_Clause (Typ) then
-                           if Known_Static_Esize (Ctyp)
-                             and then Known_Static_RM_Size (Ctyp)
-                             and then Esize (Ctyp) = RM_Size (Ctyp)
-                             and then Addressable (Esize (Ctyp))
-                           then
-                              Set_Component_Size
-                                (Base_Type (Typ), Esize (Ctyp));
-                           else
-                              Set_Component_Size
-                                (Base_Type (Typ), Uint_0);
-                           end if;
-                        end if;
-                     end if;
+                     Set_Has_Pragma_Pack (Base_Type (Typ));
                   end if;
                end if;
 
@@ -10985,23 +10931,9 @@ package body Sem_Prag is
                   --  Normal case of pack request active
 
                   else
-                     Set_Is_Packed            (Base_Type (Typ), Sense);
-                     Set_Has_Pragma_Pack      (Base_Type (Typ), Sense);
-                     Set_Has_Non_Standard_Rep (Base_Type (Typ), Sense);
-
-                     --  Complete reset action for Aspect_Cancel case
-
-                     if Sense = False then
-
-                        --  Cancel size if not explicitly given
-
-                        if not Has_Size_Clause (Typ)
-                          and then not Has_Object_Size_Clause (Typ)
-                        then
-                           Set_Esize     (Typ, Uint_0);
-                           Set_Alignment (Typ, Uint_0);
-                        end if;
-                     end if;
+                     Set_Is_Packed            (Base_Type (Typ));
+                     Set_Has_Pragma_Pack      (Base_Type (Typ));
+                     Set_Has_Non_Standard_Rep (Base_Type (Typ));
                   end if;
                end if;
             end if;
@@ -11145,13 +11077,11 @@ package body Sem_Prag is
 
                Check_Duplicate_Pragma (Ent);
 
-               if Sense then
-                  Prag :=
-                    Make_Linker_Section_Pragma
-                      (Ent, Sloc (N), ".persistent.bss");
-                  Insert_After (N, Prag);
-                  Analyze (Prag);
-               end if;
+               Prag :=
+                 Make_Linker_Section_Pragma
+                   (Ent, Sloc (N), ".persistent.bss");
+               Insert_After (N, Prag);
+               Analyze (Prag);
 
             --  Case of use as configuration pragma with no arguments
 
@@ -11310,11 +11240,11 @@ package body Sem_Prag is
 
             if Present (Ent)
               and then not (Pk = N_Package_Specification
-                              and then Present (Generic_Parent (Pa)))
+                             and then Present (Generic_Parent (Pa)))
             then
                if not Debug_Flag_U then
-                  Set_Is_Preelaborated (Ent, Sense);
-                  Set_Suppress_Elaboration_Warnings (Ent, Sense);
+                  Set_Is_Preelaborated (Ent);
+                  Set_Suppress_Elaboration_Warnings (Ent);
                end if;
             end if;
          end Preelaborate;
@@ -11897,11 +11827,11 @@ package body Sem_Prag is
                        ("pragma% requires a function name", Arg1);
                   end if;
 
-                  Set_Is_Pure (Def_Id, Sense);
+                  Set_Is_Pure (Def_Id);
 
                   if not Has_Pragma_Pure_Function (Def_Id) then
-                     Set_Has_Pragma_Pure_Function (Def_Id, Sense);
-                     Effective := Sense;
+                     Set_Has_Pragma_Pure_Function (Def_Id);
+                     Effective := True;
                   end if;
 
                   exit when From_Aspect_Specification (N);
@@ -11909,7 +11839,7 @@ package body Sem_Prag is
                   exit when No (E) or else Scope (E) /= Current_Scope;
                end loop;
 
-               if Sense and then not Effective
+               if not Effective
                  and then Warn_On_Redundant_Constructs
                then
                   Error_Msg_NE
@@ -12685,7 +12615,7 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_Optional_Identifier (Arg1, Name_Entity);
             Check_Arg_Is_Local_Name (Arg1);
-            Set_Debug_Info_Off (Entity (Get_Pragma_Arg (Arg1)), Sense);
+            Set_Debug_Info_Off (Entity (Get_Pragma_Arg (Arg1)));
 
          ----------------------------------
          -- Suppress_Exception_Locations --
@@ -13129,14 +13059,10 @@ package body Sem_Prag is
                end loop;
             end if;
 
-            Set_Is_Unchecked_Union  (Typ, Sense);
-
-            if Sense then
-               Set_Convention (Typ, Convention_C);
-            end if;
-
-            Set_Has_Unchecked_Union (Base_Type (Typ), Sense);
-            Set_Is_Unchecked_Union  (Base_Type (Typ), Sense);
+            Set_Is_Unchecked_Union  (Typ);
+            Set_Convention (Typ, Convention_C);
+            Set_Has_Unchecked_Union (Base_Type (Typ));
+            Set_Is_Unchecked_Union  (Base_Type (Typ));
          end Unchecked_Union;
 
          ------------------------
@@ -13195,7 +13121,7 @@ package body Sem_Prag is
                Error_Pragma_Arg ("pragma% requires type", Arg1);
             end if;
 
-            Set_Universal_Aliasing (Implementation_Base_Type (E_Id), Sense);
+            Set_Universal_Aliasing (Implementation_Base_Type (E_Id));
          end Universal_Alias;
 
          --------------------
@@ -13263,7 +13189,7 @@ package body Sem_Prag is
                        ("pragma% can only be applied to a variable",
                         Arg_Expr);
                   else
-                     Set_Has_Pragma_Unmodified (Arg_Ent, Sense);
+                     Set_Has_Pragma_Unmodified (Arg_Ent);
                   end if;
                end if;
 
@@ -13358,7 +13284,7 @@ package body Sem_Prag is
                         Generate_Reference (Arg_Ent, N);
                      end if;
 
-                     Set_Has_Pragma_Unreferenced (Arg_Ent, Sense);
+                     Set_Has_Pragma_Unreferenced (Arg_Ent);
                   end if;
 
                   Next (Arg_Node);
@@ -13393,7 +13319,7 @@ package body Sem_Prag is
                     ("argument for pragma% must be type or subtype", Arg_Node);
                end if;
 
-               Set_Has_Pragma_Unreferenced_Objects (Entity (Arg_Expr), Sense);
+               Set_Has_Pragma_Unreferenced_Objects (Entity (Arg_Expr));
                Next (Arg_Node);
             end loop;
          end Unreferenced_Objects;
index 9ac9424063c01c8c8564ce03595dc5e18d1e7dfa..571541af26e33ab371710b30678f307dc4de8bca 100644 (file)
@@ -256,14 +256,6 @@ package body Sinfo is
       return Node3 (N);
    end Array_Aggregate;
 
-   function Aspect_Cancel
-      (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Pragma);
-      return Flag11 (N);
-   end Aspect_Cancel;
-
    function Aspect_Rep_Item
       (N : Node_Id) return Node_Id is
    begin
@@ -3317,14 +3309,6 @@ package body Sinfo is
       Set_Node3_With_Parent (N, Val);
    end Set_Array_Aggregate;
 
-   procedure Set_Aspect_Cancel
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Pragma);
-      Set_Flag11 (N, Val);
-   end Set_Aspect_Cancel;
-
    procedure Set_Aspect_Rep_Item
       (N : Node_Id; Val : Node_Id) is
    begin
index 8d1b51ef6b5cd23fc4bf350dc4e38fcb9fba3bc2..cdf71bc51cafa958ed2736f172fe36e3f5723c99 100644 (file)
@@ -584,14 +584,6 @@ package Sinfo is
    --    is used for translation of the at end handler into a normal exception
    --    handler.
 
-   --  Aspect_Cancel (Flag11-Sem)
-   --    Processing of aspect specifications typically generates pragmas and
-   --    attribute definition clauses that are inserted into the tree after
-   --    the declaration node to get the desired aspect effect. In the case
-   --    of Boolean aspects that use "=> False" to cancel the effect of an
-   --    aspect (i.e. turn if off), the generated pragma has the Aspect_Cancel
-   --    flag set to indicate that the pragma operates in the opposite sense.
-
    --  Aspect_Rep_Item (Node2-Sem)
    --    Present in N_Aspect_Specification nodes. Points to the corresponding
    --    pragma/attribute definition node used to process the aspect.
@@ -2085,7 +2077,6 @@ package Sinfo is
       --  From_Aspect_Specification (Flag13-Sem)
       --  Is_Delayed_Aspect (Flag14-Sem)
       --  Import_Interface_Present (Flag16-Sem)
-      --  Aspect_Cancel (Flag11-Sem)
       --  Split_PPC (Flag17) set if corresponding aspect had Split_PPC set
       --  Class_Present (Flag6) set if from Aspect with 'Class
       --  From_Dynamic_Predicate (Flag7-Sem) Set if Dynamic_Predicate aspect
@@ -8076,9 +8067,6 @@ package Sinfo is
    function Array_Aggregate
      (N : Node_Id) return Node_Id;    -- Node3
 
-   function Aspect_Cancel
-     (N : Node_Id) return Boolean;    -- Flag11
-
    function Aspect_Rep_Item
      (N : Node_Id) return Node_Id;    -- Node2
 
@@ -9054,9 +9042,6 @@ package Sinfo is
    procedure Set_Array_Aggregate
      (N : Node_Id; Val : Node_Id);            -- Node3
 
-   procedure Set_Aspect_Cancel
-     (N : Node_Id; Val : Boolean := True);    -- Flag11
-
    procedure Set_Aspect_Rep_Item
      (N : Node_Id; Val : Node_Id);            -- Node2
 
@@ -11709,7 +11694,6 @@ package Sinfo is
    pragma Inline (Alternatives);
    pragma Inline (Ancestor_Part);
    pragma Inline (Array_Aggregate);
-   pragma Inline (Aspect_Cancel);
    pragma Inline (Aspect_Rep_Item);
    pragma Inline (Assignment_OK);
    pragma Inline (Associated_Node);
@@ -12032,7 +12016,6 @@ package Sinfo is
    pragma Inline (Set_Alternatives);
    pragma Inline (Set_Ancestor_Part);
    pragma Inline (Set_Array_Aggregate);
-   pragma Inline (Set_Aspect_Cancel);
    pragma Inline (Set_Aspect_Rep_Item);
    pragma Inline (Set_Assignment_OK);
    pragma Inline (Set_Associated_Node);