From ee2ba85639333f03774668c5a4b25d7ae08b1036 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 6 Nov 2012 12:28:27 +0100 Subject: [multiple changes] 2012-11-06 Tristan Gingold * sem_ch9.adb (Analyze_Protected_Type_Declaration): Fix thinko in previous commit. 2012-11-06 Jose Ruiz * ali.adb (Scan_ALI): Fix parsing mechanism for -fstack-check. 2012-11-06 Thomas Quinot * 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 --- gcc/ada/ChangeLog | 24 ++++++++++++++++++++++++ gcc/ada/ali.adb | 13 ++++++++++--- gcc/ada/atree.adb | 14 ++++++++++++++ gcc/ada/atree.ads | 30 ++++++++++++++++++++++++++++++ gcc/ada/einfo.adb | 3 +-- gcc/ada/err_vars.ads | 22 +--------------------- gcc/ada/errout.adb | 18 ------------------ gcc/ada/errout.ads | 20 -------------------- gcc/ada/erroutc.adb | 3 ++- gcc/ada/erroutc.ads | 2 +- gcc/ada/errutil.adb | 3 ++- gcc/ada/errutil.ads | 6 ++---- gcc/ada/exp_ch13.adb | 1 + gcc/ada/exp_ch2.adb | 4 ++-- gcc/ada/exp_ch6.adb | 1 + gcc/ada/exp_dist.adb | 1 - gcc/ada/expander.adb | 1 - gcc/ada/fe.h | 5 ++++- gcc/ada/fmap.adb | 2 +- gcc/ada/fmap.ads | 2 +- gcc/ada/gprep.adb | 6 +++--- gcc/ada/makeutl.adb | 1 + gcc/ada/par_sco.adb | 2 +- gcc/ada/prepcomp.adb | 1 + gcc/ada/prj-part.adb | 3 ++- gcc/ada/prj-proc.adb | 5 +++-- gcc/ada/scng.adb | 2 +- gcc/ada/sdefault.ads | 2 +- gcc/ada/sem_ch10.adb | 5 +++-- gcc/ada/sem_ch13.adb | 22 ++++++++++++++-------- gcc/ada/sem_ch2.adb | 3 +-- gcc/ada/sem_ch3.adb | 1 + gcc/ada/sem_ch4.adb | 10 +++++----- gcc/ada/sem_ch5.adb | 9 ++++----- gcc/ada/sem_ch9.adb | 4 +++- gcc/ada/sem_dim.adb | 2 +- gcc/ada/sem_elab.adb | 1 + gcc/ada/sem_eval.adb | 9 ++++++--- gcc/ada/sem_intr.adb | 4 +++- gcc/ada/sem_prag.adb | 2 +- gcc/ada/sem_type.adb | 7 ++++--- gcc/ada/sem_warn.adb | 3 ++- gcc/ada/stylesw.adb | 2 +- 43 files changed, 160 insertions(+), 121 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index aec3b4f..379a4a1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2012-11-06 Tristan Gingold + + * sem_ch9.adb (Analyze_Protected_Type_Declaration): Fix thinko + in previous commit. + +2012-11-06 Jose Ruiz + + * ali.adb (Scan_ALI): Fix parsing mechanism for -fstack-check. + +2012-11-06 Thomas Quinot + + * 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 * exp_ch4.adb: Minor comment change. diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index a85fa4b..0386c05 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -970,9 +970,16 @@ package body ALI is Add_Char_To_Name_Buffer (Getc); end loop; - -- If -fstack-check, record that it occurred - - if Name_Buffer (1 .. Name_Len) = "-fstack-check" then + -- 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_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; diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index dce76e9..70dd380 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -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 -- ----------------- diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 305ef9f..0829d4d 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -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 -- ------------------------------- diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 7e3073e..2128497 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -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 diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads index e17e1fe..58355cc 100644 --- a/gcc/ada/err_vars.ads +++ b/gcc/ada/err_vars.ads @@ -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 -- ---------------------------------- diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 48bbc98..6f45020 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -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 -- ----------------------- diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 7da6493..2c6ab7d 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -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 diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index f58a49a..56a4e35 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -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; diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads index 6c077b0..fc5cfa9 100644 --- a/gcc/ada/erroutc.ads +++ b/gcc/ada/erroutc.ads @@ -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- -- diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb index cf6e9ef..d6fa960 100644 --- a/gcc/ada/errutil.adb +++ b/gcc/ada/errutil.adb @@ -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; diff --git a/gcc/ada/errutil.ads b/gcc/ada/errutil.ads index 91ac4f1..fa6ad53 100644 --- a/gcc/ada/errutil.ads +++ b/gcc/ada/errutil.ads @@ -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. diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb index 26eaec2..141e144 100644 --- a/gcc/ada/exp_ch13.adb +++ b/gcc/ada/exp_ch13.adb @@ -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; diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb index 64e561c..b93f832 100644 --- a/gcc/ada/exp_ch2.adb +++ b/gcc/ada/exp_ch2.adb @@ -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; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 8d9ef9b..c3cf8c8 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -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; diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index cf8243e..c2396c1 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -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; diff --git a/gcc/ada/expander.adb b/gcc/ada/expander.adb index af367d9..83a6920 100644 --- a/gcc/ada/expander.adb +++ b/gcc/ada/expander.adb @@ -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; diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index f8d399c..fe52233 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -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; diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb index 171f7a1..f543209 100644 --- a/gcc/ada/fmap.adb +++ b/gcc/ada/fmap.adb @@ -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- -- diff --git a/gcc/ada/fmap.ads b/gcc/ada/fmap.ads index f1d54db..19aa069 100644 --- a/gcc/ada/fmap.ads +++ b/gcc/ada/fmap.ads @@ -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- -- diff --git a/gcc/ada/gprep.adb b/gcc/ada/gprep.adb index 0fad22b..8eb1465 100644 --- a/gcc/ada/gprep.adb +++ b/gcc/ada/gprep.adb @@ -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; diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index a2ea435..b2a6d53 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -24,6 +24,7 @@ ------------------------------------------------------------------------------ with ALI; use ALI; +with Atree; use Atree; with Debug; with Err_Vars; use Err_Vars; with Errutil; diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index cec2afe..2fdd6c5 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -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 diff --git a/gcc/ada/prepcomp.adb b/gcc/ada/prepcomp.adb index dd64bcb..2cc1c5e 100644 --- a/gcc/ada/prepcomp.adb +++ b/gcc/ada/prepcomp.adb @@ -23,6 +23,7 @@ -- -- ------------------------------------------------------------------------------ +with Atree; use Atree; with Errout; use Errout; with Lib.Writ; use Lib.Writ; with Opt; use Opt; diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index f1166af..5d09dbe 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -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; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index cb9d533..dc745fe 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -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 diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index ce644bc..e27c91d 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -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; diff --git a/gcc/ada/sdefault.ads b/gcc/ada/sdefault.ads index 21745fb..492e7b7 100644 --- a/gcc/ada/sdefault.ads +++ b/gcc/ada/sdefault.ads @@ -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- -- diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 0a90eb2..2f203dc 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -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; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 51edb64..cdddfa8 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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) diff --git a/gcc/ada/sem_ch2.adb b/gcc/ada/sem_ch2.adb index efa965e..f20a518 100644 --- a/gcc/ada/sem_ch2.adb +++ b/gcc/ada/sem_ch2.adb @@ -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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index a3b7f3e..e6f76e2 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 9d63e88..10fd386 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -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) diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index b062be9..bf1eceb 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -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 diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 8f6e4d7..9b38f00 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -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; diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index 9b9de0a..0e46efa 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -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; diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 34aa691..6d88c96 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -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; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 3434854..cf2a922 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -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 diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb index f650be9..93eb492 100644 --- a/gcc/ada/sem_intr.adb +++ b/gcc/ada/sem_intr.adb @@ -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; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 4ca5285..ed9af8f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5059,7 +5059,7 @@ package body Sem_Prag is -- If previous error, avoid cascaded errors - Cascaded_Error; + Check_Error_Detected; Applies := True; Effective := True; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 0c46536..41d9a62 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -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 diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 34bc458..53ad631 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -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)) diff --git a/gcc/ada/stylesw.adb b/gcc/ada/stylesw.adb index cce2b8f..886043b 100644 --- a/gcc/ada/stylesw.adb +++ b/gcc/ada/stylesw.adb @@ -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- -- -- cgit v1.1