* config/vax/vax.h (target_flags, MASK_UNIX_ASM, MASK_VAXC_ALIGNMENT)

[pf3gnuchains/gcc-fork.git] / gcc / ada / par-endh.adb

diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb
index 57561aa..2aabe2f 100644 (file)
--- a/gcc/ada/par-endh.adb
+++ b/gcc/ada/par-endh.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2001, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2002, 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- --
@@ -114,12 +114,17 @@ package body Endh is
    -- Local Subprograms --
    -----------------------
 
-   procedure Evaluate_End_Entry (SS_Index : Int);
+   procedure Evaluate_End_Entry (SS_Index : Nat);
    --  Compare scanned END entry (as recorded by a prior call to P_End_Scan)
    --  with a specified entry in the scope stack (the single parameter is the
    --  entry index in the scope stack). Note that Scan is not called. The above
    --  variables xxx_OK are set to indicate the result of the evaluation.
 
+   function Explicit_Start_Label (SS_Index : Nat) return Boolean;
+   --  Determines whether the specified entry in the scope stack has an
+   --  explicit start label (i.e. one other than one that was created by
+   --  the parser when no explicit label was present)
+
    procedure Output_End_Deleted;
    --  Output a message complaining that the current END structure does not
    --  match anything and is being deleted.
@@ -298,7 +303,7 @@ package body Endh is
                   --  Case of child unit name
 
                   if Nkind (End_Labl) = N_Defining_Program_Unit_Name then
-                     declare
+                     Child_End : declare
                         Eref : constant Node_Id :=
                                  Make_Identifier (Token_Ptr,
                                    Chars =>
@@ -307,6 +312,10 @@ package body Endh is
                         function Copy_Name (N : Node_Id) return Node_Id;
                         --  Copies a selected component or identifier
 
+                        ---------------
+                        -- Copy_Name --
+                        ---------------
+
                         function Copy_Name (N : Node_Id) return Node_Id is
                            R : Node_Id;
 
@@ -328,6 +337,8 @@ package body Endh is
                            end if;
                         end Copy_Name;
 
+                     --  Start of processing for Child_End
+
                      begin
                         Set_Comes_From_Source (Eref, False);
 
@@ -335,7 +346,7 @@ package body Endh is
                           Make_Designator (Token_Ptr,
                             Name       => Copy_Name (Name (End_Labl)),
                             Identifier => Eref);
-                     end;
+                     end Child_End;
 
                   --  Simple identifier case
 
@@ -364,7 +375,7 @@ package body Endh is
 
                   if Style_Check
                     and then End_Type = E_Name
-                    and then Present (Scope.Table (Scope.Last).Labl)
+                    and then Explicit_Start_Label (Scope.Last)
                   then
                      Style.No_End_Name (Scope.Table (Scope.Last).Labl);
                   end if;
@@ -655,7 +666,7 @@ package body Endh is
    -- Evaluate End Entry --
    ------------------------
 
-   procedure Evaluate_End_Entry (SS_Index : Int) is
+   procedure Evaluate_End_Entry (SS_Index : Nat) is
    begin
       Column_OK := (End_Column = Scope.Table (SS_Index).Ecol);
 
@@ -692,6 +703,7 @@ package body Endh is
 
          begin
             if Nkind (End_Labl) in N_Has_Chars
+              and then Comes_From_Source (Nam)
               and then Nkind (Nam) in N_Has_Chars
               and then Chars (End_Labl) > Error_Name
               and then Chars (Nam) > Error_Name
@@ -701,7 +713,8 @@ package body Endh is
 
                if Error_Msg_Name_1 > Error_Name then
                   declare
-                     S : String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
+                     S : constant String (1 .. Name_Len) :=
+                           Name_Buffer (1 .. Name_Len);
 
                   begin
                      Get_Name_String (Error_Msg_Name_1);
@@ -724,13 +737,14 @@ package body Endh is
       --  case, this is acceptable only if the loop is unlabeled.
 
       elsif End_Type = E_Loop then
-         Syntax_OK := (Scope.Table (SS_Index).Labl = Empty);
+         Syntax_OK := not Explicit_Start_Label (SS_Index);
 
       --  Cases where a label is definitely allowed on the END line
 
       elsif End_Type = E_Name then
-         Syntax_OK := (Scope.Table (SS_Index).Labl = Empty or else
-                         not Scope.Table (SS_Index).Lreq);
+         Syntax_OK := (not Explicit_Start_Label (SS_Index))
+                         or else
+                      (not Scope.Table (SS_Index).Lreq);
 
       --  Otherwise we have cases which don't allow labels anyway, so we
       --  certainly accept an END which does not have a label.
@@ -740,6 +754,23 @@ package body Endh is
       end if;
    end Evaluate_End_Entry;
 
+   --------------------------
+   -- Explicit_Start_Label --
+   --------------------------
+
+   function Explicit_Start_Label (SS_Index : Nat) return Boolean is
+      L : constant Node_Id := Scope.Table (SS_Index).Labl;
+
+   begin
+      if No (L) then
+         return False;
+      elsif Comes_From_Source (L) then
+         return True;
+      else
+         return False;
+      end if;
+   end Explicit_Start_Label;
+
    ------------------------
    -- Output End Deleted --
    ------------------------
@@ -784,9 +815,14 @@ package body Endh is
 
       End_Type := Scope.Table (Scope.Last).Etyp;
       Error_Msg_Col    := Scope.Table (Scope.Last).Ecol;
-      Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
       Error_Msg_Sloc   := Scope.Table (Scope.Last).Sloc;
 
+      if Explicit_Start_Label (Scope.Last) then
+         Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
+      else
+         Error_Msg_Node_1 := Empty;
+      end if;
+
       --  Suppress message if error was posted on opening label
 
       if Error_Msg_Node_1 > Empty_Or_Error
@@ -853,9 +889,14 @@ package body Endh is
       end if;
 
       End_Type := Scope.Table (Scope.Last).Etyp;
-      Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
       Error_Msg_Sloc   := Scope.Table (Scope.Last).Sloc;
 
+      if Explicit_Start_Label (Scope.Last) then
+         Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
+      else
+         Error_Msg_Node_1 := Empty;
+      end if;
+
       if End_Type = E_Case then
          Error_Msg_BC ("missing `END CASE;` for CASE#!");
 
@@ -1014,9 +1055,9 @@ package body Endh is
                        and then
                          (Scope.Last = 1
                             or else
-                              (No (Scope.Table (Scope.Last - 1).Labl)
-                                or else
-                               not Same_Label
+                              (not Explicit_Start_Label (Scope.Last - 1))
+                                 or else
+                              (not Same_Label
                                      (End_Labl,
                                       Scope.Table (Scope.Last - 1).Labl)))
                      then