diff options
author | Bob Duff <duff@adacore.com> | 2020-06-09 10:53:23 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-07-16 05:18:09 -0400 |
commit | f7a8be8a1919661122a8ac87c595e1267a1ee3d5 (patch) | |
tree | 6fa25f1f3bc668e6439ff992bcf0aaef7281c895 /gcc | |
parent | ebc2b117e43191de355187553586aef30048f098 (diff) | |
download | gcc-f7a8be8a1919661122a8ac87c595e1267a1ee3d5.zip gcc-f7a8be8a1919661122a8ac87c595e1267a1ee3d5.tar.gz gcc-f7a8be8a1919661122a8ac87c595e1267a1ee3d5.tar.bz2 |
[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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/libgnat/s-rident.ads | 15 | ||||
-rw-r--r-- | gcc/ada/sem.ads | 2 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.adb | 130 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.ads | 2 | ||||
-rw-r--r-- | 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 b7969fb..8572016 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 2383ed0c..f320b32 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 9a2f1d0..9008b60 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 02fe39b..bb29904 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 2895a9c..91c3d6d 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 |