* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@193235
138bc75d-0d04-0410-961f-
82ee72b054a4
+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.
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;
(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 --
-----------------
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 --
-------------------------------
-- 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;
-- 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
-- --
-- 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- --
-- 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 --
----------------------------------
-- 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. --
-- --
-- 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 --
-----------------------
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
-- 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
-- --
-- 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- --
-- 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;
-- --
-- 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- --
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
+with Atree; use Atree;
with Err_Vars; use Err_Vars;
with Erroutc; use Erroutc;
with Namet; use Namet;
-- --
-- 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- --
-- 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.
-- This is an error protection against previous errors
if No (E_Scope) then
+ Check_Error_Detected;
return;
end if;
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;
begin
-- Defend against errors
- if No (E) and then Total_Errors_Detected /= 0 then
+ if No (E) then
+ Check_Error_Detected;
return;
end if;
if Present (Expression (N))
and then Nkind (Expression (N)) = N_Empty
then
+ Check_Error_Detected;
return;
end if;
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;
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;
#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
#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;
-- --
-- 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- --
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
+with Atree; use Atree;
with Csets;
-with Err_Vars; use Err_Vars;
with Errutil;
with Namet; use Namet;
with Opt;
-- 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;
------------------------------------------------------------------------------
with ALI; use ALI;
+with Atree; use Atree;
with Debug;
with Err_Vars; use Err_Vars;
with Errutil;
-- The test here for zero is to deal with possible previous errors
if Index = 0 then
- Cascaded_Error;
+ Check_Error_Detected;
else
declare
-- --
------------------------------------------------------------------------------
+with Atree; use Atree;
with Errout; use Errout;
with Lib.Writ; use Lib.Writ;
with Opt; use Opt;
-- --
------------------------------------------------------------------------------
+with Atree; use Atree;
with Err_Vars; use Err_Vars;
with Opt; use Opt;
with Osint; use Osint;
-- 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;
-- --
------------------------------------------------------------------------------
+with Atree; use Atree;
with Err_Vars; use Err_Vars;
with Opt; use Opt;
with Osint; use Osint;
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;
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
-- --
------------------------------------------------------------------------------
+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;
-- --
-- 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- --
-- ignore the entire analysis effort
if No (Lib_Unit) then
+ Check_Error_Detected;
return;
else
-- 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;
-- Abandon processing in case of previous errors
if No (Scope (Uname)) then
- pragma Assert (Serious_Errors_Detected /= 0);
+ Check_Error_Detected;
return;
end if;
-- 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
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)
-- --
-- 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- --
------------------------------------------------------------------------------
with Atree; use Atree;
-with Errout; use Errout;
with Namet; use Namet;
with Opt; use Opt;
with Restrict; use Restrict;
-- Defend against previous errors
if No (Scalar_Range (Derived_Type)) then
+ Check_Error_Detected;
return;
end if;
-- Defend against error of missing expressions from previous error
if No (Then_Expr) then
+ Check_Error_Detected;
return;
end if;
-- 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));
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)
-- up, and we just return immediately (defence against previous errors).
if No (HSS) then
+ Check_Error_Detected;
return;
end if;
-- 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);
-- Ignore previous error
if Label_Ent = Any_Id then
+ Check_Error_Detected;
return;
-- We just have a label as the target of a goto
-- 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;
-- the call was aborted due to a previous error.
if No (Actual) then
- Cascaded_Error;
+ Check_Error_Detected;
return;
end if;
-- If no alias, there is a previous error
if No (Ent) then
+ Check_Error_Detected;
return;
end if;
end loop;
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
-- --
-- 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- --
-- 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;
-- If previous error, avoid cascaded errors
- Cascaded_Error;
+ Check_Error_Detected;
Applies := True;
Effective := True;
-- 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
if No (Entity (Ident))
or else Ekind (Entity (Ident)) /= E_Loop
then
+ Check_Error_Detected;
return;
end if;
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))
-- --
-- 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- --
projects / platform / upstream / linaro-gcc.git / commitdiff