+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
with Sem_Ch13;
with Sem_Elim;
with Sem_Eval;
+with Sem_Prag;
with Sem_SPARK; use Sem_SPARK;
with Sem_Type;
with Set_Targ;
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;
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;
-- 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 --
----------------------------------------------
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
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 --
---------------------------
-- 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);
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;
-- 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
-- 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 --
-------------------------------
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;
procedure Initialize is
begin
Externals.Init;
+ Compile_Time_Warnings_Errors.Init;
end Initialize;
--------
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;
--
-- 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;
projects / gcc.git / commitdiff