aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJavier Miranda <miranda@adacore.com>2019-07-08 08:13:11 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-07-08 08:13:11 +0000
commitf56e04e89e809dc34d3f7fd3137f7d35c26e8fee (patch)
treec76f6934ec9fc904beccb41ffa83f2e96ad461c4
parent5291985c00302036cc6d5932fdffb9acab3043cf (diff)
downloadgcc-f56e04e89e809dc34d3f7fd3137f7d35c26e8fee.zip
gcc-f56e04e89e809dc34d3f7fd3137f7d35c26e8fee.tar.gz
gcc-f56e04e89e809dc34d3f7fd3137f7d35c26e8fee.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog18
-rw-r--r--gcc/ada/gnat1drv.adb3
-rw-r--r--gcc/ada/sem_ch13.adb110
-rw-r--r--gcc/ada/sem_ch13.ads12
-rw-r--r--gcc/ada/sem_prag.adb118
-rw-r--r--gcc/ada/sem_prag.ads6
6 files changed, 143 insertions, 124 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d651ff0..bec3306 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index ded754d..572ce3d 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 8467f75..76639cd 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 3773a12..eb95e2b 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 d841426..7f20221 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 f2f6d0c..25353b7 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;