OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2012-11-06  Tristan Gingold  <gingold@adacore.com>

	* sem_ch9.adb (Analyze_Protected_Type_Declaration): Fix thinko
	in previous commit.

2012-11-06  Jose Ruiz  <ruiz@adacore.com>

	* ali.adb (Scan_ALI): Fix parsing mechanism for -fstack-check.

2012-11-06  Thomas Quinot  <quinot@adacore.com>

	* atree.adb, atree.ads, einfo.adb, errout.adb, errout.ads, erroutc.adb,
	erroutc.ads, errutil.adb, errutil.ads, err_vars.ads, expander.adb,
	exp_ch13.adb, exp_ch2.adb, exp_ch6.adb, exp_dist.adb, fe.h,
	fmap.adb, fmap.ads, gprep.adb, makeutl.adb, osint.adb, osint.ads,
	par_sco.adb, prepcomp.adb, prj-part.adb, prj-proc.adb, scng.adb,
	sdefault.ads, sem_ch10.adb, sem_ch13.adb, sem_ch2.adb, sem_ch3.adb,
	sem_ch4.adb, sem_ch5.adb, sem_dim.adb, sem_elab.adb, sem_eval.adb,
	sem_intr.adb, sem_prag.adb, sem_type.adb, sem_warn.adb, stylesw.adb,
	stylesw.ads, targparm.adb, targparm.ads (Cascaded_Error): Rename to
	more descriptive name 'Check_Error_Detected'. Add calls to
	Check_Error_Detected at places where semantic analysis is abandoned
	assuming a previously detected error.

From-SVN: r193235
This commit is contained in:
Arnaud Charlet 2012-11-06 12:28:27 +01:00
parent d8192289b5
commit ee2ba85639
43 changed files with 159 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
gcc/ada/ChangeLog
View File

@ -1,3 +1,27 @@
2012-11-06 Tristan Gingold <gingold@adacore.com>
* sem_ch9.adb (Analyze_Protected_Type_Declaration): Fix thinko
in previous commit.
2012-11-06 Jose Ruiz <ruiz@adacore.com>
* ali.adb (Scan_ALI): Fix parsing mechanism for -fstack-check.
2012-11-06 Thomas Quinot <quinot@adacore.com>
* atree.adb, atree.ads, einfo.adb, errout.adb, errout.ads, erroutc.adb,
erroutc.ads, errutil.adb, errutil.ads, err_vars.ads, expander.adb,
exp_ch13.adb, exp_ch2.adb, exp_ch6.adb, exp_dist.adb, fe.h,
fmap.adb, fmap.ads, gprep.adb, makeutl.adb, osint.adb, osint.ads,
par_sco.adb, prepcomp.adb, prj-part.adb, prj-proc.adb, scng.adb,
sdefault.ads, sem_ch10.adb, sem_ch13.adb, sem_ch2.adb, sem_ch3.adb,
sem_ch4.adb, sem_ch5.adb, sem_dim.adb, sem_elab.adb, sem_eval.adb,
sem_intr.adb, sem_prag.adb, sem_type.adb, sem_warn.adb, stylesw.adb,
stylesw.ads, targparm.adb, targparm.ads (Cascaded_Error): Rename to
more descriptive name 'Check_Error_Detected'. Add calls to
Check_Error_Detected at places where semantic analysis is abandoned
assuming a previously detected error.
2012-11-06 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb: Minor comment change.

11
gcc/ada/ali.adb
View File

@ -970,9 +970,16 @@ package body ALI is
Add_Char_To_Name_Buffer (Getc);
end loop;
-- If -fstack-check, record that it occurred
-- If -fstack-check, record that it occurred. Note that an
-- additional string parameter can be specified, in the form of
-- -fstack-check={no|generic|specific}. "no" means no checking,
-- "generic" means force the use of old-style checking, and
-- "specific" means use the best checking method.
if Name_Buffer (1 .. Name_Len) = "-fstack-check" then
if Name_Len >= 13
and then Name_Buffer (1 .. 13) = "-fstack-check"
and then Name_Buffer (1 .. Name_Len) /= "-fstack-check=no"
then
Stack_Check_Switch_Set := True;
end if;

14
gcc/ada/atree.adb
View File

@ -560,6 +560,20 @@ package body Atree is
(Nodes.Table (E + 2).Field12'Unrestricted_Access)).Convention := Val;
end Basic_Set_Convention;
--------------------------
-- Check_Error_Detected --
--------------------------
procedure Check_Error_Detected is
begin
-- An anomaly has been detected which is assumed to be a consequence of
-- a previous error. Raise an exception if no error found previously.
if Total_Errors_Detected = 0 then
raise Program_Error;
end if;
end Check_Error_Detected;
-----------------
-- Change_Node --
-----------------

30
gcc/ada/atree.ads
View File

@ -276,6 +276,36 @@ package Atree is
Current_Error_Node : Node_Id;
-- Node to place error messages
------------------
-- Error Counts --
------------------
-- The following variables denote the count of errors of various kinds
-- detected in the tree.
Serious_Errors_Detected : Nat := 0;
-- This is a count of errors that are serious enough to stop expansion,
-- and hence to prevent generation of an object file even if the
-- switch -gnatQ is set. Initialized to zero at the start of compilation.
-- Initialized for -gnatVa use, see comment above.
Total_Errors_Detected : Nat := 0;
-- Number of errors detected so far. Includes count of serious errors and
-- non-serious errors, so this value is always greater than or equal to the
-- Serious_Errors_Detected value. Initialized to zero at the start of
-- compilation. Initialized for -gnatVa use, see comment above.
Warnings_Detected : Nat := 0;
-- Number of warnings detected. Initialized to zero at the start of
-- compilation. Initialized for -gnatVa use, see comment above.
procedure Check_Error_Detected;
-- When an anomaly is found in the tree, many semantic routines silently
-- bail out, assuming that the anomaly was caused by a previously detected
-- error. This routine should be called in these cases, and will raise an
-- exception if no error has been detected. This ensure that the anomaly
-- is never allowed to go unnoticed.
-------------------------------
-- Default Setting of Fields --
-------------------------------

3
gcc/ada/einfo.adb
View File

@ -33,7 +33,6 @@ pragma Style_Checks (All_Checks);
-- Turn off subprogram ordering, not used for this unit
with Atree; use Atree;
with Errout; use Errout;
with Namet; use Namet;
with Nlists; use Nlists;
with Output; use Output;
@ -6981,7 +6980,7 @@ package body Einfo is
-- previous errors.
elsif No (Etyp) then
Cascaded_Error;
Check_Error_Detected;
return T;
elsif Is_Private_Type (T) and then Etyp = Full_View (T) then

22
gcc/ada/err_vars.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
@ -38,26 +38,6 @@ package Err_Vars is
-- been initialized, so we initialize some variables to avoid exceptions
-- from invalid values in such cases.
------------------
-- Error Counts --
------------------
Serious_Errors_Detected : Nat := 0;
-- This is a count of errors that are serious enough to stop expansion,
-- and hence to prevent generation of an object file even if the
-- switch -gnatQ is set. Initialized to zero at the start of compilation.
-- Initialized for -gnatVa use, see comment above.
Total_Errors_Detected : Nat := 0;
-- Number of errors detected so far. Includes count of serious errors and
-- non-serious errors, so this value is always greater than or equal to the
-- Serious_Errors_Detected value. Initialized to zero at the start of
-- compilation. Initialized for -gnatVa use, see comment above.
Warnings_Detected : Nat := 0;
-- Number of warnings detected. Initialized to zero at the start of
-- compilation. Initialized for -gnatVa use, see comment above.
----------------------------------
-- Error Message Mode Variables --
----------------------------------

18
gcc/ada/errout.adb
View File

@ -18,10 +18,6 @@
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
@ -202,20 +198,6 @@ package body Errout is
-- spec for precise definition of the conversion that is performed by this
-- routine in OpenVMS mode.
--------------------
-- Cascaded_Error --
--------------------
procedure Cascaded_Error is
begin
-- An anomaly has been detected which is assumed to be a consequence of
-- a previous error. Raise an exception if no error found previously.
if Total_Errors_Detected = 0 then
raise Program_Error;
end if;
end Cascaded_Error;
-----------------------
-- Change_Error_Text --
-----------------------

20
gcc/ada/errout.ads
View File

@ -39,19 +39,6 @@ with System;
package Errout is
Serious_Errors_Detected : Nat renames Err_Vars.Serious_Errors_Detected;
-- This is a count of errors that are serious enough to stop expansion,
-- and hence to prevent generation of an object file even if the switch
-- -gnatQ is set.
Total_Errors_Detected : Nat renames Err_Vars.Total_Errors_Detected;
-- Number of errors detected so far. Includes count of serious errors and
-- non-serious errors, so this value is always greater than or equal to
-- the Serious_Errors_Detected value.
Warnings_Detected : Nat renames Err_Vars.Warnings_Detected;
-- Number of warnings detected
Configurable_Run_Time_Violations : Nat := 0;
-- Count of configurable run time violations so far. This is used to
-- suppress certain cascaded error messages when we know that we may not
@ -727,13 +714,6 @@ package Errout is
-- This routine can only be called during semantic analysis. It may not
-- be called during parsing.
procedure Cascaded_Error;
-- When an anomaly is detected, many semantic routines silently bail out,
-- assuming that the anomaly was caused by a previously detected error.
-- This routine should be called in these cases, and will raise an
-- exception if no serious error has been detected. This ensure that the
-- anomaly is never allowed to go unnoticed.
procedure Change_Error_Text (Error_Id : Error_Msg_Id; New_Msg : String);
-- The error message text of the message identified by Id is replaced by
-- the given text. This text may contain insertion characters in the

3
gcc/ada/erroutc.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
@ -29,6 +29,7 @@
-- environment, and that in particular, no disallowed table expansion is
-- allowed to occur.
with Atree; use Atree;
with Casing; use Casing;
with Debug; use Debug;
with Err_Vars; use Err_Vars;

2
gcc/ada/erroutc.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --

3
gcc/ada/errutil.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1991-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1991-2012, 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- --
@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Err_Vars; use Err_Vars;
with Erroutc; use Erroutc;
with Namet; use Namet;

6
gcc/ada/errutil.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2002-2012, 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- --
@ -26,9 +26,7 @@
-- This package contains routines to output error messages and the
-- corresponding instantiation of Styleg, suitable to instantiate Scng.
-- It is not dependent on the GNAT tree packages (Atree, Sinfo, ...)
-- It uses the same global variables as Errout, located in package
-- It uses the same global variables as Errout, located in packages Atree and
-- Err_Vars. Like Errout, it also uses the common variables and routines
-- in package Erroutc.

1
gcc/ada/exp_ch13.adb
View File

@ -379,6 +379,7 @@ package body Exp_Ch13 is
-- This is an error protection against previous errors
if No (E_Scope) then
Check_Error_Detected;
return;
end if;

4
gcc/ada/exp_ch2.adb
View File

@ -28,7 +28,6 @@ with Checks; use Checks;
with Debug; use Debug;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
with Exp_Smem; use Exp_Smem;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
@ -341,7 +340,8 @@ package body Exp_Ch2 is
begin
-- Defend against errors
if No (E) and then Total_Errors_Detected /= 0 then
if No (E) then
Check_Error_Detected;
return;
end if;

1
gcc/ada/exp_ch6.adb
View File

@ -6227,6 +6227,7 @@ package body Exp_Ch6 is
if Present (Expression (N))
and then Nkind (Expression (N)) = N_Empty
then
Check_Error_Detected;
return;
end if;

1
gcc/ada/exp_dist.adb
View File

@ -26,7 +26,6 @@
with Atree; use Atree;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
with Exp_Atag; use Exp_Atag;
with Exp_Disp; use Exp_Disp;
with Exp_Strm; use Exp_Strm;

1
gcc/ada/expander.adb
View File

@ -25,7 +25,6 @@
with Atree; use Atree;
with Debug_A; use Debug_A;
with Errout; use Errout;
with Exp_Aggr; use Exp_Aggr;
with Exp_Alfa; use Exp_Alfa;
with Exp_Attr; use Exp_Attr;

5
gcc/ada/fe.h
View File

@ -80,6 +80,10 @@ extern Boolean Is_Entity_Name (Node_Id);
#define Get_Attribute_Definition_Clause einfo__get_attribute_definition_clause
extern Node_Id Get_Attribute_Definition_Clause (Entity_Id, char);
/* atree: */
#define Serious_Errors_Detected atree__serious_errors_detected
/* errout: */
#define Error_Msg_N errout__error_msg_n
@ -95,7 +99,6 @@ extern void Set_Identifier_Casing (Char *, const Char *);
#define Error_Msg_Node_2 err_vars__error_msg_node_2
#define Error_Msg_Uint_1 err_vars__error_msg_uint_1
#define Error_Msg_Uint_2 err_vars__error_msg_uint_2
#define Serious_Errors_Detected err_vars__serious_errors_detected
extern Entity_Id Error_Msg_Node_2;
extern Uint Error_Msg_Uint_1;

2
gcc/ada/fmap.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2012, 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- --

2
gcc/ada/fmap.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2012, 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- --

6
gcc/ada/gprep.adb
View File

@ -23,8 +23,8 @@
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Csets;
with Err_Vars; use Err_Vars;
with Errutil;
with Namet; use Namet;
with Opt;
@ -524,13 +524,13 @@ package body GPrep is
-- In verbose mode, if there is no error, report it
if Opt.Verbose_Mode and then Err_Vars.Total_Errors_Detected = 0 then
if Opt.Verbose_Mode and then Total_Errors_Detected = 0 then
Errutil.Finalize (Source_Type => "input");
end if;
-- If we had some errors, delete the output file, and report them
if Err_Vars.Total_Errors_Detected > 0 then
if Total_Errors_Detected > 0 then
if Outfile /= Standard_Output then
Delete (Text_Outfile);
end if;

1
gcc/ada/makeutl.adb
View File

@ -24,6 +24,7 @@
------------------------------------------------------------------------------
with ALI; use ALI;
with Atree; use Atree;
with Debug;
with Err_Vars; use Err_Vars;
with Errutil;

2
gcc/ada/par_sco.adb
View File

@ -969,7 +969,7 @@ package body Par_SCO is
-- The test here for zero is to deal with possible previous errors
if Index = 0 then
Cascaded_Error;
Check_Error_Detected;
else
declare

1
gcc/ada/prepcomp.adb
View File

@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Errout; use Errout;
with Lib.Writ; use Lib.Writ;
with Opt; use Opt;

3
gcc/ada/prj-part.adb
View File

@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Err_Vars; use Err_Vars;
with Opt; use Opt;
with Osint; use Osint;
@ -690,7 +691,7 @@ package body Prj.Part is
-- If there were any kind of error during the parsing, serious
-- or not, then the parsing fails.
if Err_Vars.Total_Errors_Detected > 0 then
if Total_Errors_Detected > 0 then
Project := Empty_Node;
end if;

5
gcc/ada/prj-proc.adb
View File

@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Err_Vars; use Err_Vars;
with Opt; use Opt;
with Osint; use Osint;
@ -2908,7 +2909,7 @@ package body Prj.Proc is
Process_Imported_Projects (Imported, Limited_With => True);
if Err_Vars.Total_Errors_Detected = 0 then
if Total_Errors_Detected = 0 then
Process_Aggregated_Projects;
end if;
@ -2938,7 +2939,7 @@ package body Prj.Proc is
end loop;
end if;
if Err_Vars.Total_Errors_Detected = 0 then
if Total_Errors_Detected = 0 then
-- For an aggregate library we add the aggregated projects
-- as imported ones. This is necessary to give visibility

2
gcc/ada/scng.adb
View File

@ -23,8 +23,8 @@
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Csets; use Csets;
with Err_Vars; use Err_Vars;
with Hostparm; use Hostparm;
with Namet; use Namet;
with Opt; use Opt;

2
gcc/ada/sdefault.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --

5
gcc/ada/sem_ch10.adb
View File

@ -725,6 +725,7 @@ package body Sem_Ch10 is
-- ignore the entire analysis effort
if No (Lib_Unit) then
Check_Error_Detected;
return;
else
@ -2677,7 +2678,7 @@ package body Sem_Ch10 is
-- Abandon processing in case of previous errors
if No (Par_Name) then
pragma Assert (Serious_Errors_Detected /= 0);
Check_Error_Detected;
return;
end if;
end loop;
@ -5105,7 +5106,7 @@ package body Sem_Ch10 is
-- Abandon processing in case of previous errors
if No (Scope (Uname)) then
pragma Assert (Serious_Errors_Detected /= 0);
Check_Error_Detected;
return;
end if;

22
gcc/ada/sem_ch13.adb
View File

@ -7292,9 +7292,8 @@ package body Sem_Ch13 is
-- clause in question, then there was some previous error for which
-- we already gave a message, so just return with Comp Empty.
if No (Comp)
or else Component_Clause (Comp) /= CC
then
if No (Comp) or else Component_Clause (Comp) /= CC then
Check_Error_Detected;
Comp := Empty;
-- Normal case where we have a component clause
@ -7897,15 +7896,22 @@ package body Sem_Ch13 is
end if;
end if;
-- Dismiss cases for generic types or types with previous errors
-- Dismiss generic types
if No (UT)
or else UT = Any_Type
or else Is_Generic_Type (UT)
or else Is_Generic_Type (Root_Type (UT))
if Is_Generic_Type (T)
or else
Is_Generic_Type (UT)
or else
Is_Generic_Type (Root_Type (UT))
then
return;
-- Guard against previous errors
elsif No (UT) or else UT = Any_Type then
Check_Error_Detected;
return;
-- Check case of bit packed array
elsif Is_Array_Type (UT)

3
gcc/ada/sem_ch2.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
@ -24,7 +24,6 @@
------------------------------------------------------------------------------
with Atree; use Atree;
with Errout; use Errout;
with Namet; use Namet;
with Opt; use Opt;
with Restrict; use Restrict;

1
gcc/ada/sem_ch3.adb
View File

@ -12078,6 +12078,7 @@ package body Sem_Ch3 is
-- Defend against previous errors
if No (Scalar_Range (Derived_Type)) then
Check_Error_Detected;
return;
end if;

10
gcc/ada/sem_ch4.adb
View File

@ -1921,6 +1921,7 @@ package body Sem_Ch4 is
-- Defend against error of missing expressions from previous error
if No (Then_Expr) then
Check_Error_Detected;
return;
end if;
@ -3917,8 +3918,7 @@ package body Sem_Ch4 is
-- subsequent semantic checks might examine the original node.
Set_Entity (Sel, Comp);
Rewrite (Selector_Name (N),
New_Occurrence_Of (Comp, Sloc (N)));
Rewrite (Selector_Name (N), New_Occurrence_Of (Comp, Sloc (N)));
Set_Original_Discriminant (Selector_Name (N), Comp);
Set_Etype (N, Etype (Comp));
Check_Implicit_Dereference (N, Etype (Comp));
@ -3930,9 +3930,9 @@ package body Sem_Ch4 is
elsif Is_Record_Type (Prefix_Type) then
-- Find component with given name
-- In an instance, if the node is known as a prefixed call, do
-- not examine components whose visibility may be accidental.
-- Find component with given name. In an instance, if the node is
-- known as a prefixed call, do not examine components whose
-- visibility may be accidental.
while Present (Comp) and then not Is_Prefixed_Call (N) loop
if Chars (Comp) = Chars (Sel)

9
gcc/ada/sem_ch5.adb
View File

@ -898,6 +898,7 @@ package body Sem_Ch5 is
-- up, and we just return immediately (defence against previous errors).
if No (HSS) then
Check_Error_Detected;
return;
end if;
@ -942,11 +943,8 @@ package body Sem_Ch5 is
-- identifier and continue, otherwise raise an exception.
if No (Ent) then
if Total_Errors_Detected /= 0 then
Set_Identifier (N, Empty);
else
raise Program_Error;
end if;
Check_Error_Detected;
Set_Identifier (N, Empty);
else
Set_Ekind (Ent, E_Block);
@ -1398,6 +1396,7 @@ package body Sem_Ch5 is
-- Ignore previous error
if Label_Ent = Any_Id then
Check_Error_Detected;
return;
-- We just have a label as the target of a goto

4
gcc/ada/sem_ch9.adb
View File

@ -2094,7 +2094,9 @@ package body Sem_Ch9 is
-- Pragma case
elsif Pragma_Name (Prio_Item) = Name_Priority then
elsif Nkind (Prio_Item) = N_Pragma
and then Pragma_Name (Prio_Item) = Name_Priority
then
Error_Msg_N ("?pragma Interrupt_Priority is preferred "
& "in presence of handlers", Prio_Item);
end if;

2
gcc/ada/sem_dim.adb
View File

@ -1634,7 +1634,7 @@ package body Sem_Dim is
-- the call was aborted due to a previous error.
if No (Actual) then
Cascaded_Error;
Check_Error_Detected;
return;
end if;

1
gcc/ada/sem_elab.adb
View File

@ -828,6 +828,7 @@ package body Sem_Elab is
-- If no alias, there is a previous error
if No (Ent) then
Check_Error_Detected;
return;
end if;
end loop;

9
gcc/ada/sem_eval.adb
View File

@ -1294,10 +1294,13 @@ package body Sem_Eval is
begin
-- Never known at compile time if bad type or raises constraint error
-- or empty (latter case occurs only as a result of a previous error)
-- or empty (latter case occurs only as a result of a previous error).
if No (Op)
or else Op = Error
if No (Op) then
Check_Error_Detected;
return False;
elsif Op = Error
or else Etype (Op) = Any_Type
or else Raises_Constraint_Error (Op)
then

4
gcc/ada/sem_intr.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
@ -271,7 +271,9 @@ package body Sem_Intr is
-- Return if previous error in declaration, otherwise get T2 type
if No (Next_Formal (First_Formal (E))) then
Check_Error_Detected;
return;
else
T2 := Etype (Next_Formal (First_Formal (E)));
end if;

2
gcc/ada/sem_prag.adb
View File

@ -5059,7 +5059,7 @@ package body Sem_Prag is
-- If previous error, avoid cascaded errors
Cascaded_Error;
Check_Error_Detected;
Applies := True;
Effective := True;

7
gcc/ada/sem_type.adb
View File

@ -906,9 +906,10 @@ package body Sem_Type is
-- covers an object T2 that implements a direct derivation of T1.
-- Note: test for presence of E is defense against previous error.
if Present (E)
and then Present (Interfaces (E))
then
if No (E) then
Check_Error_Detected;
elsif Present (Interfaces (E)) then
Elmt := First_Elmt (Interfaces (E));
while Present (Elmt) loop
if Is_Ancestor (Etype (T1), Node (Elmt)) then

3
gcc/ada/sem_warn.adb
View File

@ -619,6 +619,7 @@ package body Sem_Warn is
if No (Entity (Ident))
or else Ekind (Entity (Ident)) /= E_Loop
then
Check_Error_Detected;
return;
end if;
@ -3317,7 +3318,7 @@ package body Sem_Warn is
or else
Denotes_Same_Prefix (Act1, Act2))
then
-- Exclude generic types and guard against previous errors.
-- Exclude generic types and guard against previous errors
if Error_Posted (N)
or else No (Etype (Act1))

2
gcc/ada/stylesw.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --