From 8be08b9b67df52d90280f3b1314dc038943ffa3f Mon Sep 17 00:00:00 2001 From: Ghjuvan Lacambre Date: Thu, 13 Aug 2020 10:36:08 +0200 Subject: [PATCH] [Ada] Fix transformation of Suppress aspect into pragma gcc/ada/ * sem_ch13.adb (Make_Aitem_Pragma): Turn into function. This removes a side-effect on the Aitem variable. (Analyze_Aspect_Specifications): Handle Suppress and Unsuppress aspects differently from the Linker_Section aspect. (Ceck_Aspect_At_Freeze_Point): Don't expect Suppress/Unsuppress to be delayed anymore. --- gcc/ada/sem_ch13.adb | 131 ++++++++++++++++++++++++------------------- 1 file changed, 72 insertions(+), 59 deletions(-) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 636d44f99ae..564aafadfa3 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1813,9 +1813,9 @@ package body Sem_Ch13 is procedure Analyze_Aspect_Static; -- Ada 202x (AI12-0075): Perform analysis of aspect Static - procedure Make_Aitem_Pragma + function Make_Aitem_Pragma (Pragma_Argument_Associations : List_Id; - Pragma_Name : Name_Id); + Pragma_Name : Name_Id) return Node_Id; -- This is a wrapper for Make_Pragma used for converting aspects -- to pragmas. It takes care of Sloc (set from Loc) and building -- the pragma identifier from the given name. In addition the @@ -1874,7 +1874,7 @@ package body Sem_Ch13 is -- Generate: -- pragma Convention (, ); - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Name => Name_Convention, Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, @@ -2677,12 +2677,12 @@ package body Sem_Ch13 is -- Make_Aitem_Pragma -- ----------------------- - procedure Make_Aitem_Pragma + function Make_Aitem_Pragma (Pragma_Argument_Associations : List_Id; - Pragma_Name : Name_Id) + Pragma_Name : Name_Id) return Node_Id is - Args : List_Id := Pragma_Argument_Associations; - + Args : List_Id := Pragma_Argument_Associations; + Aitem : Node_Id; begin -- We should never get here if aspect was disabled @@ -2715,6 +2715,8 @@ package body Sem_Ch13 is Set_Corresponding_Aspect (Aitem, Aspect); Set_From_Aspect_Specification (Aitem); + + return Aitem; end Make_Aitem_Pragma; -- Start of processing for Analyze_One_Aspect @@ -3048,13 +3050,10 @@ package body Sem_Ch13 is -- referring to the entity, and the second argument is the -- aspect definition expression. - -- Linker_Section/Suppress/Unsuppress + -- Linker_Section - when Aspect_Linker_Section - | Aspect_Suppress - | Aspect_Unsuppress - => - Make_Aitem_Pragma + when Aspect_Linker_Section => + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => New_Occurrence_Of (E, Loc)), @@ -3069,8 +3068,7 @@ package body Sem_Ch13 is -- code. (This is already done for types with implicit -- initialization, such as protected types.) - if A_Id = Aspect_Linker_Section - and then Nkind (N) = N_Object_Declaration + if Nkind (N) = N_Object_Declaration and then Has_Init_Expression (N) then Delay_Required := False; @@ -3081,7 +3079,7 @@ package body Sem_Ch13 is -- Corresponds to pragma Implemented, construct the pragma when Aspect_Synchronization => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => New_Occurrence_Of (E, Loc)), @@ -3092,7 +3090,7 @@ package body Sem_Ch13 is -- Attach_Handler when Aspect_Attach_Handler => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Sloc (Ent), Expression => Ent), @@ -3134,7 +3132,7 @@ package body Sem_Ch13 is -- flags recording whether it is static/dynamic). We also -- set flags recording this in the type itself. - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Sloc (Ent), Expression => Ent), @@ -3219,7 +3217,7 @@ package body Sem_Ch13 is -- Construct the pragma - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Sloc (Ent), Expression => Ent), @@ -3375,10 +3373,25 @@ package body Sem_Ch13 is Expression => Relocate_Node (Expr)); end if; + -- Suppress/Unsuppress + + when Aspect_Suppress + | Aspect_Unsuppress + => + Aitem := Make_Aitem_Pragma + (Pragma_Argument_Associations => New_List ( + Make_Pragma_Argument_Association (Loc, + Expression => Relocate_Node (Expr)), + Make_Pragma_Argument_Association (Sloc (Expr), + Expression => New_Occurrence_Of (E, Loc))), + Pragma_Name => Chars (Id)); + + Delay_Required := False; + -- Warnings when Aspect_Warnings => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Sloc (Expr), Expression => Relocate_Node (Expr)), @@ -3406,7 +3419,7 @@ package body Sem_Ch13 is -- an invariant must apply to a private type, or appear in -- the private part of a spec and apply to a completion. - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Sloc (Ent), Expression => Ent), @@ -3458,7 +3471,7 @@ package body Sem_Ch13 is if Nkind (Context) in N_Generic_Package_Declaration | N_Package_Declaration then - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3484,7 +3497,7 @@ package body Sem_Ch13 is -- related object declaration. when Aspect_Async_Readers => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3499,7 +3512,7 @@ package body Sem_Ch13 is -- related object declaration. when Aspect_Async_Writers => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3514,7 +3527,7 @@ package body Sem_Ch13 is -- related object declaration. when Aspect_Constant_After_Elaboration => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3534,7 +3547,7 @@ package body Sem_Ch13 is -- private type's full view. when Aspect_Default_Initial_Condition => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3548,7 +3561,7 @@ package body Sem_Ch13 is -- Default_Storage_Pool when Aspect_Default_Storage_Pool => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3569,7 +3582,7 @@ package body Sem_Ch13 is -- Analyze_Depends_In_Decl_Part for details. when Aspect_Depends => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3584,7 +3597,7 @@ package body Sem_Ch13 is -- related object declaration. when Aspect_Effective_Reads => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3599,7 +3612,7 @@ package body Sem_Ch13 is -- related object declaration. when Aspect_Effective_Writes => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3614,7 +3627,7 @@ package body Sem_Ch13 is -- related subprogram. when Aspect_Extensions_Visible => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3630,7 +3643,7 @@ package body Sem_Ch13 is -- a type declaration. when Aspect_Ghost => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3650,7 +3663,7 @@ package body Sem_Ch13 is -- Analyze_Global_In_Decl_Part for details. when Aspect_Global => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3685,7 +3698,7 @@ package body Sem_Ch13 is if Nkind (Context) in N_Generic_Package_Declaration | N_Package_Declaration then - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3733,7 +3746,7 @@ package body Sem_Ch13 is if Nkind (Context) in N_Generic_Package_Declaration | N_Package_Declaration then - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3759,7 +3772,7 @@ package body Sem_Ch13 is -- Max_Entry_Queue_Depth when Aspect_Max_Entry_Queue_Depth => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3772,7 +3785,7 @@ package body Sem_Ch13 is -- Max_Entry_Queue_Length when Aspect_Max_Entry_Queue_Length => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3785,7 +3798,7 @@ package body Sem_Ch13 is -- Max_Queue_Length when Aspect_Max_Queue_Length => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3800,7 +3813,7 @@ package body Sem_Ch13 is -- declaration. when Aspect_No_Caching => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3824,7 +3837,7 @@ package body Sem_Ch13 is Expression => Relocate_Node (Expr))); end if; - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => Args, Pragma_Name => Chars (Id)); end; @@ -3836,7 +3849,7 @@ package body Sem_Ch13 is | N_Package_Instantiation or else Is_Single_Concurrent_Type_Declaration (N) then - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3857,7 +3870,7 @@ package body Sem_Ch13 is -- SPARK_Mode when Aspect_SPARK_Mode => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3878,7 +3891,7 @@ package body Sem_Ch13 is -- routine Analyze_Refined_Depends_In_Decl_Part. when Aspect_Refined_Depends => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3899,7 +3912,7 @@ package body Sem_Ch13 is -- routine Analyze_Refined_Global_In_Decl_Part. when Aspect_Refined_Global => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3912,7 +3925,7 @@ package body Sem_Ch13 is -- Refined_Post when Aspect_Refined_Post => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3932,7 +3945,7 @@ package body Sem_Ch13 is -- the pragma. if Nkind (N) = N_Package_Body then - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -3953,7 +3966,7 @@ package body Sem_Ch13 is -- Relative_Deadline when Aspect_Relative_Deadline => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -4002,7 +4015,7 @@ package body Sem_Ch13 is -- attribute does not have visibility on the discriminant. when Aspect_Secondary_Stack_Size => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -4020,7 +4033,7 @@ package body Sem_Ch13 is -- related subprogram. when Aspect_Volatile_Function => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -4100,7 +4113,7 @@ package body Sem_Ch13 is Chars => Name_Entity, Expression => Ent)); - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => Pargs, Pragma_Name => Name_Annotate); end; @@ -4294,7 +4307,7 @@ package body Sem_Ch13 is New_Expr := Relocate_Node (Expr); end if; - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Eloc, Chars => Name_Check, @@ -4385,7 +4398,7 @@ package body Sem_Ch13 is -- Build the test-case pragma - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => Args, Pragma_Name => Nam); end Test_Case; @@ -4393,7 +4406,7 @@ package body Sem_Ch13 is -- Contract_Cases when Aspect_Contract_Cases => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -4406,7 +4419,7 @@ package body Sem_Ch13 is -- Subprogram_Variant when Aspect_Subprogram_Variant => - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -4523,7 +4536,7 @@ package body Sem_Ch13 is if A_Id /= Aspect_Export and then A_Id /= Aspect_Import then - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Sloc (Ent), Expression => Ent)), @@ -4574,7 +4587,7 @@ package body Sem_Ch13 is -- Create a pragma and put it at the start of the task -- definition for the task type declaration. - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Relocate_Node (Expr))), @@ -4635,7 +4648,7 @@ package body Sem_Ch13 is if Is_Boolean_Aspect (Aspect) and then No (Aitem) then if Is_True (Static_Boolean (Expr)) then - Make_Aitem_Pragma + Aitem := Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Sloc (Ent), Expression => Ent)), @@ -10753,8 +10766,6 @@ package body Sem_Ch13 is | Aspect_Output | Aspect_Put_Image | Aspect_Read - | Aspect_Suppress - | Aspect_Unsuppress | Aspect_Warnings | Aspect_Write => @@ -10871,8 +10882,10 @@ package body Sem_Ch13 is | Aspect_Relaxed_Initialization | Aspect_SPARK_Mode | Aspect_Subprogram_Variant + | Aspect_Suppress | Aspect_Test_Case | Aspect_Unimplemented + | Aspect_Unsuppress | Aspect_Volatile_Function => raise Program_Error; -- 2.30.2