[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 <miranda@adacore.com> 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
This commit is contained in:
Javier Miranda
Pierre-Marie de Rodat
parent
5291985c00
commit
f56e04e89e
@ -1,3 +1,21 @@
|
||||
2019-07-08 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* 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 <schonberg@adacore.com>
|
||||
|
||||
* sem_ch13.adb (Analyze_Aspect_Specifications): For a
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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 --
|
||||
---------------------------
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user