[multiple changes]

2004-08-13  Olivier Hainque  <hainque@act-europe.fr>

	* decl.c (gnat_to_gnu_entity) <E_Variable>: When building an allocator
	for a global aliased object with a variable size and an unconstrained
	nominal subtype, pretend there is no initializer if the one we have is
	incomplete, and avoid referencing an inexistant component in there. The
	part we have will be rebuilt anyway and the reference may confuse
	further operations.

2004-08-13  Thomas Quinot  <quinot@act-europe.fr>

	* einfo.ads: Minor reformatting

	* lib-writ.adb (Output_Main_Program_Line): Do not set parameter
	restrictions in the ALI if we only want to warn about violations.

2004-08-13  Vincent Celier  <celier@gnat.com>

	* ali.adb (Scan_ALI): Initialize component Body_Needed_For_SAL to False
	when creating a new Unit_Record in table Units.

	* gnatls.adb (Output_Unit): In verbose mode, output the restrictions
	that are violated, if any.

	* prj-nmsc.adb (Ada_Check.Get_Path_Names_And_Record_Sources): Do not
	add directory separator if path already ends with a directory separator.

2004-08-13  Ed Schonberg  <schonberg@gnat.com>

	* rtsfind.adb (Entity_Not_Defined): If the error ocurrs in a predefined
	unit, this is an attempt to inline a construct that is not available in
	the current restricted mode, so abort rather than trying to continue.

	* sem_ch3.adb (Build_Underlying_Full_View): If the new type has
	discriminants that rename those of the parent, recover names of
	original discriminants for the constraint on the full view of the
	parent.
	(Complete_Private_Subtype): Do not create a subtype declaration if the
	subtype is an itype.

	* gnat_rm.texi: Added section on implementation of discriminated
	records with default values for discriminants.

2004-08-13  Ed Schonberg  <schonberg@gnat.com>

	PR ada/15601
	* sem_res.adb (Make_Call_Into_Operator): Handle properly the case where
	the second operand is overloaded.

From-SVN: r85934

gcc/ada/ChangeLog

+2004-08-13  Olivier Hainque  <hainque@act-europe.fr>
+
+	* decl.c (gnat_to_gnu_entity) <E_Variable>: When building an allocator
+	for a global aliased object with a variable size and an unconstrained
+	nominal subtype, pretend there is no initializer if the one we have is
+	incomplete, and avoid referencing an inexistant component in there. The
+	part we have will be rebuilt anyway and the reference may confuse
+	further operations.
+
+2004-08-13  Thomas Quinot  <quinot@act-europe.fr>
+
+	* einfo.ads: Minor reformatting
+
+	* lib-writ.adb (Output_Main_Program_Line): Do not set parameter
+	restrictions in the ALI if we only want to warn about violations.
+
+2004-08-13  Vincent Celier  <celier@gnat.com>
+
+	* ali.adb (Scan_ALI): Initialize component Body_Needed_For_SAL to False
+	when creating a new Unit_Record in table Units.
+
+	* gnatls.adb (Output_Unit): In verbose mode, output the restrictions
+	that are violated, if any.
+
+	* prj-nmsc.adb (Ada_Check.Get_Path_Names_And_Record_Sources): Do not
+	add directory separator if path already ends with a directory separator.
+
+2004-08-13  Ed Schonberg  <schonberg@gnat.com>
+
+	* rtsfind.adb (Entity_Not_Defined): If the error ocurrs in a predefined
+	unit, this is an attempt to inline a construct that is not available in
+	the current restricted mode, so abort rather than trying to continue.
+
+	* sem_ch3.adb (Build_Underlying_Full_View): If the new type has
+	discriminants that rename those of the parent, recover names of
+	original discriminants for the constraint on the full view of the
+	parent.
+	(Complete_Private_Subtype): Do not create a subtype declaration if the
+	subtype is an itype.
+
+	* gnat_rm.texi: Added section on implementation of discriminated
+	records with default values for discriminants.
+
+2004-08-13  Ed Schonberg  <schonberg@gnat.com>
+
+	PR ada/15601
+	* sem_res.adb (Make_Call_Into_Operator): Handle properly the case where
+	the second operand is overloaded.
+
 2004-08-10  Richard Henderson  <rth@redhat.com>
 
 	* utils.c (gnat_install_builtins): Remove __builtin_stack_alloc,

gcc/ada/ali.adb

@@ -1173,6 +1173,7 @@ package body ALI is
          Units.Table (Units.Last).First_Arg       := First_Arg;
          Units.Table (Units.Last).Elab_Position   := 0;
          Units.Table (Units.Last).Interface       := ALIs.Table (Id).Interface;
+         Units.Table (Units.Last).Body_Needed_For_SAL := False;
 
          if Debug_Flag_U then
             Write_Str (" ----> reading unit ");

gcc/ada/decl.c

@@ -922,11 +922,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    used_by_ref = true;
 	    const_flag = true;
 
-	    /* Get the data part of GNU_EXPR in case this was a
-	       aliased object whose nominal subtype is unconstrained.
-	       In that case the pointer above will be a thin pointer and
-	       build_allocator will automatically make the template and
-	       constructor already made above.  */
+	    /* In case this was a aliased object whose nominal subtype is
+	       unconstrained, the pointer above will be a thin pointer and
+	       build_allocator will automatically make the template.
+
+	       If we have a template initializer only (that we made above),
+	       pretend there is none and rely on what build_allocator creates
+	       again anyway.  Otherwise (if we have a full initializer), get
+	       the data part and feed that to build_allocator.  */
 
 	    if (definition)
 	      {
@@ -937,11 +940,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		  {
 		    gnu_alloc_type
 		      = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_alloc_type)));
-		    gnu_expr
-		      = build_component_ref
-			(gnu_expr, NULL_TREE,
-			 TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr))),
-			 false);
+
+                   if (TREE_CODE (gnu_expr) == CONSTRUCTOR
+                       &&
+                       TREE_CHAIN (CONSTRUCTOR_ELTS (gnu_expr)) == NULL_TREE)
+                     gnu_expr = 0;
+                   else
+                     gnu_expr
+                       = build_component_ref
+                         (gnu_expr, NULL_TREE,
+                          TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr))),
+			  false);
 		  }
 
 		if (TREE_CODE (TYPE_SIZE_UNIT (gnu_alloc_type)) == INTEGER_CST

gcc/ada/einfo.ads

@@ -3088,7 +3088,7 @@ package Einfo is
 --       Present in private subtypes that are the completion of other private
 --       types, or in private types that are derived from private subtypes.
 --       If the full view of a private type T is derived from another
---       private type  with discriminants Td, the full view of T is also
+--       private type with discriminants Td, the full view of T is also
 --       private, and there is no way to attach to it a further full view that
 --       would convey the structure of T to the back end. The Underlying_Full_
 --       View is an attribute of the full view that is a subtype of Td with

gcc/ada/gnat_rm.texi

@@ -380,6 +380,7 @@ Implementation of Specific Ada Features
 * GNAT Implementation of Tasking::
 * GNAT Implementation of Shared Passive Packages::
 * Code Generation for Array Aggregates::
+* The Size of Discriminated Records with Default Discriminants::
 
 Project File Reference
 
@@ -12798,6 +12799,7 @@ facilities.
 * GNAT Implementation of Tasking::
 * GNAT Implementation of Shared Passive Packages::
 * Code Generation for Array Aggregates::
+* The Size of Discriminated Records with Default Discriminants::
 @end menu
 
 @node Machine Code Insertions
@@ -13342,6 +13344,98 @@ If any of these conditions are violated, the aggregate will be built in
 a temporary (created either by the front-end or the code generator) and then
 that temporary will be copied onto the target.
 
+
+@node The Size of Discriminated Records with Default Discriminants
+@section The Size of Discriminated Records with Default Discriminants
+
+@noindent
+If a discriminated type @code{T} has discriminants with default values, it is
+possible to declare an object of this type without providing an explicit
+constraint:
+
+@smallexample @c ada
+@group
+type Size is range 1..100;
+
+type Rec (D : Size := 15) is record
+   Name : String (1..D);
+end T;
+
+Word : Rec;
+@end group
+@end smallexample
+
+@noindent 
+Such an object is said to be @emph{unconstrained}.
+The discriminant of the object
+can be modified by a full assignment to the object, as long as it preserves the
+relation between the value of the discriminant, and the value of the components
+that depend on it:
+
+@smallexample @c ada
+@group
+Word := (3, "yes");
+
+Word := (5, "maybe");
+
+Word := (5, "no"); -- raises Constraint_Error
+@end group
+@end smallexample
+
+@noindent
+In order to support this behavior efficiently, an unconstrained object is
+given the maximum size that any value of the type requires. In the case
+above, @code{Word} has storage for the discriminant and for
+a @code{String} of length 100.
+It is important to note that unconstrained objects do not require dynamic
+allocation. It would be an improper implementation to place on the heap those
+components whose size depends on discriminants. (This improper implementation
+was used by some Ada83 compilers, where the @code{Name} component above
+would have
+been stored as a pointer to a dynamic string). Following the principle that
+dynamic storage management should never be introduced implicitly,
+an Ada95 compiler should reserve the full size for an unconstrained declared
+object, and place it on the stack.
+
+This maximum size approach
+has been a source of surprise to some users, who expect the default
+values of the discriminants to determine the size reserved for an
+unconstrained object: ``If the default is 15, why should the object occupy
+a larger size?''
+The answer, of course, is that the discriminant may be later modified,
+and its full range of values must be taken into account. This is why the
+declaration:
+
+@smallexample
+@group
+type Rec (D : Positive := 15) is record
+   Name : String (1..D);
+end record;
+
+Too_Large : Rec;
+@end group
+@end smallexample
+
+@noindent
+is flagged by the compiler with a warning:
+an attempt to create @code{Too_Large} will raise @code{Storage_Error},
+because the required size includes @code{Positive'Last}
+bytes. As the first example indicates, the proper approach is to declare an
+index type of ``reasonable'' range so that unconstrained objects are not too
+large.
+
+One final wrinkle: if the object is declared to be @code{aliased}, or if it is
+created in the heap by means of an allocator, then it is @emph{not}
+unconstrained:
+it is constrained by the default values of the discriminants, and those values
+cannot be modified by full assignment. This is because in the presence of
+aliasing all views of the object (which may be manipulated by different tasks,
+say) must be consistent, so it is imperative that the object, once created,
+remain invariant.
+
+
+
+
 @node Project File Reference
 @chapter Project File Reference
 

gcc/ada/gnatls.adb

@@ -513,9 +513,11 @@ procedure Gnatls is
 
          else
             Write_Str ("Unit => ");
-            Write_Eol; Write_Str ("     Name   => ");
+            Write_Eol;
+            Write_Str ("     Name   => ");
             Write_Str (Name_Buffer (1 .. Name_Len));
-            Write_Eol; Write_Str ("     Kind   => ");
+            Write_Eol;
+            Write_Str ("     Kind   => ");
 
             if Units.Table (U_Id).Unit_Kind = 'p' then
                Write_Str ("package ");
@@ -547,7 +549,8 @@ procedure Gnatls is
                U.Body_Needed_For_SAL or
                U.Elaborate_Body
             then
-               Write_Eol; Write_Str ("     Flags  =>");
+               Write_Eol;
+               Write_Str ("     Flags  =>");
 
                if U.Preelab then
                   Write_Str (" Preelaborable");
@@ -631,7 +634,8 @@ procedure Gnatls is
                --  Display these restrictions.
 
                if Restrictions.Set /= (All_Restrictions => False) then
-                  Write_Eol; Write_Str ("     Restrictions  =>");
+                  Write_Eol;
+                  Write_Str ("     pragma Restrictions  =>");
 
                   --  For boolean restrictions, just display the name of the
                   --  restriction; for valued restrictions, also display the
@@ -650,12 +654,45 @@ procedure Gnatls is
                      end if;
                   end loop;
                end if;
+
+               --  If the unit violates some Restrictions, display the list of
+               --  these restrictions.
+
+               if Restrictions.Violated /= (All_Restrictions => False) then
+                  Write_Eol;
+                  Write_Str ("     Restrictions violated =>");
+
+                  --  For boolean restrictions, just display the name of the
+                  --  restriction; for valued restrictions, also display the
+                  --  restriction value.
+
+                  for Restriction in All_Restrictions loop
+                     if Restrictions.Violated (Restriction) then
+                        Write_Eol;
+                        Write_Str ("       ");
+                        Write_Str (Image (Restriction));
+
+                        if Restriction in All_Parameter_Restrictions then
+                           if Restrictions.Count (Restriction) > 0 then
+                              Write_Str (" =>");
+
+                              if Restrictions.Unknown (Restriction) then
+                                 Write_Str (" at least");
+                              end if;
+
+                              Write_Str (Restrictions.Count (Restriction)'Img);
+                           end if;
+                        end if;
+                     end if;
+                  end loop;
+               end if;
             end;
          end if;
 
          if Print_Source then
             if Too_Long then
-               Write_Eol; Write_Str ("   ");
+               Write_Eol;
+               Write_Str ("   ");
             else
                Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
             end if;

gcc/ada/lib-writ.adb

@@ -958,7 +958,9 @@ package body Lib.Writ is
       --  And now the information for the parameter restrictions
 
       for RP in All_Parameter_Restrictions loop
-         if Main_Restrictions.Set (RP) then
+         if Main_Restrictions.Set (RP)
+           and then not Restriction_Warnings (RP)
+         then
             Write_Info_Char ('r');
             Write_Info_Nat (Nat (Main_Restrictions.Value (RP)));
          else

gcc/ada/rtsfind.adb

@@ -186,7 +186,23 @@ package body Rtsfind is
    procedure Entity_Not_Defined (Id : RE_Id) is
    begin
       if No_Run_Time_Mode then
-         RTE_Error_Msg ("|construct not allowed in no run time mode");
+
+         --  If the error occurs when compiling the body of a predefined
+         --  unit for inlining purposes, the body must be illegal in this
+         --  mode, and there is no point in continuing.
+
+         if Is_Predefined_File_Name
+           (Unit_File_Name (Get_Source_Unit (Sloc (Current_Error_Node))))
+         then
+            Error_Msg_N
+              ("construct not allowed in no run time mode!",
+                 Current_Error_Node);
+            raise Unrecoverable_Error;
+
+         else
+            RTE_Error_Msg ("|construct not allowed in no run time mode");
+         end if;
+
       elsif Configurable_Run_Time_Mode then
          RTE_Error_Msg ("|construct not allowed in this configuration>");
       else

gcc/ada/sem_ch3.adb

@@ -6288,30 +6288,60 @@ package body Sem_Ch3 is
       C      : Node_Id;
       Id     : Node_Id;
 
+      procedure Set_Discriminant_Name (Id : Node_Id);
+      --  If the derived type has discriminants, they may rename discriminants
+      --  of the parent. When building the full view of the parent, we need to
+      --  recover the names of the original discriminants if the constraint is
+      --  given by named associations.
+
+      ---------------------------
+      -- Set_Discriminant_Name --
+      ---------------------------
+
+      procedure Set_Discriminant_Name (Id : Node_Id) is
+         Disc : Entity_Id;
+
+      begin
+         Set_Original_Discriminant (Id, Empty);
+
+         if Has_Discriminants (Typ) then
+            Disc := First_Discriminant (Typ);
+
+            while Present (Disc) loop
+               if Chars (Disc) = Chars (Id)
+                 and then Present (Corresponding_Discriminant (Disc))
+               then
+                  Set_Chars (Id, Chars (Corresponding_Discriminant (Disc)));
+               end if;
+               Next_Discriminant (Disc);
+            end loop;
+         end if;
+      end Set_Discriminant_Name;
+
+   --  Start of processing for Build_Underlying_Full_View
+
    begin
       if Nkind (N) = N_Full_Type_Declaration then
          Constr := Constraint (Subtype_Indication (Type_Definition (N)));
 
-      --  ??? ??? is this assert right, I assume so otherwise Constr
-      --  would not be defined below (this used to be an elsif)
-
-      else pragma Assert (Nkind (N) = N_Subtype_Declaration);
+      elsif Nkind (N) = N_Subtype_Declaration then
          Constr := New_Copy_Tree (Constraint (Subtype_Indication (N)));
-      end if;
 
-      --  If the constraint has discriminant associations, the discriminant
-      --  entity is already set, but it denotes a discriminant of the new
-      --  type, not the original parent, so it must be found anew.
+      elsif Nkind (N) = N_Component_Declaration then
+         Constr :=
+           New_Copy_Tree
+             (Constraint (Subtype_Indication (Component_Definition (N))));
 
-      C := First (Constraints (Constr));
+      else
+         raise Program_Error;
+      end if;
 
+      C := First (Constraints (Constr));
       while Present (C) loop
-
          if Nkind (C) = N_Discriminant_Association then
             Id := First (Selector_Names (C));
-
             while Present (Id) loop
-               Set_Original_Discriminant (Id, Empty);
+               Set_Discriminant_Name (Id);
                Next (Id);
             end loop;
          end if;
@@ -6319,19 +6349,22 @@ package body Sem_Ch3 is
          Next (C);
       end loop;
 
-      Indic := Make_Subtype_Declaration (Loc,
-         Defining_Identifier => Subt,
-         Subtype_Indication  =>
-           Make_Subtype_Indication (Loc,
-             Subtype_Mark => New_Reference_To (Par, Loc),
-             Constraint   => New_Copy_Tree (Constr)));
+      Indic :=
+        Make_Subtype_Declaration (Loc,
+          Defining_Identifier => Subt,
+          Subtype_Indication  =>
+            Make_Subtype_Indication (Loc,
+              Subtype_Mark => New_Reference_To (Par, Loc),
+              Constraint   => New_Copy_Tree (Constr)));
 
       --  If this is a component subtype for an outer itype, it is not
       --  a list member, so simply set the parent link for analysis: if
       --  the enclosing type does not need to be in a declarative list,
       --  neither do the components.
 
-      if Is_List_Member (N) then
+      if Is_List_Member (N)
+        and then Nkind (N) /= N_Component_Declaration
+      then
          Insert_Before (N, Indic);
       else
          Set_Parent (Indic, Parent (N));
@@ -6972,19 +7005,26 @@ package body Sem_Ch3 is
            (Full, Related_Nod, Full_Base, Discriminant_Constraint (Priv));
 
       --  If the full base is itself derived from private, build a congruent
-      --  subtype of its underlying type, for use by the back end. Do not
-      --  do this for a constrained record component, where the back-end has
-      --  the proper information and there is no place for the declaration.
+      --  subtype of its underlying type, for use by the back end. For a
+      --  constrained record component, the declaration cannot be placed on
+      --  the component list, but it must neverthess be built an analyzed, to
+      --  supply enough information for gigi to compute the size of component.
 
       elsif Ekind (Full_Base) in Private_Kind
         and then Is_Derived_Type (Full_Base)
         and then Has_Discriminants (Full_Base)
-        and then Nkind (Related_Nod) /= N_Component_Declaration
         and then (Ekind (Current_Scope) /= E_Record_Subtype)
-        and then
-          Nkind (Subtype_Indication (Parent (Priv))) = N_Subtype_Indication
       then
-         Build_Underlying_Full_View (Parent (Priv), Full, Etype (Full_Base));
+         if not Is_Itype (Priv)
+           and then
+             Nkind (Subtype_Indication (Parent (Priv))) = N_Subtype_Indication
+         then
+            Build_Underlying_Full_View
+              (Parent (Priv), Full, Etype (Full_Base));
+
+         elsif Nkind (Related_Nod) = N_Component_Declaration then
+            Build_Underlying_Full_View (Related_Nod, Full, Etype (Full_Base));
+         end if;
 
       elsif Is_Record_Type (Full_Base) then
 

gcc/ada/sem_res.adb

@@ -1173,7 +1173,11 @@ package body Sem_Res is
                          or else Scope (Opnd_Type) /= System_Aux_Id
                          or else Pack /= Scope (System_Aux_Id))
             then
-               Error := True;
+               if not Is_Overloaded (Right_Opnd (Op_Node)) then
+                  Error := True;
+               else
+                  Error := not Operand_Type_In_Scope (Pack);
+               end if;
 
             elsif Pack = Standard_Standard
               and then not Operand_Type_In_Scope (Standard_Standard)