[gcc(refs/users/guojiufu/heads/personal-branch)] [Ada] Ada2020: AI12-0055 No_Dynamic_CPU_Assignment restriction

Jiu Fu Guo guojiufu@gcc.gnu.org
Mon Aug 10 07:06:29 GMT 2020


https://gcc.gnu.org/g:f7a8be8a1919661122a8ac87c595e1267a1ee3d5

commit f7a8be8a1919661122a8ac87c595e1267a1ee3d5
Author: Bob Duff <duff@adacore.com>
Date:   Tue Jun 9 10:53:23 2020 -0400

    [Ada] Ada2020: AI12-0055 No_Dynamic_CPU_Assignment restriction
    
    gcc/ada/
    
            * libgnat/s-rident.ads (No_Dynamic_CPU_Assignment): New
            restriction. Add it to all relevant profiles.
            * sem_ch13.adb (Attribute_CPU): Check No_Dynamic_CPU_Assignment
            restriction.
            (Attribute_CPU, Attribute_Dispatching_Domain,
            Attribute_Interrupt_Priority): Remove error checks -- these are
            checked in the parser.
            * sem_prag.adb (Pragma_CPU): Check No_Dynamic_CPU_Assignment
            restriction.  We've got a little violation of DRY here.
            * sem.ads, sem_ch3.ads: Minor comment fix.

Diff:
---
 gcc/ada/libgnat/s-rident.ads |  15 +++--
 gcc/ada/sem.ads              |   2 +-
 gcc/ada/sem_ch13.adb         | 130 +++++++++++++++++++------------------------
 gcc/ada/sem_ch3.ads          |   2 +-
 gcc/ada/sem_prag.adb         |   7 ++-
 5 files changed, 74 insertions(+), 82 deletions(-)

diff --git a/gcc/ada/libgnat/s-rident.ads b/gcc/ada/libgnat/s-rident.ads
index b7969fb96b4..8572016abbe 100644
--- a/gcc/ada/libgnat/s-rident.ads
+++ b/gcc/ada/libgnat/s-rident.ads
@@ -62,10 +62,10 @@
 --  then the binder could fail to recognize the R (restrictions line) in the
 --  ali file, leading to bind errors when restrictions were added or removed.
 
---  The latest implementation avoids both this problem by using a named
---  scheme for recording restrictions, rather than a positional scheme which
---  fails completely if restrictions are added or subtracted. Now the worst
---  that happens at bind time in inconsistent builds is that unrecognized
+--  The latest implementation avoids this problem by using a named scheme
+--  for recording restrictions, rather than a positional scheme that fails
+--  completely if restrictions are added or subtracted. Now the worst that
+--  happens at bind time in inconsistent builds is that unrecognized
 --  restrictions are ignored, and the consistency checking for restrictions
 --  might be incomplete, which is no big deal.
 
@@ -104,6 +104,7 @@ package System.Rident is
       No_Dispatch,                               -- (RM H.4(19))
       No_Dispatching_Calls,                      -- GNAT
       No_Dynamic_Attachment,                     -- Ada 2012 (RM E.7(10/3))
+      No_Dynamic_CPU_Assignment,                 -- Ada 202x (RM D.7(10/3))
       No_Dynamic_Priorities,                     -- (RM D.9(9))
       No_Enumeration_Maps,                       -- GNAT
       No_Entry_Calls_In_Elaboration_Code,        -- GNAT
@@ -438,6 +439,7 @@ package System.Rident is
                           (No_Abort_Statements             => True,
                            No_Asynchronous_Control         => True,
                            No_Dynamic_Attachment           => True,
+                           No_Dynamic_CPU_Assignment       => True,
                            No_Dynamic_Priorities           => True,
                            No_Local_Protected_Objects      => True,
                            No_Protected_Type_Allocators    => True,
@@ -469,6 +471,7 @@ package System.Rident is
                           (No_Abort_Statements             => True,
                            No_Asynchronous_Control         => True,
                            No_Dynamic_Attachment           => True,
+                           No_Dynamic_CPU_Assignment       => True,
                            No_Dynamic_Priorities           => True,
                            No_Entry_Queue                  => True,
                            No_Local_Protected_Objects      => True,
@@ -511,6 +514,7 @@ package System.Rident is
                           (No_Abort_Statements             => True,
                            No_Asynchronous_Control         => True,
                            No_Dynamic_Attachment           => True,
+                           No_Dynamic_CPU_Assignment       => True,
                            No_Dynamic_Priorities           => True,
                            No_Entry_Queue                  => True,
                            No_Local_Protected_Objects      => True,
@@ -578,6 +582,7 @@ package System.Rident is
                           (No_Abort_Statements             => True,
                            No_Asynchronous_Control         => True,
                            No_Dynamic_Attachment           => True,
+                           No_Dynamic_CPU_Assignment       => True,
                            No_Dynamic_Priorities           => True,
                            No_Local_Protected_Objects      => True,
                            No_Protected_Type_Allocators    => True,
@@ -616,6 +621,7 @@ package System.Rident is
                           (No_Abort_Statements             => True,
                            No_Asynchronous_Control         => True,
                            No_Dynamic_Attachment           => True,
+                           No_Dynamic_CPU_Assignment       => True,
                            No_Dynamic_Priorities           => True,
                            No_Local_Protected_Objects      => True,
                            No_Protected_Type_Allocators    => True,
@@ -666,6 +672,7 @@ package System.Rident is
                           (No_Abort_Statements             => True,
                            No_Asynchronous_Control         => True,
                            No_Dynamic_Attachment           => True,
+                           No_Dynamic_CPU_Assignment       => True,
                            No_Dynamic_Priorities           => True,
                            No_Entry_Queue                  => True,
                            No_Local_Protected_Objects      => True,
diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads
index 2383ed0cc90..f320b32d995 100644
--- a/gcc/ada/sem.ads
+++ b/gcc/ada/sem.ads
@@ -138,7 +138,7 @@
 --  this is the one case where this model falls down. Here is how we patch
 --  it up without causing too much distortion to our basic model.
 
---  A switch (In_Spec_Expression) is set to show that we are in the initial
+--  A flag (In_Spec_Expression) is set to show that we are in the initial
 --  occurrence of a default expression. The analyzer is then called on this
 --  expression with the switch set true. Analysis and resolution proceed almost
 --  as usual, except that Freeze_Expression will not freeze non-static
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 9a2f1d05c2c..9008b60dc15 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -6442,37 +6442,31 @@ package body Sem_Ch13 is
          ---------
 
          when Attribute_CPU =>
+            pragma Assert (From_Aspect_Specification (N));
+            --  The parser forbids this clause in source code, so it must have
+            --  come from an aspect specification.
 
-            --  CPU attribute definition clause not allowed except from aspect
-            --  specification.
+            if not Is_Task_Type (U_Ent) then
+               Error_Msg_N ("CPU can only be defined for task", Nam);
 
-            if From_Aspect_Specification (N) then
-               if not Is_Task_Type (U_Ent) then
-                  Error_Msg_N ("CPU can only be defined for task", Nam);
-
-               elsif Duplicate_Clause then
-                  null;
+            elsif Duplicate_Clause then
+               null;
 
-               else
-                  --  The expression must be analyzed in the special manner
-                  --  described in "Handling of Default and Per-Object
-                  --  Expressions" in sem.ads.
+            else
+               --  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 components must be established
-                  --  and restored before and after analysis.
+               --  The visibility to the components must be established
+               --  and restored before and after analysis.
 
-                  Push_Type (U_Ent);
-                  Preanalyze_Spec_Expression (Expr, RTE (RE_CPU_Range));
-                  Pop_Type (U_Ent);
+               Push_Type (U_Ent);
+               Preanalyze_Spec_Expression (Expr, RTE (RE_CPU_Range));
+               Pop_Type (U_Ent);
 
-                  if not Is_OK_Static_Expression (Expr) then
-                     Check_Restriction (Static_Priorities, Expr);
-                  end if;
+               if not Is_OK_Static_Expression (Expr) then
+                  Check_Restriction (No_Dynamic_CPU_Assignment, Expr);
                end if;
-
-            else
-               Error_Msg_N
-                 ("attribute& cannot be set with definition clause", N);
             end if;
 
          ----------------------
@@ -6536,36 +6530,30 @@ package body Sem_Ch13 is
          ------------------------
 
          when Attribute_Dispatching_Domain =>
+            pragma Assert (From_Aspect_Specification (N));
+            --  The parser forbids this clause in source code, so it must have
+            --  come from an aspect specification.
 
-            --  Dispatching_Domain 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
-                    ("Dispatching_Domain can only be defined for task", Nam);
-
-               elsif Duplicate_Clause then
-                  null;
+            if not Is_Task_Type (U_Ent) then
+               Error_Msg_N
+                 ("Dispatching_Domain can only be defined for task", Nam);
 
-               else
-                  --  The expression must be analyzed in the special manner
-                  --  described in "Handling of Default and Per-Object
-                  --  Expressions" in sem.ads.
+            elsif Duplicate_Clause then
+               null;
 
-                  --  The visibility to the components must be restored
+            else
+               --  The expression must be analyzed in the special manner
+               --  described in "Handling of Default and Per-Object
+               --  Expressions" in sem.ads.
 
-                  Push_Type (U_Ent);
+               --  The visibility to the components must be restored
 
-                  Preanalyze_Spec_Expression
-                    (Expr, RTE (RE_Dispatching_Domain));
+               Push_Type (U_Ent);
 
-                  Pop_Type (U_Ent);
-               end if;
+               Preanalyze_Spec_Expression
+                 (Expr, RTE (RE_Dispatching_Domain));
 
-            else
-               Error_Msg_N
-                 ("attribute& cannot be set with definition clause", N);
+               Pop_Type (U_Ent);
             end if;
 
          ------------------
@@ -6623,43 +6611,37 @@ package body Sem_Ch13 is
          ------------------------
 
          when Attribute_Interrupt_Priority =>
+            pragma Assert (From_Aspect_Specification (N));
+            --  The parser forbids this clause in source code, so it must have
+            --  come from an aspect specification.
 
-            --  Interrupt_Priority attribute definition clause not allowed
-            --  except from aspect specification.
-
-            if From_Aspect_Specification (N) then
-               if not Is_Concurrent_Type (U_Ent) then
-                  Error_Msg_N
-                    ("Interrupt_Priority can only be defined for task and "
-                     & "protected object", Nam);
+            if not Is_Concurrent_Type (U_Ent) then
+               Error_Msg_N
+                 ("Interrupt_Priority can only be defined for task and "
+                  & "protected object", Nam);
 
-               elsif Duplicate_Clause then
-                  null;
+            elsif Duplicate_Clause then
+               null;
 
-               else
-                  --  The expression must be analyzed in the special manner
-                  --  described in "Handling of Default and Per-Object
-                  --  Expressions" in sem.ads.
+            else
+               --  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 components must be restored
+               --  The visibility to the components must be restored
 
-                  Push_Type (U_Ent);
+               Push_Type (U_Ent);
 
-                  Preanalyze_Spec_Expression
-                    (Expr, RTE (RE_Interrupt_Priority));
+               Preanalyze_Spec_Expression
+                 (Expr, RTE (RE_Interrupt_Priority));
 
-                  Pop_Type (U_Ent);
+               Pop_Type (U_Ent);
 
-                  --  Check the No_Task_At_Interrupt_Priority restriction
+               --  Check the No_Task_At_Interrupt_Priority restriction
 
-                  if Is_Task_Type (U_Ent) then
-                     Check_Restriction (No_Task_At_Interrupt_Priority, N);
-                  end if;
+               if Is_Task_Type (U_Ent) then
+                  Check_Restriction (No_Task_At_Interrupt_Priority, N);
                end if;
-
-            else
-               Error_Msg_N
-                 ("attribute& cannot be set with definition clause", N);
             end if;
 
          --------------
diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads
index 02fe39ba76c..bb2990496be 100644
--- a/gcc/ada/sem_ch3.ads
+++ b/gcc/ada/sem_ch3.ads
@@ -241,7 +241,7 @@ package Sem_Ch3 is
    --  Default and per object expressions do not freeze their components, and
    --  must be analyzed and resolved accordingly. The analysis is done by
    --  calling the Preanalyze_And_Resolve routine and setting the global
-   --  In_Default_Expression flag. See the documentation section entitled
+   --  In_Spec_Expression flag. See the documentation section entitled
    --  "Handling of Default and Per-Object Expressions" in sem.ads for full
    --  details. N is the expression to be analyzed, T is the expected type.
    --  This mechanism is also used for aspect specifications that have an
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 2895a9cbba5..91c3d6d3bc6 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -14855,13 +14855,13 @@ package body Sem_Prag is
             Ada_2012_Pragma;
             Check_No_Identifiers;
             Check_Arg_Count (1);
+            Arg := Get_Pragma_Arg (Arg1);
 
             --  Subprogram case
 
             if Nkind (P) = N_Subprogram_Body then
                Check_In_Main_Program;
 
-               Arg := Get_Pragma_Arg (Arg1);
                Analyze_And_Resolve (Arg, Any_Integer);
 
                Ent := Defining_Unit_Name (Specification (P));
@@ -14908,7 +14908,6 @@ package body Sem_Prag is
             --  Task case
 
             elsif Nkind (P) = N_Task_Definition then
-               Arg := Get_Pragma_Arg (Arg1);
                Ent := Defining_Identifier (Parent (P));
 
                --  The expression must be analyzed in the special manner
@@ -14917,6 +14916,10 @@ package body Sem_Prag is
 
                Preanalyze_Spec_Expression (Arg, RTE (RE_CPU_Range));
 
+               if not Is_OK_Static_Expression (Arg) then
+                  Check_Restriction (No_Dynamic_CPU_Assignment, N);
+               end if;
+
             --  Anything else is incorrect
 
             else


More information about the Gcc-cvs mailing list