This internal modification changes the representation of the
Fatal_Error field in the unit record to record the presence
of fatal errors even if -gnatq/Q is set. No functional effect
for the compiler itself so no test now. This should allow an
improvement in ASIS processing which will be documented there.
Tested on x86_64-pc-linux-gnu, committed on trunk
2015-02-05 Robert Dewar <de...@adacore.com>
* errout.adb (Handle_Serious_Error): New setting of Fatal_Error.
* frontend.adb (Frontend): New setting of Fatal_Error.
* lib-load.adb (Create_Dummy_Package_Unit): New setting of
Fatal_Error.
(Load_Main_Source): New setting of Fatal_Error
(Load_Unit): New setting of Fatal_Error.
* lib-writ.adb (Add_Preprocessing_Dependency): New setting of
Fatal_Error.
(Ensure_System_Dependency): New setting of Fatal_Error.
* lib.adb (Fatal_Error): New setting of Fatal_Error
(Set_Fatal_Error): New setting of Fatal_Error.
* lib.ads: New definition of Fatal_Error and associated routines.
* par-ch10.adb (P_Compilation_Unit): New setting of Fatal_Error.
* par-load.adb (Load): New setting of Fatal_Error.
* rtsfind.adb (Load_RTU): New setting of Fatal_Error.
* sem_ch10.adb (Analyze_Compilation_Unit): New setting of
Fatal_Error.
(Optional_Subunit): New setting of Fatal_Error.
(Analyze_Proper_Body): New setting of Fatal_Error.
(Load_Needed_Body): New setting of Fatal_Error.
Index: lib.adb
===================================================================
--- lib.adb (revision 220439)
+++ lib.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -106,7 +106,7 @@
return Units.Table (U).Expected_Unit;
end Expected_Unit;
- function Fatal_Error (U : Unit_Number_Type) return Boolean is
+ function Fatal_Error (U : Unit_Number_Type) return Fatal_Type is
begin
return Units.Table (U).Fatal_Error;
end Fatal_Error;
@@ -196,9 +196,9 @@
Units.Table (U).Error_Location := W;
end Set_Error_Location;
- procedure Set_Fatal_Error (U : Unit_Number_Type; B : Boolean := True) is
+ procedure Set_Fatal_Error (U : Unit_Number_Type; V : Fatal_Type) is
begin
- Units.Table (U).Fatal_Error := B;
+ Units.Table (U).Fatal_Error := V;
end Set_Fatal_Error;
procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True) is
Index: lib.ads
===================================================================
--- lib.ads (revision 220439)
+++ lib.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -302,7 +302,7 @@
-- No_Name for the main unit.
-- Fatal_Error
- -- A flag that is initialized to False, and gets set to True if a fatal
+ -- A flag that is initialized to None and gets set to Errorif a fatal
-- error occurs during the processing of a unit. A fatal error is one
-- defined as serious enough to stop the next phase of the compiler
-- from running (i.e. fatal error during parsing stops semantics,
@@ -310,6 +310,7 @@
-- currently, errors of any kind cause Fatal_Error to be set, but
-- eventually perhaps only errors labeled as fatal errors should be
-- this severe if we decide to try Sem on sources with minor errors.
+ -- There are three settings (see declaration of Fatal_Type).
-- Generate_Code
-- This flag is set True for all units in the current file for which
@@ -401,13 +402,29 @@
Default_Main_CPU : constant Int := -1;
-- Value used in Main_CPU field to indicate default main affinity
+ -- The following defines settings for the Fatal_Error field
+
+ type Fatal_Type is (
+ None,
+ -- No error detected for this unit
+
+ Error_Detected,
+ -- Fatal error detected that prevents moving to the next phase. For
+ -- example, a fatal error during parsing inhibits semantic analysis.
+
+ Error_Ignored);
+ -- A fatal error was detected, but we are in Try_Semantics mode (as set
+ -- by -gnatq or -gnatQ). This does not stop the compiler from proceding,
+ -- but tools can use this status (e.g. ASIS looking at the generated
+ -- tree) to know that a fatal error was detected.
+
function Cunit (U : Unit_Number_Type) return Node_Id;
function Cunit_Entity (U : Unit_Number_Type) return Entity_Id;
function Dependency_Num (U : Unit_Number_Type) return Nat;
function Dynamic_Elab (U : Unit_Number_Type) return Boolean;
function Error_Location (U : Unit_Number_Type) return Source_Ptr;
function Expected_Unit (U : Unit_Number_Type) return Unit_Name_Type;
- function Fatal_Error (U : Unit_Number_Type) return Boolean;
+ function Fatal_Error (U : Unit_Number_Type) return Fatal_Type;
function Generate_Code (U : Unit_Number_Type) return Boolean;
function Ident_String (U : Unit_Number_Type) return Node_Id;
function Has_RACW (U : Unit_Number_Type) return Boolean;
@@ -422,20 +439,20 @@
function Unit_Name (U : Unit_Number_Type) return Unit_Name_Type;
-- Get value of named field from given units table entry
- procedure Set_Cunit (U : Unit_Number_Type; N : Node_Id);
- procedure Set_Cunit_Entity (U : Unit_Number_Type; E : Entity_Id);
- procedure Set_Dynamic_Elab (U : Unit_Number_Type; B : Boolean := True);
- procedure Set_Error_Location (U : Unit_Number_Type; W : Source_Ptr);
- procedure Set_Fatal_Error (U : Unit_Number_Type; B : Boolean := True);
- procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True);
- procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True);
- procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id);
- procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True);
- procedure Set_Main_CPU (U : Unit_Number_Type; P : Int);
- procedure Set_No_Elab_Code_All (U : Unit_Number_Type; B : Boolean := True);
- procedure Set_Main_Priority (U : Unit_Number_Type; P : Int);
- procedure Set_OA_Setting (U : Unit_Number_Type; C : Character);
- procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type);
+ procedure Set_Cunit (U : Unit_Number_Type; N : Node_Id);
+ procedure Set_Cunit_Entity (U : Unit_Number_Type; E : Entity_Id);
+ procedure Set_Dynamic_Elab (U : Unit_Number_Type; B : Boolean := True);
+ procedure Set_Error_Location (U : Unit_Number_Type; W : Source_Ptr);
+ procedure Set_Fatal_Error (U : Unit_Number_Type; V : Fatal_Type);
+ procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True);
+ procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True);
+ procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id);
+ procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True);
+ procedure Set_Main_CPU (U : Unit_Number_Type; P : Int);
+ procedure Set_No_Elab_Code_All (U : Unit_Number_Type; B : Boolean := True);
+ procedure Set_Main_Priority (U : Unit_Number_Type; P : Int);
+ procedure Set_OA_Setting (U : Unit_Number_Type; C : Character);
+ procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type);
-- Set value of named field for given units table entry. Note that we
-- do not have an entry for each possible field, since some of the fields
-- can only be set by specialized interfaces (defined below).
@@ -606,7 +623,7 @@
function Is_Loaded (Uname : Unit_Name_Type) return Boolean;
-- Determines if unit with given name is already loaded, i.e. there is
-- already an entry in the file table with this unit name for which the
- -- corresponding file was found and parsed. Note that the Fatal_Error flag
+ -- corresponding file was found and parsed. Note that the Fatal_Error value
-- of this entry must be checked before proceeding with further processing.
function Last_Unit return Unit_Number_Type;
@@ -767,7 +784,7 @@
Serial_Number : Nat;
Version : Word;
Error_Location : Source_Ptr;
- Fatal_Error : Boolean;
+ Fatal_Error : Fatal_Type;
Generate_Code : Boolean;
Has_RACW : Boolean;
Dynamic_Elab : Boolean;
Index: frontend.adb
===================================================================
--- frontend.adb (revision 220439)
+++ frontend.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -338,7 +338,7 @@
-- unit failed to load, to avoid cascaded inconsistencies that can lead
-- to a compiler crash.
- and then not Fatal_Error (Main_Unit)
+ and then Fatal_Error (Main_Unit) /= Error_Detected
then
-- Pragmas that require some semantic activity, such as Interrupt_State,
-- cannot be processed until the main unit is installed, because they
@@ -388,7 +388,7 @@
-- Following steps are skipped if we had a fatal error during parsing
- if not Fatal_Error (Main_Unit) then
+ if Fatal_Error (Main_Unit) /= Error_Detected then
-- Reset Operating_Mode to Check_Semantics for subunits. We cannot
-- actually generate code for subunits, so we suppress expansion.
Index: lib-writ.adb
===================================================================
--- lib-writ.adb (revision 220439)
+++ lib-writ.adb (working copy)
@@ -81,7 +81,7 @@
Cunit_Entity => Empty,
Dependency_Num => 0,
Dynamic_Elab => False,
- Fatal_Error => False,
+ Fatal_Error => None,
Generate_Code => False,
Has_RACW => False,
Filler => False,
@@ -139,7 +139,7 @@
Cunit_Entity => Empty,
Dependency_Num => 0,
Dynamic_Elab => False,
- Fatal_Error => False,
+ Fatal_Error => None,
Generate_Code => False,
Has_RACW => False,
Filler => False,
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb (revision 220439)
+++ sem_ch10.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -936,7 +936,7 @@
and then (Distribution_Stub_Mode = Generate_Receiver_Stub_Body
or else
Distribution_Stub_Mode = Generate_Caller_Stub_Body)
- and then not Fatal_Error (Main_Unit)
+ and then Fatal_Error (Main_Unit) /= Error_Detected
then
if Is_RCI_Pkg_Spec_Or_Body (N) then
@@ -1096,7 +1096,7 @@
elsif not Analyzed (Cunit (Un))
and then Un /= Main_Unit
- and then not Fatal_Error (Un)
+ and then Fatal_Error (Un) /= Error_Detected
then
Style_Check := False;
Semantics (Cunit (Un));
@@ -1623,7 +1623,8 @@
-- All done if we successfully loaded the subunit
if Unum /= No_Unit
- and then (not Fatal_Error (Unum) or else Try_Semantics)
+ and then (Fatal_Error (Unum) /= Error_Detected
+ or else Try_Semantics)
then
Comp_Unit := Cunit (Unum);
@@ -1860,7 +1861,9 @@
-- Analyze the unit if semantics active
- if not Fatal_Error (Unum) or else Try_Semantics then
+ if Fatal_Error (Unum) /= Error_Detected
+ or else Try_Semantics
+ then
Analyze_Subunit (Comp_Unit);
end if;
end if;
@@ -5442,7 +5445,7 @@
else
Compiler_State := Analyzing; -- reset after load
- if not Fatal_Error (Unum) or else Try_Semantics then
+ if Fatal_Error (Unum) /= Error_Detected or else Try_Semantics then
if Debug_Flag_L then
Write_Str ("*** Loaded generic body");
Write_Eol;
Index: rtsfind.adb
===================================================================
--- rtsfind.adb (revision 220439)
+++ rtsfind.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -979,7 +979,7 @@
if U.Unum = No_Unit then
Load_Fail ("not found", U_Id, Id);
- elsif Fatal_Error (U.Unum) then
+ elsif Fatal_Error (U.Unum) = Error_Detected then
Load_Fail ("had parser errors", U_Id, Id);
end if;
@@ -1025,7 +1025,7 @@
Semantics (Cunit (U.Unum));
Restore_Private_Visibility;
- if Fatal_Error (U.Unum) then
+ if Fatal_Error (U.Unum) = Error_Detected then
Load_Fail ("had semantic errors", U_Id, Id);
end if;
end if;
Index: par-load.adb
===================================================================
--- par-load.adb (revision 220439)
+++ par-load.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -127,7 +127,7 @@
begin
-- Don't do any loads if we already had a fatal error
- if Fatal_Error (Cur_Unum) then
+ if Fatal_Error (Cur_Unum) = Error_Detected then
return;
end if;
Index: errout.adb
===================================================================
--- errout.adb (revision 220439)
+++ errout.adb (working copy)
@@ -753,12 +753,23 @@
end if;
-- Set the fatal error flag in the unit table unless we are in
- -- Try_Semantics mode. This stops the semantics from being performed
+ -- Try_Semantics mode (in which case we set ignored mode if not
+ -- currently set. This stops the semantics from being performed
-- if we find a serious error. This is skipped if we are currently
-- dealing with the configuration pragma file.
- if not Try_Semantics and then Current_Source_Unit /= No_Unit then
- Set_Fatal_Error (Get_Source_Unit (Sptr));
+ if Current_Source_Unit /= No_Unit then
+ declare
+ U : constant Unit_Number_Type := Get_Source_Unit (Sptr);
+ begin
+ if Try_Semantics then
+ if Fatal_Error (U) = None then
+ Set_Fatal_Error (U, Error_Ignored);
+ end if;
+ else
+ Set_Fatal_Error (U, Error_Detected);
+ end if;
+ end;
end if;
end Handle_Serious_Error;
Index: par-ch10.adb
===================================================================
--- par-ch10.adb (revision 220439)
+++ par-ch10.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -596,7 +596,7 @@
else
Cunit_Error_Flag := True;
- Set_Fatal_Error (Current_Source_Unit);
+ Set_Fatal_Error (Current_Source_Unit, Error_Detected);
end if;
-- Clear away any missing semicolon indication, we are done with that
@@ -726,7 +726,7 @@
-- cascaded messages in some situations.
else
- if not Fatal_Error (Current_Source_Unit) then
+ if Fatal_Error (Current_Source_Unit) /= Error_Detected then
if Token in Token_Class_Cunit then
Error_Msg_SC
("end of file expected, " &
@@ -758,7 +758,7 @@
-- An error resync is a serious bomb, so indicate result unit no good
when Error_Resync =>
- Set_Fatal_Error (Current_Source_Unit);
+ Set_Fatal_Error (Current_Source_Unit, Error_Detected);
return Error;
end P_Compilation_Unit;
Index: lib-load.adb
===================================================================
--- lib-load.adb (revision 220439)
+++ lib-load.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -212,7 +212,7 @@
Dynamic_Elab => False,
Error_Location => Sloc (With_Node),
Expected_Unit => Spec_Name,
- Fatal_Error => True,
+ Fatal_Error => Error_Detected,
Generate_Code => False,
Has_RACW => False,
Filler => False,
@@ -319,7 +319,7 @@
Dynamic_Elab => False,
Error_Location => No_Location,
Expected_Unit => No_Unit_Name,
- Fatal_Error => False,
+ Fatal_Error => None,
Generate_Code => False,
Has_RACW => False,
Filler => False,
@@ -683,7 +683,7 @@
Dynamic_Elab => False,
Error_Location => Sloc (Error_Node),
Expected_Unit => Uname_Actual,
- Fatal_Error => False,
+ Fatal_Error => None,
Generate_Code => False,
Has_RACW => False,
Filler => False,
@@ -742,10 +742,20 @@
-- If loaded unit had a fatal error, then caller inherits it
- if Units.Table (Unum).Fatal_Error
- and then Present (Error_Node)
- then
- Units.Table (Calling_Unit).Fatal_Error := True;
+ if Present (Error_Node) then
+ case Units.Table (Unum).Fatal_Error is
+ when None =>
+ null;
+
+ when Error_Detected =>
+ Units.Table (Calling_Unit).Fatal_Error := Error_Detected;
+
+ when Error_Ignored =>
+ if Units.Table (Calling_Unit).Fatal_Error = None then
+ Units.Table (Calling_Unit).Fatal_Error :=
+ Error_Ignored;
+ end if;
+ end case;
end if;
-- Remove load stack entry and return the entry in the file table
