From: Javier Miranda Date: Mon, 8 Jul 2019 08:13:11 +0000 (+0000) Subject: [Ada] Code reorganization X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f56e04e89e809dc34d3f7fd3137f7d35c26e8fee;p=gcc.git [Ada] Code reorganization This patch performs a code reorganization of the implementation of pragma Compile_Time_Error. No functional change. No test required. 2019-07-08 Javier Miranda gcc/ada/ * gnat1drv.adb (Post_Compilation_Validation_Checks: Validate_Compile_Time_Warning_Errors is now located in sem_prag (instead of sem_ch13). * sem_ch13.ads (Validate_Compile_Time_Warning_Error, Validate_Compile_Time_Warning_Errors): Move to sem_prag. * sem_ch13.adb (Compile_Time_Warnings_Errors): Move to sem_prag. (Initialize): Remove initialization of table Compile_Time_Warning_Errors. (Validate_Compile_Time_Warning_Error, Validate_Compile_Time_Warning_Errors): Move to sem_prag. * sem_prag.ads (Validate_Compile_Time_Warning_Errors): New procedure. * sem_prag.adb (Initialize): Initialize table Compile_Time_Warning_Errors. From-SVN: r273202 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d651ff09eaf..bec33068f53 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2019-07-08 Javier Miranda + + * gnat1drv.adb (Post_Compilation_Validation_Checks: + Validate_Compile_Time_Warning_Errors is now located in sem_prag + (instead of sem_ch13). + * sem_ch13.ads (Validate_Compile_Time_Warning_Error, + Validate_Compile_Time_Warning_Errors): Move to sem_prag. + * sem_ch13.adb + (Compile_Time_Warnings_Errors): Move to sem_prag. + (Initialize): Remove initialization of table + Compile_Time_Warning_Errors. + (Validate_Compile_Time_Warning_Error, + Validate_Compile_Time_Warning_Errors): Move to sem_prag. + * sem_prag.ads (Validate_Compile_Time_Warning_Errors): New + procedure. + * sem_prag.adb (Initialize): Initialize table + Compile_Time_Warning_Errors. + 2019-07-08 Ed Schonberg * sem_ch13.adb (Analyze_Aspect_Specifications): For a diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index ded754d55ae..572ce3d4bbb 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -61,6 +61,7 @@ with Sem_Ch12; with Sem_Ch13; with Sem_Elim; with Sem_Eval; +with Sem_Prag; with Sem_SPARK; use Sem_SPARK; with Sem_Type; with Set_Targ; @@ -990,7 +991,7 @@ procedure Gnat1drv is Atree.Unlock; Nlists.Unlock; Sem.Unlock; - Sem_Ch13.Validate_Compile_Time_Warning_Errors; + Sem_Prag.Validate_Compile_Time_Warning_Errors; Sem.Lock; Nlists.Lock; Atree.Lock; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 8467f753576..76639cd301f 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -30,7 +30,6 @@ with Debug; use Debug; with Einfo; use Einfo; with Elists; use Elists; with Errout; use Errout; -with Expander; use Expander; with Exp_Disp; use Exp_Disp; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; @@ -247,41 +246,6 @@ package body Sem_Ch13 is -- Remove visibility to the discriminants of type entity E and pop the -- scope stack if E has discriminants and is not a subtype. - --------------------------------------------------- - -- Table for Validate_Compile_Time_Warning_Error -- - --------------------------------------------------- - - -- The following table collects pragmas Compile_Time_Error and Compile_ - -- Time_Warning for validation. Entries are made by calls to subprogram - -- Validate_Compile_Time_Warning_Error, and the call to the procedure - -- Validate_Compile_Time_Warning_Errors does the actual error checking - -- and posting of warning and error messages. The reason for this delayed - -- processing is to take advantage of back-annotations of attributes size - -- and alignment values performed by the back end. - - -- Note: the reason we store a Source_Ptr value instead of a Node_Id is - -- that by the time Validate_Unchecked_Conversions is called, Sprint will - -- already have modified all Sloc values if the -gnatD option is set. - - type CTWE_Entry is record - Eloc : Source_Ptr; - -- Source location used in warnings and error messages - - Prag : Node_Id; - -- Pragma Compile_Time_Error or Compile_Time_Warning - - Scope : Node_Id; - -- The scope which encloses the pragma - end record; - - package Compile_Time_Warnings_Errors is new Table.Table ( - Table_Component_Type => CTWE_Entry, - Table_Index_Type => Int, - Table_Low_Bound => 1, - Table_Initial => 50, - Table_Increment => 200, - Table_Name => "Compile_Time_Warnings_Errors"); - ---------------------------------------------- -- Table for Validate_Unchecked_Conversions -- ---------------------------------------------- @@ -11830,7 +11794,6 @@ package body Sem_Ch13 is procedure Initialize is begin Address_Clause_Checks.Init; - Compile_Time_Warnings_Errors.Init; Unchecked_Conversions.Init; -- ??? Might be needed in the future for some non GCC back-ends @@ -13937,79 +13900,6 @@ package body Sem_Ch13 is end loop; end Validate_Address_Clauses; - ----------------------------------------- - -- Validate_Compile_Time_Warning_Error -- - ----------------------------------------- - - procedure Validate_Compile_Time_Warning_Error (N : Node_Id) is - begin - Compile_Time_Warnings_Errors.Append - (New_Val => CTWE_Entry'(Eloc => Sloc (N), - Scope => Current_Scope, - Prag => N)); - end Validate_Compile_Time_Warning_Error; - - ------------------------------------------ - -- Validate_Compile_Time_Warning_Errors -- - ------------------------------------------ - - procedure Validate_Compile_Time_Warning_Errors is - procedure Set_Scope (S : Entity_Id); - -- Install all enclosing scopes of S along with S itself - - procedure Unset_Scope (S : Entity_Id); - -- Uninstall all enclosing scopes of S along with S itself - - --------------- - -- Set_Scope -- - --------------- - - procedure Set_Scope (S : Entity_Id) is - begin - if S /= Standard_Standard then - Set_Scope (Scope (S)); - end if; - - Push_Scope (S); - end Set_Scope; - - ----------------- - -- Unset_Scope -- - ----------------- - - procedure Unset_Scope (S : Entity_Id) is - begin - if S /= Standard_Standard then - Unset_Scope (Scope (S)); - end if; - - Pop_Scope; - end Unset_Scope; - - -- Start of processing for Validate_Compile_Time_Warning_Errors - - begin - Expander_Mode_Save_And_Set (False); - In_Compile_Time_Warning_Or_Error := True; - - for N in Compile_Time_Warnings_Errors.First .. - Compile_Time_Warnings_Errors.Last - loop - declare - T : CTWE_Entry renames Compile_Time_Warnings_Errors.Table (N); - - begin - Set_Scope (T.Scope); - Reset_Analyzed_Flags (T.Prag); - Process_Compile_Time_Warning_Or_Error (T.Prag, T.Eloc); - Unset_Scope (T.Scope); - end; - end loop; - - In_Compile_Time_Warning_Or_Error := False; - Expander_Mode_Restore; - end Validate_Compile_Time_Warning_Errors; - --------------------------- -- Validate_Independence -- --------------------------- diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index 3773a120f46..eb95e2bf06c 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -189,18 +189,6 @@ package Sem_Ch13 is -- change. A False result is possible only for array, enumeration or -- record types. - procedure Validate_Compile_Time_Warning_Error (N : Node_Id); - -- N is a pragma Compile_Time_Error or Compile_Warning_Error whose boolean - -- expression is not known at compile time. This procedure makes an entry - -- in a table. The actual checking is performed by Validate_Compile_Time_ - -- Warning_Errors, which is invoked after calling the back end. - - procedure Validate_Compile_Time_Warning_Errors; - -- This routine is called after calling the back end to validate pragmas - -- Compile_Time_Error and Compile_Time_Warning for size and alignment - -- appropriateness. The reason it is called that late is to take advantage - -- of any back-annotation of size and alignment performed by the back end. - procedure Validate_Unchecked_Conversion (N : Node_Id; Act_Unit : Entity_Id); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d8414269d5b..7f202215b18 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -41,6 +41,7 @@ with Elists; use Elists; with Errout; use Errout; with Exp_Dist; use Exp_Dist; with Exp_Util; use Exp_Util; +with Expander; use Expander; with Freeze; use Freeze; with Ghost; use Ghost; with Gnatvsn; use Gnatvsn; @@ -298,6 +299,12 @@ package body Sem_Prag is -- pragma. Entity name for unit and its parents is taken from item in -- previous with_clause that mentions the unit. + procedure Validate_Compile_Time_Warning_Error (N : Node_Id); + -- N is a pragma Compile_Time_Error or Compile_Warning_Error whose boolean + -- expression is not known at compile time. This procedure makes an entry + -- in a table. The actual checking is performed by Validate_Compile_Time_ + -- Warning_Errors, which is invoked after calling the back end. + Dummy : Integer := 0; pragma Volatile (Dummy); -- Dummy volatile integer used in bodies of ip/rv to prevent optimization @@ -316,6 +323,41 @@ package body Sem_Prag is -- pragma in the source program, a breakpoint on rv catches this place in -- the source, allowing convenient stepping to the point of interest. + --------------------------------------------------- + -- Table for Validate_Compile_Time_Warning_Error -- + --------------------------------------------------- + + -- The following table collects pragmas Compile_Time_Error and Compile_ + -- Time_Warning for validation. Entries are made by calls to subprogram + -- Validate_Compile_Time_Warning_Error, and the call to the procedure + -- Validate_Compile_Time_Warning_Errors does the actual error checking + -- and posting of warning and error messages. The reason for this delayed + -- processing is to take advantage of back-annotations of attributes size + -- and alignment values performed by the back end. + + -- Note: the reason we store a Source_Ptr value instead of a Node_Id is + -- that by the time Validate_Unchecked_Conversions is called, Sprint will + -- already have modified all Sloc values if the -gnatD option is set. + + type CTWE_Entry is record + Eloc : Source_Ptr; + -- Source location used in warnings and error messages + + Prag : Node_Id; + -- Pragma Compile_Time_Error or Compile_Time_Warning + + Scope : Node_Id; + -- The scope which encloses the pragma + end record; + + package Compile_Time_Warnings_Errors is new Table.Table ( + Table_Component_Type => CTWE_Entry, + Table_Index_Type => Int, + Table_Low_Bound => 1, + Table_Initial => 50, + Table_Increment => 200, + Table_Name => "Compile_Time_Warnings_Errors"); + ------------------------------- -- Adjust_External_Name_Case -- ------------------------------- @@ -7605,7 +7647,7 @@ package body Sem_Prag is Check_Expression (Arg1x); if Validation_Needed then - Sem_Ch13.Validate_Compile_Time_Warning_Error (N); + Validate_Compile_Time_Warning_Error (N); end if; end if; end Process_Compile_Time_Warning_Or_Error; @@ -30724,6 +30766,7 @@ package body Sem_Prag is procedure Initialize is begin Externals.Init; + Compile_Time_Warnings_Errors.Init; end Initialize; -------- @@ -32066,4 +32109,77 @@ package body Sem_Prag is return Empty; end Test_Case_Arg; + ----------------------------------------- + -- Validate_Compile_Time_Warning_Error -- + ----------------------------------------- + + procedure Validate_Compile_Time_Warning_Error (N : Node_Id) is + begin + Compile_Time_Warnings_Errors.Append + (New_Val => CTWE_Entry'(Eloc => Sloc (N), + Scope => Current_Scope, + Prag => N)); + end Validate_Compile_Time_Warning_Error; + + ------------------------------------------ + -- Validate_Compile_Time_Warning_Errors -- + ------------------------------------------ + + procedure Validate_Compile_Time_Warning_Errors is + procedure Set_Scope (S : Entity_Id); + -- Install all enclosing scopes of S along with S itself + + procedure Unset_Scope (S : Entity_Id); + -- Uninstall all enclosing scopes of S along with S itself + + --------------- + -- Set_Scope -- + --------------- + + procedure Set_Scope (S : Entity_Id) is + begin + if S /= Standard_Standard then + Set_Scope (Scope (S)); + end if; + + Push_Scope (S); + end Set_Scope; + + ----------------- + -- Unset_Scope -- + ----------------- + + procedure Unset_Scope (S : Entity_Id) is + begin + if S /= Standard_Standard then + Unset_Scope (Scope (S)); + end if; + + Pop_Scope; + end Unset_Scope; + + -- Start of processing for Validate_Compile_Time_Warning_Errors + + begin + Expander_Mode_Save_And_Set (False); + In_Compile_Time_Warning_Or_Error := True; + + for N in Compile_Time_Warnings_Errors.First .. + Compile_Time_Warnings_Errors.Last + loop + declare + T : CTWE_Entry renames Compile_Time_Warnings_Errors.Table (N); + + begin + Set_Scope (T.Scope); + Reset_Analyzed_Flags (T.Prag); + Process_Compile_Time_Warning_Or_Error (T.Prag, T.Eloc); + Unset_Scope (T.Scope); + end; + end loop; + + In_Compile_Time_Warning_Or_Error := False; + Expander_Mode_Restore; + end Validate_Compile_Time_Warning_Errors; + end Sem_Prag; diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index f2f6d0c342c..25353b70b23 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -555,4 +555,10 @@ package Sem_Prag is -- -- Empty if there is no such argument + procedure Validate_Compile_Time_Warning_Errors; + -- This routine is called after calling the back end to validate pragmas + -- Compile_Time_Error and Compile_Time_Warning for size and alignment + -- appropriateness. The reason it is called that late is to take advantage + -- of any back-annotation of size and alignment performed by the back end. + end Sem_Prag;