[Ada] Aspect/pragma Secondary_Stack_Size can evaluate non-literals as zero
authorPatrick Bernardi <bernardi@adacore.com>
Thu, 11 Jan 2018 08:50:43 +0000 (08:50 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Thu, 11 Jan 2018 08:50:43 +0000 (08:50 +0000)
This patch fixes the problem of aspect/pragma Secondary_Stack_Size expressions
with non-literals evaluating as zero in static secondary stacks allocations.
The aspect Secondary_Stack_Size is now converted to a pragma instead of an
attribute as the attribute does not have visibility on the discriminant.
Additionally, the discriminant of the corresponding record type is now
referenced if the pragma expression contains a discriminant.

No simple test available as the problem only impacts programs when
System.Parameters.Sec_Stack_Dynamic = False

2018-01-11  Patrick Bernardi  <bernardi@adacore.com>

gcc/ada/

* exp_ch9.adb (Expand_N_Task_Type_Declaration): Simplified
Secondary_Stack_Size handling as a pragma is now generated for the
corresponding aspect instead of an attribute.  Pragma expression is
relocated instead of evaluated. Discriminant of the corresponding
record type is referenced rather than the type discriminant.
(Create_Secondary_Stack_For_Task, Make_Task_Create_Call): Update
Secondary_Stack_Size rep item checks to only look for the pragma rep.
* sem_ch13.adb (Analyze_One_Aspect): Transform
Aspect_Secondary_Stack_Size into a pragma instead of an attribute
because the attribute does not have visibility on a task type's
discriminants when the type's definition is expanded.
(Analyze_Attribute_Definition_Clause): Remove handling of
Attribute_Secondary_Stack_Size.
* snames.adb-tmpl, snames.ads-tmpl: Remove
Attribute_Secondary_Stack_Size, no longer used.

From-SVN: r256488

gcc/ada/ChangeLog
gcc/ada/exp_ch9.adb
gcc/ada/sem_ch13.adb
gcc/ada/snames.adb-tmpl
gcc/ada/snames.ads-tmpl

index 625f3053a6f30c6d0361dc6de8fb3fdbb6efc1f9..ca74b1c65300148a64896ef139c248df648857d4 100644 (file)
@@ -1,3 +1,21 @@
+2018-01-11  Patrick Bernardi  <bernardi@adacore.com>
+
+       * exp_ch9.adb (Expand_N_Task_Type_Declaration): Simplified
+       Secondary_Stack_Size handling as a pragma is now generated for the
+       corresponding aspect instead of an attribute.  Pragma expression is
+       relocated instead of evaluated. Discriminant of the corresponding
+       record type is referenced rather than the type discriminant.
+       (Create_Secondary_Stack_For_Task, Make_Task_Create_Call): Update
+       Secondary_Stack_Size rep item checks to only look for the pragma rep.
+       * sem_ch13.adb (Analyze_One_Aspect): Transform
+       Aspect_Secondary_Stack_Size into a pragma instead of an attribute
+       because the attribute does not have visibility on a task type's
+       discriminants when the type's definition is expanded.
+       (Analyze_Attribute_Definition_Clause): Remove handling of
+       Attribute_Secondary_Stack_Size.
+       * snames.adb-tmpl, snames.ads-tmpl: Remove
+       Attribute_Secondary_Stack_Size, no longer used.
+
 2018-01-11  Justin Squirek  <squirek@adacore.com>
 
        * sem_ch8.adb: Minor comment fix.
index cd260b267dbae7d8881061ef66e70992a13af5a1..d89b112bf0f9766b1aee5dcf522e0703bd7487be 100644 (file)
@@ -5437,7 +5437,7 @@ package body Exp_Ch9 is
         (Restriction_Active (No_Implicit_Heap_Allocations)
           or else Restriction_Active (No_Implicit_Task_Allocations))
         and then not Restriction_Active (No_Secondary_Stack)
-        and then Has_Rep_Item
+        and then Has_Rep_Pragma
                    (T, Name_Secondary_Stack_Size, Check_Parents => False);
    end Create_Secondary_Stack_For_Task;
 
@@ -11933,7 +11933,7 @@ package body Exp_Ch9 is
                   Set_Analyzed (Task_Size);
 
                else
-                  Task_Size := Relocate_Node (Expr_N);
+                  Task_Size := New_Copy_Tree (Expr_N);
                end if;
             end;
 
@@ -11971,29 +11971,35 @@ package body Exp_Ch9 is
 
       if Create_Secondary_Stack_For_Task (TaskId) then
          declare
-            Ritem     : Node_Id;
-            Size_Expr : Node_Id;
+            Stack_Size : Node_Id;
 
-         begin
-            --  First extract the secondary stack size from the task type's
-            --  representation aspect.
+            Size_Expr : constant Node_Id :=
+                          Expression (First (
+                            Pragma_Argument_Associations (
+                              Get_Rep_Pragma (TaskId,
+                                Name_Secondary_Stack_Size))));
 
-            Ritem :=
-              Get_Rep_Item
-                (TaskId, Name_Secondary_Stack_Size, Check_Parents => False);
+         begin
+            --  The secondary stack is defined inside the corresponding
+            --  record. Therefore if the size of the stack is set by means
+            --  of a discriminant, we must reference the discriminant of the
+            --  corresponding record type.
 
-            --  Get Secondary_Stack_Size expression. Can be a pragma or aspect.
+            if Nkind (Size_Expr) in N_Has_Entity
+              and then Present (Discriminal_Link (Entity (Size_Expr)))
+            then
+               Stack_Size :=
+                 New_Occurrence_Of
+                   (CR_Discriminant (Discriminal_Link (Entity (Size_Expr))),
+                    Loc);
+               Set_Parent   (Stack_Size, Parent (Size_Expr));
+               Set_Etype    (Stack_Size, Etype (Size_Expr));
+               Set_Analyzed (Stack_Size);
 
-            if Nkind (Ritem) = N_Pragma then
-               Size_Expr :=
-                 Expression
-                   (First (Pragma_Argument_Associations (Ritem)));
             else
-               Size_Expr := Expression (Ritem);
+               Stack_Size := New_Copy_Tree (Size_Expr);
             end if;
 
-            pragma Assert (Compile_Time_Known_Value (Size_Expr));
-
             --  Create the secondary stack for the task
 
             Decl_SS :=
@@ -12010,8 +12016,8 @@ package body Exp_Ch9 is
                         Constraint   =>
                           Make_Index_Or_Discriminant_Constraint (Loc,
                             Constraints  => New_List (
-                              Make_Integer_Literal (Loc,
-                                Expr_Value (Size_Expr)))))));
+                              Convert_To (RTE (RE_Size_Type),
+                                Stack_Size))))));
 
             Append_To (Cdecls, Decl_SS);
          end;
@@ -12052,16 +12058,16 @@ package body Exp_Ch9 is
 
              Expression =>
                Convert_To (RTE (RE_Size_Type),
-                 Relocate_Node (
+                 New_Copy_Tree (
                    Expression (First (
                      Pragma_Argument_Associations (
                        Get_Rep_Pragma (TaskId, Name_Storage_Size))))))));
       end if;
 
       --  Add the _Secondary_Stack_Size component if a Secondary_Stack_Size
-      --  rep item is present.
+      --  pragma is present.
 
-      if Has_Rep_Item
+      if Has_Rep_Pragma
            (TaskId, Name_Secondary_Stack_Size, Check_Parents => False)
       then
          Append_To (Cdecls,
@@ -12135,7 +12141,7 @@ package body Exp_Ch9 is
 
              Expression =>
                Convert_To (RTE (RE_Time_Span),
-                 Relocate_Node (
+                 New_Copy_Tree (
                    Expression (First (
                      Pragma_Argument_Associations (
                        Get_Relative_Deadline_Pragma (Taskdef))))))));
@@ -14246,15 +14252,15 @@ package body Exp_Ch9 is
       end if;
 
       --  Secondary_Stack_Size parameter. Set RE_Unspecified_Size unless there
-      --  is a Secondary_Stack_Size rep item, in which case take the value from
-      --  the rep item. If the restriction No_Secondary_Stack is active then a
+      --  is a Secondary_Stack_Size pragma, in which case take the value from
+      --  the pragma. If the restriction No_Secondary_Stack is active then a
       --  size of 0 is passed regardless to prevent the allocation of the
       --  unused stack.
 
       if Restriction_Active (No_Secondary_Stack) then
          Append_To (Args, Make_Integer_Literal (Loc, 0));
 
-      elsif Has_Rep_Item
+      elsif Has_Rep_Pragma
               (Ttyp, Name_Secondary_Stack_Size, Check_Parents => False)
       then
          Append_To (Args,
index dd001971dd12d97d1402cb70be8d3b1b125f1cf5..b26d99f8511d4aa9520ab4f0daac486cb16a2477 100644 (file)
@@ -2210,7 +2210,6 @@ package body Sem_Ch13 is
                   | Aspect_Output
                   | Aspect_Read
                   | Aspect_Scalar_Storage_Order
-                  | Aspect_Secondary_Stack_Size
                   | Aspect_Simple_Storage_Pool
                   | Aspect_Size
                   | Aspect_Small
@@ -3205,6 +3204,27 @@ package body Sem_Ch13 is
                      end;
                   end if;
 
+               --  Secondary_Stack_Size
+
+               --  Aspect Secondary_Stack_Size needs to be converted into a
+               --  pragma for two reasons: the attribute is not analyzed until
+               --  after the expansion of the task type declaration and the
+               --  attribute does not have visibility on the discriminant.
+
+               when Aspect_Secondary_Stack_Size =>
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Loc,
+                         Expression => Relocate_Node (Expr))),
+                     Pragma_Name                  =>
+                       Name_Secondary_Stack_Size);
+
+                  Decorate (Aspect, Aitem);
+                  Insert_Pragma (Aitem);
+                  goto Continue;
+
+               --  Volatile_Function
+
                --  Aspect Volatile_Function is never delayed because it is
                --  equivalent to a source pragma which appears after the
                --  related subprogram.
@@ -5851,46 +5871,6 @@ package body Sem_Ch13 is
                Set_SSO_Set_High_By_Default (Base_Type (U_Ent), False);
             end if;
 
-         --------------------------
-         -- Secondary_Stack_Size --
-         --------------------------
-
-         when Attribute_Secondary_Stack_Size =>
-
-            --  Secondary_Stack_Size attribute definition clause not allowed
-            --  except from aspect specification.
-
-            if From_Aspect_Specification (N) then
-               if not Is_Task_Type (U_Ent) then
-                  Error_Msg_N
-                    ("Secondary Stack Size can only be defined for task", Nam);
-
-               elsif Duplicate_Clause then
-                  null;
-
-               else
-                  Check_Restriction (No_Secondary_Stack, Expr);
-
-                  --  The expression must be analyzed in the special manner
-                  --  described in "Handling of Default and Per-Object
-                  --  Expressions" in sem.ads.
-
-                  --  The visibility to the discriminants must be restored
-
-                  Push_Scope_And_Install_Discriminants (U_Ent);
-                  Preanalyze_Spec_Expression (Expr, Any_Integer);
-                  Uninstall_Discriminants_And_Pop_Scope (U_Ent);
-
-                  if not Is_OK_Static_Expression (Expr) then
-                     Check_Restriction (Static_Storage_Size, Expr);
-                  end if;
-               end if;
-
-            else
-               Error_Msg_N
-                 ("attribute& cannot be set with definition clause", N);
-            end if;
-
          ----------
          -- Size --
          ----------
index 886a13c7d14e9838ce9396cfe2df767ceba04925..f085b84dbcbeb69bea3c698cd1c0a91379611870 100644 (file)
@@ -134,8 +134,6 @@ package body Snames is
          return Attribute_Dispatching_Domain;
       elsif N = Name_Interrupt_Priority then
          return Attribute_Interrupt_Priority;
-      elsif N = Name_Secondary_Stack_Size then
-         return Attribute_Secondary_Stack_Size;
       else
          return Attribute_Id'Val (N - First_Attribute_Name);
       end if;
index e89e3ff9b4db62cbe353f17093a5eb87faf5a701..73d96e67dc0da2dfd71cf628fd64eca252d849d3 100644 (file)
@@ -1706,11 +1706,10 @@ package Snames is
 
       Attribute_CPU,
       Attribute_Dispatching_Domain,
-      Attribute_Interrupt_Priority,
-      Attribute_Secondary_Stack_Size);
+      Attribute_Interrupt_Priority);
 
    subtype Internal_Attribute_Id is Attribute_Id range
-     Attribute_CPU .. Attribute_Secondary_Stack_Size;
+     Attribute_CPU .. Attribute_Interrupt_Priority;
 
    type Attribute_Class_Array is array (Attribute_Id) of Boolean;
    --  Type used to build attribute classification flag arrays