[multiple changes]

2011-09-02  Bob Duff  <duff@adacore.com>

	* lib-xref.adb: (Hash): Avoid use of 'Mod attribute, because old
	compilers don't understand it.

2011-09-02  Gary Dismukes  <dismukes@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference): Pass the
	underlying subtype rather than its base type on the call to
	Build_Record_Or_Elementary_Input_Function, so that any
	constraints on a discriminated subtype will be available for
	doing the check required by AI05-0192.
	* exp_strm.adb (Build_Record_Or_Elementary_Input_Function):
	If the prefix subtype of the 'Input attribute is a constrained
	discriminated subtype, then check each constrained discriminant value
	against the corresponding value read from the stream.

From-SVN: r178453

gcc/ada/ChangeLog

+2011-09-02  Bob Duff  <duff@adacore.com>
+
+	* lib-xref.adb: (Hash): Avoid use of 'Mod attribute, because old
+	compilers don't understand it.
+
+2011-09-02  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_attr.adb (Expand_N_Attribute_Reference): Pass the
+	underlying subtype rather than its base type on the call to
+	Build_Record_Or_Elementary_Input_Function, so that any
+	constraints on a discriminated subtype will be available for
+	doing the check required by AI05-0192.
+	* exp_strm.adb (Build_Record_Or_Elementary_Input_Function):
+	If the prefix subtype of the 'Input attribute is a constrained
+	discriminated subtype, then check each constrained discriminant value
+	against the corresponding value read from the stream.
+
 2011-09-02  Yannick Moy  <moy@adacore.com>
 
 	* usage.adb, warnsw.adb, sem_ch6.adb, opt.ads: Disable by default

gcc/ada/exp_attr.adb

@@ -2531,8 +2531,12 @@ package body Exp_Attr is
                   return;
                end if;
 
+               --  Build the type's Input function, passing the subtype rather
+               --  than its base type, because checks are needed in the case of
+               --  constrained discriminants (see Ada 2012 AI05-0192).
+
                Build_Record_Or_Elementary_Input_Function
-                 (Loc, Base_Type (U_Type), Decl, Fname);
+                 (Loc, U_Type, Decl, Fname);
                Insert_Action (N, Decl);
 
                if Nkind (Parent (N)) = N_Object_Declaration

gcc/ada/exp_strm.adb

@@ -25,6 +25,7 @@
 
 with Atree;    use Atree;
 with Einfo;    use Einfo;
+with Elists;   use Elists;
 with Exp_Util; use Exp_Util;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
@@ -1106,14 +1107,16 @@ package body Exp_Strm is
       Decl : out Node_Id;
       Fnam : out Entity_Id)
    is
-      Cn       : Name_Id;
-      Constr   : List_Id;
-      Decls    : List_Id;
-      Discr    : Entity_Id;
-      J        : Pos;
-      Obj_Decl : Node_Id;
-      Odef     : Node_Id;
-      Stms     : List_Id;
+      B_Typ      : constant Entity_Id := Base_Type (Typ);
+      Cn         : Name_Id;
+      Constr     : List_Id;
+      Decls      : List_Id;
+      Discr      : Entity_Id;
+      Discr_Elmt : Elmt_Id            := No_Elmt;
+      J          : Pos;
+      Obj_Decl   : Node_Id;
+      Odef       : Node_Id;
+      Stms       : List_Id;
 
    begin
       Decls  := New_List;
@@ -1121,8 +1124,15 @@ package body Exp_Strm is
 
       J := 1;
 
-      if Has_Discriminants (Typ) then
-         Discr := First_Discriminant (Typ);
+      if Has_Discriminants (B_Typ) then
+         Discr := First_Discriminant (B_Typ);
+
+         --  If the prefix subtype is constrained, then retrieve the first
+         --  element of its constraint.
+
+         if Is_Constrained (Typ) then
+            Discr_Elmt := First_Elmt (Discriminant_Constraint (Typ));
+         end if;
 
          while Present (Discr) loop
             Cn := New_External_Name ('C', J);
@@ -1153,13 +1163,30 @@ package body Exp_Strm is
 
             Append_To (Constr, Make_Identifier (Loc, Cn));
 
+            --  If the prefix subtype imposes a discriminant constraint, then
+            --  check that each discriminant value equals the value read.
+
+            if Present (Discr_Elmt) then
+               Append_To (Decls,
+                 Make_Raise_Constraint_Error (Loc,
+                   Condition => Make_Op_Ne (Loc,
+                                  Left_Opnd  =>
+                                    New_Reference_To
+                                      (Defining_Identifier (Decl), Loc),
+                                  Right_Opnd =>
+                                    New_Copy_Tree (Node (Discr_Elmt))),
+                   Reason    => CE_Discriminant_Check_Failed));
+
+               Next_Elmt (Discr_Elmt);
+            end if;
+
             Next_Discriminant (Discr);
             J := J + 1;
          end loop;
 
          Odef :=
            Make_Subtype_Indication (Loc,
-             Subtype_Mark => New_Occurrence_Of (Typ, Loc),
+             Subtype_Mark => New_Occurrence_Of (B_Typ, Loc),
              Constraint =>
                Make_Index_Or_Discriminant_Constraint (Loc,
                  Constraints => Constr));
@@ -1167,7 +1194,7 @@ package body Exp_Strm is
       --  If no discriminants, then just use the type with no constraint
 
       else
-         Odef := New_Occurrence_Of (Typ, Loc);
+         Odef := New_Occurrence_Of (B_Typ, Loc);
       end if;
 
       --  Create an extended return statement encapsulating the result object
@@ -1184,7 +1211,7 @@ package body Exp_Strm is
       --  The object is about to get its value from Read, and if the type is
       --  null excluding we do not want spurious warnings on an initial null.
 
-      if Is_Access_Type (Typ) then
+      if Is_Access_Type (B_Typ) then
          Set_No_Initialization (Obj_Decl);
       end if;
 
@@ -1195,15 +1222,15 @@ package body Exp_Strm is
             Make_Handled_Sequence_Of_Statements (Loc,
               Statements => New_List (
                 Make_Attribute_Reference (Loc,
-                  Prefix         => New_Occurrence_Of (Typ, Loc),
+                  Prefix         => New_Occurrence_Of (B_Typ, Loc),
                   Attribute_Name => Name_Read,
                   Expressions    => New_List (
                     Make_Identifier (Loc, Name_S),
                     Make_Identifier (Loc, Name_V)))))));
 
-      Fnam := Make_Stream_Subprogram_Name (Loc, Typ, TSS_Stream_Input);
+      Fnam := Make_Stream_Subprogram_Name (Loc, B_Typ, TSS_Stream_Input);
 
-      Build_Stream_Function (Loc, Typ, Decl, Fnam, Decls, Stms);
+      Build_Stream_Function (Loc, B_Typ, Decl, Fnam, Decls, Stms);
    end Build_Record_Or_Elementary_Input_Function;
 
    -------------------------------------------------

gcc/ada/lib-xref.adb

@@ -1057,7 +1057,11 @@ package body Lib.Xref is
 
       XE : Xref_Entry renames Xrefs.Table (F);
       type M is mod 2**32;
-      H : constant M := M'Mod (XE.Key.Ent) + 2**7 * M'Mod (XE.Key.Loc);
+
+      H : constant M := M (XE.Key.Ent) + 2**7 * M (abs XE.Key.Loc);
+      --  We can't use M'Mod above, because it prevents bootstrapping with
+      --  older compilers. Loc can be negative, so we do "abs" before
+      --  converting.
    begin
       return Header_Num (H mod Num_Buckets);
    end Hash;