[multiple changes]

2010-10-12  Robert Dewar  <dewar@adacore.com>

	* par-endh.adb (Check_End): Don't swallow semicolon or aspects after
	END RECORD.
	* sem_attr.adb (Eval_Attribute): Code clean up.

2010-10-12  Robert Dewar  <dewar@adacore.com>

	* par-ch12.adb (P_Formal_Private_Type_Definition): Improve error
	messages and recovery for case of out of order Abstract/Tagged/Private
	keywords.
	* par-ch3.adb (P_Type_Declaration): Improve error messages and recovery
	for case of out of order Abstract/Tagged/Private keywords.

2010-10-12  Ed Schonberg  <schonberg@adacore.com>

	* inline.adb (Analyze_Inlined_Bodies): Restrict previous change to case
	where child unit is main unit of compilation.

From-SVN: r165354

6 files changed, 125 insertions, 79 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9f1aff0..02f1e54 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,24 @@
 2010-10-12  Robert Dewar  <dewar@adacore.com>
 
+	* par-endh.adb (Check_End): Don't swallow semicolon or aspects after
+	END RECORD.
+	* sem_attr.adb (Eval_Attribute): Code clean up.
+
+2010-10-12  Robert Dewar  <dewar@adacore.com>
+
+	* par-ch12.adb (P_Formal_Private_Type_Definition): Improve error
+	messages and recovery for case of out of order Abstract/Tagged/Private
+	keywords.
+	* par-ch3.adb (P_Type_Declaration): Improve error messages and recovery
+	for case of out of order Abstract/Tagged/Private keywords.
+
+2010-10-12  Ed Schonberg  <schonberg@adacore.com>
+
+	* inline.adb (Analyze_Inlined_Bodies): Restrict previous change to case
+	where child unit is main unit of compilation.
+
+2010-10-12  Robert Dewar  <dewar@adacore.com>
+
 	* aspects.ads, aspects.adb (Move_Aspects): New procedure.
 	* atree.ads, atree.adb: (New_Copy): Does not copy aspect specifications
 	* sinfo.ads, par-ch3.adb, par-ch6.adb, par-ch7.adb, par-ch9.adb,
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index f7e2b30..e537144 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -626,19 +626,19 @@ package body Inline is
       Pack      : Entity_Id;
       S         : Succ_Index;
 
-      function Is_Ancestor
+      function Is_Ancestor_Of_Main
         (U_Name : Entity_Id;
          Nam    : Node_Id) return Boolean;
       --  Determine whether the unit whose body is loaded is an ancestor of
-      --  a unit mentioned in a with_clause of that body. The body is not
+      --  the main unit, and has a with_clause on it. The body is not
       --  analyzed yet, so the check is purely lexical: the name of the with
       --  clause is a selected component, and names of ancestors must match.
 
-      -----------------
-      -- Is_Ancestor --
-      -----------------
+      -------------------------
+      -- Is_Ancestor_Of_Main --
+      -------------------------
 
-      function Is_Ancestor
+      function Is_Ancestor_Of_Main
         (U_Name : Entity_Id;
          Nam    : Node_Id) return Boolean
       is
@@ -649,6 +649,12 @@ package body Inline is
             return False;
 
          else
+            if Chars (Selector_Name (Nam)) /=
+               Chars (Cunit_Entity (Main_Unit))
+            then
+               return False;
+            end if;
+
             Pref := Prefix (Nam);
             if Nkind (Pref) = N_Identifier then
 
@@ -666,10 +672,10 @@ package body Inline is
             else
                --  A is an ancestor of A.B.C if it is an ancestor of A.B
 
-               return Is_Ancestor (U_Name, Pref);
+               return Is_Ancestor_Of_Main (U_Name, Pref);
             end if;
          end if;
-      end Is_Ancestor;
+      end Is_Ancestor_Of_Main;
 
    --  Start of processing for  Analyze_Inlined_Bodies
 
@@ -751,7 +757,8 @@ package body Inline is
                            Item := First (Context_Items (Body_Unit));
                            while Present (Item) loop
                               if Nkind (Item) = N_With_Clause
-                                and then Is_Ancestor (U_Id, Name (Item))
+                                and then
+                                  Is_Ancestor_Of_Main (U_Id, Name (Item))
                               then
                                  Set_Is_Inlined (U_Id, False);
                                  exit;
diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb
index 81f5e25..20dfde9 100644
--- a/gcc/ada/par-ch12.adb
+++ b/gcc/ada/par-ch12.adb
@@ -834,6 +834,20 @@ package body Ch12 is
 
       Set_Sloc (Def_Node, Token_Ptr);
       T_Private;
+
+      if Token = Tok_Tagged then -- CODEFIX
+         Error_Msg_SC ("TAGGED must come before PRIVATE");
+         Scan; -- past TAGGED
+
+      elsif Token = Tok_Abstract then -- CODEFIX
+         Error_Msg_SC ("`ABSTRACT TAGGED` must come before PRIVATE");
+         Scan; -- past ABSTRACT
+
+         if Token = Tok_Tagged then
+            Scan; -- past TAGGED
+         end if;
+      end if;
+
       return Def_Node;
    end P_Formal_Private_Type_Definition;
 
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index 9cca962..27a9cfc 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -309,11 +309,11 @@ package body Ch3 is
 
    --  Error recovery: can raise Error_Resync
 
-   --  Note: The processing for full type declaration, incomplete type
-   --  declaration, private type declaration and type definition is
-   --  included in this function. The processing for concurrent type
-   --  declarations is NOT here, but rather in chapter 9 (i.e. this
-   --  function handles only declarations starting with TYPE).
+   --  The processing for full type declarations, incomplete type declarations,
+   --  private type declarations and type definitions is included in this
+   --  function. The processing for concurrent type declarations is NOT here,
+   --  but rather in chapter 9 (this function handles only declarations
+   --  starting with TYPE).
 
    function P_Type_Declaration return Node_Id is
       Abstract_Present : Boolean := False;
@@ -770,6 +770,22 @@ package body Ch3 is
             when Tok_Private =>
                Decl_Node := New_Node (N_Private_Type_Declaration, Type_Loc);
                Scan; -- past PRIVATE
+
+               --  Check error cases of private [abstract] tagged
+
+               if Token = Tok_Abstract then
+                  Error_Msg_SC ("`ABSTRACT TAGGED` must come before PRIVATE");
+                  Scan; -- past ABSTRACT
+
+                  if Token = Tok_Tagged then
+                     Scan; -- past TAGGED
+                  end if;
+
+               elsif Token = Tok_Tagged then
+                  Error_Msg_SC ("TAGGED must come before PRIVATE");
+                  Scan; -- past TAGGED
+               end if;
+
                exit;
 
             --  Ada 2005 (AI-345): Protected, synchronized or task interface
diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb
index 6e12a17..8bb75f8 100644
--- a/gcc/ada/par-endh.adb
+++ b/gcc/ada/par-endh.adb
@@ -387,48 +387,51 @@ package body Endh is
             end if;
          end if;
 
-         --  Scan aspect specifications if permitted here
+         --  Deal with terminating aspect specifications and following semi-
+         --  colon. We skip this in the case of END RECORD, since in this
+         --  case the aspect specifications and semicolon are handled at
+         --  a higher level.
 
-         if Aspect_Specifications_Present then
-            if No (Decl) then
-               P_Aspect_Specifications (Error);
-            else
-               P_Aspect_Specifications (Decl);
-            end if;
+         if End_Type /= E_Record then
 
-         --  Except in case of END RECORD, semicolon must follow. For END
-         --  RECORD, a semicolon does follow, but it is part of a higher level
-         --  construct. In any case, a missing semicolon is not serious enough
-         --  to consider the END statement to be bad in the sense that we
-         --  are dealing with (i.e. to be suspicious that it is not in fact
-         --  the END statement we are looking for!)
-
-         elsif End_Type /= E_Record then
-            if Token = Tok_Semicolon then
-               T_Semicolon;
-
-            --  Semicolon is missing. If the missing semicolon is at the end
-            --  of the line, i.e. we are at the start of the line now, then
-            --  a missing semicolon gets flagged, but is not serious enough
-            --  to consider the END statement to be bad in the sense that we
-            --  are dealing with (i.e. to be suspicious that this END is not
-            --  the END statement we are looking for).
-
-            --  Similarly, if we are at a colon, we flag it but a colon for
-            --  a semicolon is not serious enough to consider the END to be
-            --  incorrect. Same thing for a period in place of a semicolon.
-
-            elsif Token_Is_At_Start_Of_Line
-              or else Token = Tok_Colon
-              or else Token = Tok_Dot
-            then
-               T_Semicolon;
+            --  Scan aspect specifications if permitted here
+
+            if Aspect_Specifications_Present then
+               if No (Decl) then
+                  P_Aspect_Specifications (Error);
+               else
+                  P_Aspect_Specifications (Decl);
+               end if;
 
-            --  If the missing semicolon is not at the start of the line,
-            --  then we do consider the END line to be dubious in this sense.
+            --  If no aspect specifications, must have a semicolon
 
-            else
-               End_OK := False;
+            elsif End_Type /= E_Record then
+               if Token = Tok_Semicolon then
+                  T_Semicolon;
+
+               --  Semicolon is missing. If the missing semicolon is at the end
+               --  of the line, i.e. we are at the start of the line now, then
+               --  a missing semicolon gets flagged, but is not serious enough
+               --  to consider the END statement to be bad in the sense that we
+               --  are dealing with (i.e. to be suspicious that this END is not
+               --  the END statement we are looking for).
+
+               --  Similarly, if we are at a colon, we flag it but a colon for
+               --  a semicolon is not serious enough to consider the END to be
+               --  incorrect. Same thing for a period in place of a semicolon.
+
+               elsif Token_Is_At_Start_Of_Line
+                 or else Token = Tok_Colon
+                 or else Token = Tok_Dot
+               then
+                  T_Semicolon;
+
+               --  If the missing semicolon is not at the start of the line,
+               --  then we consider the END line to be dubious in this sense.
+
+               else
+                  End_OK := False;
+               end if;
             end if;
          end if;
       end if;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 469e77c..3c8a03d 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -5375,33 +5375,20 @@ package body Sem_Attr is
       --  constructs from this test comes from some internal usage in packed
       --  arrays, which otherwise fails, could use more analysis perhaps???
 
-      declare
-         function Within_Aspect (N : Node_Id) return Boolean;
-         --  True if within aspect expression. Giant kludge, do this test only
-         --  within an aspect, since doing it more widely, even though clearly
-         --  correct, causes regressions notably in GA19-001 ???
-
-         function Within_Aspect (N : Node_Id) return Boolean
-         is
-         begin
-            if No (Parent (N)) then
-               return False;
-            elsif Nkind (N) = N_Aspect_Specification then
-               return True;
-            else
-               return Within_Aspect (Parent (N));
-            end if;
-         end Within_Aspect;
-
-      begin
-         if In_Spec_Expression
-           and then Comes_From_Source (N)
-           and then not (Is_Entity_Name (P) and then Is_Frozen (Entity (P)))
-           and then Within_Aspect (N)
-         then
-            return;
-         end if;
-      end;
+      --  We do however go ahead with generic actual types, otherwise we get
+      --  some regressions, probably these types should be frozen anyway???
+
+      if In_Spec_Expression
+        and then Comes_From_Source (N)
+        and then not (Is_Entity_Name (P)
+                       and then
+                        (Is_Frozen (Entity (P))
+                          or else (Is_Type (Entity (P))
+                                    and then
+                                      Is_Generic_Actual_Type (Entity (P)))))
+      then
+         return;
+      end if;
 
       --  Acquire first two expressions (at the moment, no attributes take more
       --  than two expressions in any case).