[gcc(refs/users/aoliva/heads/testme)] [Ada] Ada2020: AI12-0055 No_Dynamic_CPU_Assignment restriction
Alexandre Oliva
aoliva@gcc.gnu.org
Wed Jul 22 09:09:02 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