From f7a8be8a1919661122a8ac87c595e1267a1ee3d5 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Tue, 9 Jun 2020 10:53:23 -0400 Subject: [PATCH] [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. --- 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 -- 2.30.2