errout.adb (Error_Msg): Ignore attempt to put error msg at junk location if we alread...

	* errout.adb (Error_Msg): Ignore attempt to put error msg at junk
	location if we already have errors. Stops some cases of cascaded
	errors.

	* errout.adb: Improve comment.

From-SVN: r47653

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3153721082247b0cbf9d7e3040b2d3c70100ea67..6e607f24409f571db4e1ff5f33c3d65e7f7c22d7 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2001-12-04  Robert Dewar <dewar@gnat.com>
+
+       * errout.adb (Error_Msg): Ignore attempt to put error msg at junk 
+       location if we already have errors. Stops some cases of cascaded 
+       errors.
+       
+       * errout.adb: Improve comment.
+
 2001-12-04  Robert Dewar <dewar@gnat.com>
 
        * sem_ch12.adb:

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 74fc82124c76a4c58ac3ddc40b4b7eb1542899b2..d78858c42cdb852914ff3c5a0d6e1c9743832d12 100644 (file)
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -665,15 +665,26 @@ package body Errout is
    --  additional messages referencing the generic declaration.
 
    procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
-
-      Sindex : constant Source_File_Index :=
-                 Get_Source_File_Index (Flag_Location);
+      Sindex : Source_File_Index;
+      --  Source index for flag location
 
       Orig_Loc : Source_Ptr;
       --  Original location of Flag_Location (i.e. location in original
       --  template in instantiation case, otherwise unchanged).
 
    begin
+      --  If we already have messages, and we are trying to place a message
+      --  at No_Location or in package Standard, then just ignore the attempt
+      --  since we assume that what is happening is some cascaded junk. Note
+      --  that this is safe in the sense that proceeding will surely bomb.
+
+      if Flag_Location < First_Source_Ptr
+        and then Errors_Detected > 0
+      then
+         return;
+      end if;
+
+      Sindex := Get_Source_File_Index (Flag_Location);
       Test_Warning_Msg (Msg);
 
       --  It is a fatal error to issue an error message when scanning from
@@ -3069,11 +3080,10 @@ package body Errout is
             Ent := Etype (Ent);
          end if;
 
-         --  If we are stuck in a loop, get out and settle for the
-         --  internal name after all. In this case we set to kill the
-         --  message if it is not the first error message (we really try
-         --  hard not to show the dirty laundry of the implementation to
-         --  the poor user!)
+         --  If we are stuck in a loop, get out and settle for the internal
+         --  name after all. In this case we set to kill the message if it
+         --  is not the first error message (we really try hard not to show
+         --  the dirty laundry of the implementation to the poor user!)
 
          if Ent = Old_Ent then
             Kill_Message := True;