[multiple changes]

2012-07-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Analyze_Selected_Component): When checking for
	potential ambiguities with class-wide operations on synchronized
	types, attach the copied node properly to the tree, to prevent
	errors during expansion.

2012-07-23  Yannick Moy  <moy@adacore.com>

	* sem_ch5.adb (Analyze_Loop_Statement): Make sure the loop body
	is analyzed in Alfa mode.

2012-07-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb: Adjust previous change.

2012-07-23  Vincent Pucci  <pucci@adacore.com>

	* sem_ch9.adb (Allows_Lock_Free_Implementation): Flag
	Lock_Free_Given renames previous flag Complain. Description
	updated. Henceforth, catch every error messages issued by this
	routine when Lock_Free_Given is True.  Declaration restriction
	updated: No non-elementary parameter instead (even in parameter)
	New subprogram body restrictions implemented: No allocator,
	no address, import or export rep items, no delay statement,
	no goto statement, no quantified expression and no dereference
	of access value.

2012-07-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Determine_Range): Add local variable Btyp. Handle
	the case where the base type of an enumeration subtype is
	private. Replace all occurrences of Base_Type with Btyp.
	* exp_attr.adb (Attribute_Valid): Handle the case where the
	base type of an enumeration subtype is private. Replace all
	occurrences of Base_Type with Btyp.
	* sem_util.adb (Get_Enum_Lit_From_Pos): Add local variable
	Btyp. Handle the case where the base type of an enumeration
	subtype is private. Replace all occurrences of Base_Type with
	Btyp.

From-SVN: r189775

gcc/ada/ChangeLog

 2012-07-23  Ed Schonberg  <schonberg@adacore.com>
 
+	* sem_ch4.adb (Analyze_Selected_Component): When checking for
+	potential ambiguities with class-wide operations on synchronized
+	types, attach the copied node properly to the tree, to prevent
+	errors during expansion.
+
+2012-07-23  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch5.adb (Analyze_Loop_Statement): Make sure the loop body
+	is analyzed in Alfa mode.
+
+2012-07-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb: Adjust previous change.
+
+2012-07-23  Vincent Pucci  <pucci@adacore.com>
+
+	* sem_ch9.adb (Allows_Lock_Free_Implementation): Flag
+	Lock_Free_Given renames previous flag Complain. Description
+	updated. Henceforth, catch every error messages issued by this
+	routine when Lock_Free_Given is True.  Declaration restriction
+	updated: No non-elementary parameter instead (even in parameter)
+	New subprogram body restrictions implemented: No allocator,
+	no address, import or export rep items, no delay statement,
+	no goto statement, no quantified expression and no dereference
+	of access value.
+
+2012-07-23  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* checks.adb (Determine_Range): Add local variable Btyp. Handle
+	the case where the base type of an enumeration subtype is
+	private. Replace all occurrences of Base_Type with Btyp.
+	* exp_attr.adb (Attribute_Valid): Handle the case where the
+	base type of an enumeration subtype is private. Replace all
+	occurrences of Base_Type with Btyp.
+	* sem_util.adb (Get_Enum_Lit_From_Pos): Add local variable
+	Btyp. Handle the case where the base type of an enumeration
+	subtype is private. Replace all occurrences of Base_Type with
+	Btyp.
+
+2012-07-23  Ed Schonberg  <schonberg@adacore.com>
+
 	* par-ch6.adb (P_Mode): in Ada 2005, a mode indicator can apply
 	to a formal object of an anonymous access type.
 

gcc/ada/checks.adb

@@ -3151,6 +3151,9 @@ package body Checks is
       Cindex : Cache_Index;
       --  Used to search cache
 
+      Btyp : Entity_Id;
+      --  Base type
+
       function OK_Operands return Boolean;
       --  Used for binary operators. Determines the ranges of the left and
       --  right operands, and if they are both OK, returns True, and puts
@@ -3267,6 +3270,15 @@ package body Checks is
          Typ := Underlying_Type (Base_Type (Typ));
       end if;
 
+      --  Retrieve the base type. Handle the case where the base type is a
+      --  private enumeration type.
+
+      Btyp := Base_Type (Typ);
+
+      if Is_Private_Type (Btyp) and then Present (Full_View (Btyp)) then
+         Btyp := Full_View (Btyp);
+      end if;
+
       --  We use the actual bound unless it is dynamic, in which case use the
       --  corresponding base type bound if possible. If we can't get a bound
       --  then we figure we can't determine the range (a peculiar case, that
@@ -3280,8 +3292,8 @@ package body Checks is
       if Compile_Time_Known_Value (Bound) then
          Lo := Expr_Value (Bound);
 
-      elsif Compile_Time_Known_Value (Type_Low_Bound (Base_Type (Typ))) then
-         Lo := Expr_Value (Type_Low_Bound (Base_Type (Typ)));
+      elsif Compile_Time_Known_Value (Type_Low_Bound (Btyp)) then
+         Lo := Expr_Value (Type_Low_Bound (Btyp));
 
       else
          OK := False;
@@ -3296,8 +3308,8 @@ package body Checks is
       --  always be compile time known. Again, it is not clear that this
       --  can ever be false, but no point in bombing.
 
-      if Compile_Time_Known_Value (Type_High_Bound (Base_Type (Typ))) then
-         Hbound := Expr_Value (Type_High_Bound (Base_Type (Typ)));
+      if Compile_Time_Known_Value (Type_High_Bound (Btyp)) then
+         Hbound := Expr_Value (Type_High_Bound (Btyp));
          Hi := Hbound;
 
       else
@@ -4744,17 +4756,17 @@ package body Checks is
             --  associated subtype.
 
             Insert_Action (N,
-               Make_Raise_Constraint_Error (Loc,
-                 Condition =>
-                    Make_Not_In (Loc,
-                      Left_Opnd  =>
-                        Convert_To (Base_Type (Etype (Sub)),
-                          Duplicate_Subexpr_Move_Checks (Sub)),
-                      Right_Opnd =>
-                        Make_Attribute_Reference (Loc,
-                          Prefix         => New_Reference_To (Etype (A), Loc),
-                          Attribute_Name => Name_Range)),
-                 Reason => CE_Index_Check_Failed));
+              Make_Raise_Constraint_Error (Loc,
+                Condition =>
+                   Make_Not_In (Loc,
+                     Left_Opnd  =>
+                       Convert_To (Base_Type (Etype (Sub)),
+                         Duplicate_Subexpr_Move_Checks (Sub)),
+                     Right_Opnd =>
+                       Make_Attribute_Reference (Loc,
+                         Prefix         => New_Reference_To (Etype (A), Loc),
+                         Attribute_Name => Name_Range)),
+                Reason => CE_Index_Check_Failed));
          end if;
 
       --  General case
@@ -4831,14 +4843,14 @@ package body Checks is
                   end if;
 
                   Insert_Action (N,
-                     Make_Raise_Constraint_Error (Loc,
-                       Condition =>
-                          Make_Not_In (Loc,
-                            Left_Opnd  =>
-                              Convert_To (Base_Type (Etype (Sub)),
-                                Duplicate_Subexpr_Move_Checks (Sub)),
-                            Right_Opnd => Range_N),
-                       Reason => CE_Index_Check_Failed));
+                    Make_Raise_Constraint_Error (Loc,
+                      Condition =>
+                         Make_Not_In (Loc,
+                           Left_Opnd  =>
+                             Convert_To (Base_Type (Etype (Sub)),
+                               Duplicate_Subexpr_Move_Checks (Sub)),
+                           Right_Opnd => Range_N),
+                      Reason => CE_Index_Check_Failed));
                end if;
 
                A_Idx := Next_Index (A_Idx);

gcc/ada/exp_attr.adb

@@ -5372,6 +5372,13 @@ package body Exp_Attr is
 
          Validity_Checks_On := False;
 
+         --  Retrieve the base type. Handle the case where the base type is a
+         --  private enumeration type.
+
+         if Is_Private_Type (Btyp) and then Present (Full_View (Btyp)) then
+            Btyp := Full_View (Btyp);
+         end if;
+
          --  Floating-point case. This case is handled by the Valid attribute
          --  code in the floating-point attribute run-time library.
 
@@ -5472,15 +5479,14 @@ package body Exp_Attr is
          --       (X >= type(X)'First and then type(X)'Last <= X)
 
          elsif Is_Enumeration_Type (Ptyp)
-           and then Present (Enum_Pos_To_Rep (Base_Type (Ptyp)))
+           and then Present (Enum_Pos_To_Rep (Btyp))
          then
             Tst :=
               Make_Op_Ge (Loc,
                 Left_Opnd =>
                   Make_Function_Call (Loc,
                     Name =>
-                      New_Reference_To
-                        (TSS (Base_Type (Ptyp), TSS_Rep_To_Pos), Loc),
+                      New_Reference_To (TSS (Btyp, TSS_Rep_To_Pos), Loc),
                     Parameter_Associations => New_List (
                       Pref,
                       New_Occurrence_Of (Standard_False, Loc))),

gcc/ada/exp_ch9.adb

@@ -3188,7 +3188,7 @@ package body Exp_Ch9 is
 
                   Rewrite (Stmt,
                     Make_Implicit_If_Statement (N,
-                      Condition =>
+                      Condition       =>
                         Make_Function_Call (Loc,
                           Name                   =>
                             New_Reference_To (Try_Write, Loc),
@@ -3379,9 +3379,9 @@ package body Exp_Ch9 is
               Make_Object_Renaming_Declaration (Loc,
                 Defining_Identifier =>
                   Defining_Identifier (Comp_Decl),
-                Subtype_Mark      =>
+                Subtype_Mark        =>
                   New_Occurrence_Of (Comp_Type, Loc),
-                Name              =>
+                Name                =>
                   New_Reference_To (Desired_Comp, Loc)));
 
             --  Wrap any return or raise statements in Stmts in same the manner

gcc/ada/sem_ch4.adb

@@ -4222,13 +4222,21 @@ package body Sem_Ch4 is
 
                --  Duplicate the call. This is required to avoid problems with
                --  the tree transformations performed by Try_Object_Operation.
+               --  Set properly the parent of the copied call, because it is
+               --  about to be reanalyzed.
 
-              and then
-                Try_Object_Operation
-                  (N            => Sinfo.Name (New_Copy_Tree (Parent (N))),
-                   CW_Test_Only => True)
             then
-               return;
+               declare
+                  Par : constant Node_Id := New_Copy_Tree (Parent (N));
+
+               begin
+                  Set_Parent (Par, Parent (Parent (N)));
+                  if Try_Object_Operation
+                    (Sinfo.Name (Par), CW_Test_Only => True)
+                  then
+                     return;
+                  end if;
+               end;
             end if;
          end if;
 

gcc/ada/sem_ch5.adb

@@ -2633,14 +2633,14 @@ package body Sem_Ch5 is
       --  types the actual subtype of the components will only be determined
       --  when the cursor declaration is analyzed.
 
-      --  If the expander is not active, then we want to analyze the loop body
-      --  now even in the Ada 2012 iterator case, since the rewriting will not
-      --  be done. Insert the loop variable in the current scope, if not done
-      --  when analysing the iteration scheme.
+      --  If the expander is not active, or in Alfa mode, then we want to
+      --  analyze the loop body now even in the Ada 2012 iterator case, since
+      --  the rewriting will not be done. Insert the loop variable in the
+      --  current scope, if not done when analysing the iteration scheme.
 
       if No (Iter)
         or else No (Iterator_Specification (Iter))
-        or else not Expander_Active
+        or else not Full_Expander_Active
       then
          if Present (Iter)
            and then Present (Iterator_Specification (Iter))

gcc/ada/sem_res.adb

@@ -7071,7 +7071,8 @@ package body Sem_Res is
       if Is_Overloaded (P) then
 
          --  Use the context type to select the prefix that has the correct
-         --  designated type.
+         --  designated type. Keep the first match, which will be the inner-
+         --  most.
 
          Get_First_Interp (P, I, It);
 
@@ -7079,7 +7080,9 @@ package body Sem_Res is
             if Is_Access_Type (It.Typ)
               and then Covers (Typ, Designated_Type (It.Typ))
             then
-               P_Typ := It.Typ;
+               if No (P_Typ) then
+                  P_Typ := It.Typ;
+               end if;
 
             --  Remove access types that do not match, but preserve access
             --  to subprogram interpretations, in case a further dereference

gcc/ada/sem_util.adb

@@ -4500,7 +4500,8 @@ package body Sem_Util is
       Pos : Uint;
       Loc : Source_Ptr) return Node_Id
    is
-      Lit : Node_Id;
+      Btyp : Entity_Id := Base_Type (T);
+      Lit  : Node_Id;
 
    begin
       --  In the case where the literal is of type Character, Wide_Character
@@ -4522,7 +4523,11 @@ package body Sem_Util is
       --
 
       else
-         Lit := First_Literal (Base_Type (T));
+         if Is_Private_Type (Btyp) and then Present (Full_View (Btyp)) then
+            Btyp := Full_View (Btyp);
+         end if;
+
+         Lit := First_Literal (Btyp);
          for J in 1 .. UI_To_Int (Pos) loop
             Next_Literal (Lit);
          end loop;