[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,6 +940,12 @@ 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)));
+
+                   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,

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/prj-nmsc.adb

@@ -29,7 +29,6 @@ with Fmap;     use Fmap;
 with Hostparm;
 with MLib.Tgt;
 with Namet;    use Namet;
-with Opt;      use Opt;
 with Osint;    use Osint;
 with Output;   use Output;
 with MLib.Tgt; use MLib.Tgt;
@@ -241,16 +240,12 @@ package body Prj.Nmsc is
      (Name    : Name_Id;
       Parent  : Name_Id;
       Dir     : out Name_Id;
-      Display  : out Name_Id;
-      Project  : Project_Id := No_Project;
-      Kind     : String := "";
-      Location : Source_Ptr := No_Location);
-   --  Locate a directory. Dir is the canonical path name. Display is the
-   --  path name for display purpose.
-   --  When the directory does not exist, Setup_Projects is True and Kind is
-   --  not the empty string, an attempt is made to create the directory.
-   --  Returns No_Name in Dir and Display if directory does not exist or
-   --  cannot be created.
+      Display : out Name_Id);
+   --  Locate a directory (returns No_Name for Dir and Display if directory
+   --  does not exist). Name is the directory name. Parent is the root
+   --  directory, if Name is a relative path name. Dir is the canonical case
+   --  path name of the directory, Display is the directory path name for
+   --  display purposes.
 
    function Path_Name_Of
      (File_Name : Name_Id;
@@ -386,7 +381,11 @@ package body Prj.Nmsc is
                      Source_Names.Set (Canonical_Name, NL);
                      Name_Len := Dir_Path'Length;
                      Name_Buffer (1 .. Name_Len) := Dir_Path;
+
+                     if Name_Buffer (Name_Len) /= Directory_Separator then
                         Add_Char_To_Name_Buffer (Directory_Separator);
+                     end if;
+
                      Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
                      Path := Name_Find;
 
@@ -1113,8 +1112,7 @@ package body Prj.Nmsc is
                --  the object directory or one of the source directories.
                --  This is the directory where copies of the interface
                --  sources will be copied. Note that this directory may be
-               --  the library directory. If setting up projects (gnat setup)
-               --  and the directory does not exist, attempt to create it.
+               --  the library directory.
 
                if Lib_Src_Dir.Value /= Empty_String then
                   declare
@@ -1124,18 +1122,11 @@ package body Prj.Nmsc is
                      Locate_Directory
                        (Dir_Id, Data.Display_Directory,
                         Data.Library_Src_Dir,
-                        Data.Display_Library_Src_Dir,
-                        Project  => Project,
-                        Kind     => "library interface copy",
-                        Location => Lib_Src_Dir.Location);
+                        Data.Display_Library_Src_Dir);
 
-                     --  If directory does not exist, report an error. No need
-                     --  to do that if Setup_Projects is True, as an error
-                     --  has already been reported by Locate_Directory.
+                     --  If directory does not exist, report an error
 
-                     if not Setup_Projects
-                       and then Data.Library_Src_Dir = No_Name
-                     then
+                     if Data.Library_Src_Dir = No_Name then
 
                         --  Get the absolute name of the library directory
                         --  that does not exist, to report an error.
@@ -2526,17 +2517,15 @@ package body Prj.Nmsc is
       end if;
 
       if For_Language = Lang_Ada then
-
-         --  If we have looked for sources and found none, then it is an
-         --  error, except if it is an extending project. If a non-extending
-         --  project is not supposed to contain any source, then we never
-         --  Find_Sources. No error is signalled when setting up projects
-         --  using gnat setup.
+         --  If we have looked for sources and found none, then
+         --  it is an error, except if it is an extending project.
+         --  If a non extending project is not supposed to contain
+         --  any source, then we never call Find_Sources.
 
          if Current_Source /= Nil_String then
             Data.Ada_Sources_Present := True;
 
-         elsif not Setup_Projects and then Data.Extends = No_Project then
+         elsif Data.Extends = No_Project then
             Error_Msg
               (Project,
                "there are no Ada sources in this project",
@@ -3306,20 +3295,15 @@ package body Prj.Nmsc is
                   Object_Dir.Location);
 
             else
-               --  Check that the specified object directory does exist, and
-               --  attempt to create it if setting up projects (gnat setup).
+               --  We check that the specified object directory
+               --  does exist.
 
                Locate_Directory
                  (Object_Dir.Value, Data.Display_Directory,
-                  Data.Object_Directory, Data.Display_Object_Dir,
-                  Project  => Project, Kind => "object",
-                  Location => Object_Dir.Location);
+                  Data.Object_Directory, Data.Display_Object_Dir);
 
-               if not Setup_Projects
-                 and then Data.Object_Directory = No_Name
-               then
+               if Data.Object_Directory = No_Name then
                   --  The object directory does not exist, report an error
-
                   Err_Vars.Error_Msg_Name_1 := Object_Dir.Value;
                   Error_Msg
                     (Project,
@@ -3327,9 +3311,10 @@ package body Prj.Nmsc is
                      Data.Location);
 
                   --  Do not keep a nil Object_Directory. Set it to the
-                  --  specified (relative or absolute) path. This is for the
-                  --  benefit of tools that recover from errors. For example,
-                  --  these tools could create the non-existent directory.
+                  --  specified (relative or absolute) path.
+                  --  This is for the benefit of tools that recover from
+                  --  errors; for example, these tools could create the
+                  --  non existent directory.
 
                   Data.Display_Object_Dir := Object_Dir.Value;
                   Get_Name_String (Object_Dir.Value);
@@ -3376,18 +3361,14 @@ package body Prj.Nmsc is
                   Exec_Dir.Location);
 
             else
-               --  We check that the specified exec directory does exist and
-               --  attempt to create it if setting up projects (gnat setup).
+               --  We check that the specified object directory
+               --  does exist.
 
                Locate_Directory
                  (Exec_Dir.Value, Data.Directory,
-                  Data.Exec_Directory, Data.Display_Exec_Dir,
-                  Project  => Project, Kind => "exec",
-                  Location => Exec_Dir.Location);
+                  Data.Exec_Directory, Data.Display_Exec_Dir);
 
-               if not Setup_Projects
-                 and then Data.Exec_Directory = No_Name
-               then
+               if Data.Exec_Directory = No_Name then
                   Err_Vars.Error_Msg_Name_1 := Exec_Dir.Value;
                   Error_Msg
                     (Project,
@@ -3447,10 +3428,10 @@ package body Prj.Nmsc is
 
          elsif Source_Dirs.Values = Nil_String then
 
-            --  If Source_Dirs is an empty string list, this means that this
-            --  contains no sources. For projects that do not extend other
-            --  projects, this also means that there is no need for an object
-            --  directory unless one is specified explicitly.
+            --  If Source_Dirs is an empty string list, this means
+            --  that this project contains no source. For projects that
+            --  don't extend other projects, this also means that there is no
+            --  need for an object directory, if not specified.
 
             if Data.Extends = No_Project
               and then  Data.Object_Directory = Data.Directory
@@ -3531,8 +3512,8 @@ package body Prj.Nmsc is
 
             begin
                --  If the project extended is a library project, we inherit
-               --  the library name, if it is not redefined, we check that
-               --  the library directory is specified, and we reset the
+               --  the library name, if it is not redefined; we check that
+               --  the library directory is specified; and we reset the
                --  library flag for the extended project.
 
                if Extended_Data.Library then
@@ -3579,16 +3560,13 @@ package body Prj.Nmsc is
             end if;
 
          else
-            --  Find path name, check that it is a directory, and attempt
-            --  to create it if setting up projects (gnat setup).
+            --  Find path name, check that it is a directory
 
             Locate_Directory
               (Lib_Dir.Value, Data.Display_Directory,
-               Data.Library_Dir, Data.Display_Library_Dir,
-               Project => Project, Kind => "library",
-               Location => Lib_Dir.Location);
+               Data.Library_Dir, Data.Display_Library_Dir);
 
-            if not Setup_Projects and then Data.Library_Dir = No_Name then
+            if Data.Library_Dir = No_Name then
 
                --  Get the absolute name of the library directory that
                --  does not exist, to report an error.
@@ -3773,7 +3751,7 @@ package body Prj.Nmsc is
             --  Check Spec_Suffix
 
             declare
-               Spec_Suffixes : Array_Element_Id :=
+               Spec_Suffixs : Array_Element_Id :=
                                 Util.Value_Of
                                   (Name_Spec_Suffix,
                                    Naming.Decl.Arrays);
@@ -3782,17 +3760,17 @@ package body Prj.Nmsc is
                Suffix2 : Array_Element_Id;
 
             begin
-               --  If some suffixes have been specified, we make sure that
+               --  If some suffixs have been specified, we make sure that
                --  for each language for which a default suffix has been
                --  specified, there is a suffix specified, either the one
                --  in the project file or if there were none, the default.
 
-               if Spec_Suffixes /= No_Array_Element then
+               if Spec_Suffixs /= No_Array_Element then
                   Suffix := Data.Naming.Spec_Suffix;
 
                   while Suffix /= No_Array_Element loop
                      Element := Array_Elements.Table (Suffix);
-                     Suffix2 := Spec_Suffixes;
+                     Suffix2 := Spec_Suffixs;
 
                      while Suffix2 /= No_Array_Element loop
                         exit when Array_Elements.Table (Suffix2).Index =
@@ -3800,8 +3778,9 @@ package body Prj.Nmsc is
                         Suffix2 := Array_Elements.Table (Suffix2).Next;
                      end loop;
 
-                     --  There is a registered default suffix, but no suffix is
-                     --  specified in the project file. Add default to array.
+                     --  There is a registered default suffix, but no
+                     --  suffix specified in the project file.
+                     --  Add the default to the array.
 
                      if Suffix2 = No_Array_Element then
                         Array_Elements.Increment_Last;
@@ -3810,16 +3789,16 @@ package body Prj.Nmsc is
                            Src_Index => Element.Src_Index,
                            Index_Case_Sensitive => False,
                            Value     => Element.Value,
-                           Next      => Spec_Suffixes);
-                        Spec_Suffixes := Array_Elements.Last;
+                           Next      => Spec_Suffixs);
+                        Spec_Suffixs := Array_Elements.Last;
                      end if;
 
                      Suffix := Element.Next;
                   end loop;
 
-                  --  Put the resulting array as the specification suffixes
+                  --  Put the resulting array as the specification suffixs
 
-                  Data.Naming.Spec_Suffix := Spec_Suffixes;
+                  Data.Naming.Spec_Suffix := Spec_Suffixs;
                end if;
             end;
 
@@ -3847,26 +3826,27 @@ package body Prj.Nmsc is
             --  Check Body_Suffix
 
             declare
-               Impl_Suffixes : Array_Element_Id :=
+               Impl_Suffixs : Array_Element_Id :=
                                 Util.Value_Of
-                                   (Name_Body_Suffix, Naming.Decl.Arrays);
+                                  (Name_Body_Suffix,
+                                   Naming.Decl.Arrays);
 
                Suffix  : Array_Element_Id;
                Element : Array_Element;
                Suffix2 : Array_Element_Id;
 
             begin
-               --  If some suffixes have been specified, we make sure that
+               --  If some suffixs have been specified, we make sure that
                --  for each language for which a default suffix has been
                --  specified, there is a suffix specified, either the one
                --  in the project file or if there were noe, the default.
 
-               if Impl_Suffixes /= No_Array_Element then
+               if Impl_Suffixs /= No_Array_Element then
                   Suffix := Data.Naming.Body_Suffix;
 
                   while Suffix /= No_Array_Element loop
                      Element := Array_Elements.Table (Suffix);
-                     Suffix2 := Impl_Suffixes;
+                     Suffix2 := Impl_Suffixs;
 
                      while Suffix2 /= No_Array_Element loop
                         exit when Array_Elements.Table (Suffix2).Index =
@@ -3885,16 +3865,16 @@ package body Prj.Nmsc is
                            Src_Index => Element.Src_Index,
                            Index_Case_Sensitive => False,
                            Value => Element.Value,
-                           Next  => Impl_Suffixes);
-                        Impl_Suffixes := Array_Elements.Last;
+                           Next  => Impl_Suffixs);
+                        Impl_Suffixs := Array_Elements.Last;
                      end if;
 
                      Suffix := Element.Next;
                   end loop;
 
-                  --  Put the resulting array as the implementation suffixes
+                  --  Put the resulting array as the implementation suffixs
 
-                  Data.Naming.Body_Suffix := Impl_Suffixes;
+                  Data.Naming.Body_Suffix := Impl_Suffixs;
                end if;
             end;
 
@@ -3944,10 +3924,7 @@ package body Prj.Nmsc is
      (Name    : Name_Id;
       Parent  : Name_Id;
       Dir     : out Name_Id;
-      Display  : out Name_Id;
-      Project  : Project_Id := No_Project;
-      Kind     : String := "";
-      Location : Source_Ptr := No_Location)
+      Display : out Name_Id)
    is
       The_Name   : constant String := Get_Name_String (Name);
       The_Parent : constant String :=
@@ -3955,43 +3932,24 @@ package body Prj.Nmsc is
       The_Parent_Last : constant Natural :=
                      Compute_Directory_Last (The_Parent);
 
-      procedure Create_Directory (Absolute_Path : String);
-      --  Attempt to create a new directory
-
-      procedure Get_Names_For (Absolute_Path : String);
-      --  Create name ids Dir and Display for directory Absolute_Path
-
-      ----------------------
-      -- Create_Directory --
-      ----------------------
-
-      procedure Create_Directory (Absolute_Path : String) is
    begin
-         --  Attempt to create the directory
-
-         Make_Dir (Absolute_Path);
-
-         --  Setup Dir and Display if creation was successful
-
-         Get_Names_For (Absolute_Path);
-
-      exception
-         when Directory_Error =>
-            Error_Msg
-              (Project,
-               "could not create " & Kind & " directory """ &
-               Absolute_Path & """",
-               Location);
-      end Create_Directory;
+      if Current_Verbosity = High then
+         Write_Str ("Locate_Directory (""");
+         Write_Str (The_Name);
+         Write_Str (""", """);
+         Write_Str (The_Parent);
+         Write_Line (""")");
+      end if;
 
-      -------------------
-      -- Get_Names_For --
-      -------------------
+      Dir     := No_Name;
+      Display := No_Name;
 
-      procedure Get_Names_For (Absolute_Path : String) is
+      if Is_Absolute_Path (The_Name) then
+         if Is_Directory (The_Name) then
+            declare
                Normed : constant String :=
                           Normalize_Pathname
-                              (Absolute_Path,
+                            (The_Name,
                              Resolve_Links  => False,
                              Case_Sensitive => True);
 
@@ -4009,28 +3967,7 @@ package body Prj.Nmsc is
                Name_Len := Canonical_Path'Length;
                Name_Buffer (1 .. Name_Len) := Canonical_Path;
                Dir := Name_Find;
-      end Get_Names_For;
-
-   --  Start of processing for Locate_Directory
-
-   begin
-      if Current_Verbosity = High then
-         Write_Str ("Locate_Directory (""");
-         Write_Str (The_Name);
-         Write_Str (""", """);
-         Write_Str (The_Parent);
-         Write_Line (""")");
-      end if;
-
-      Dir     := No_Name;
-      Display := No_Name;
-
-      if Is_Absolute_Path (The_Name) then
-         if Is_Directory (The_Name) then
-            Get_Names_For (The_Name);
-
-         elsif Kind /= "" and then Setup_Projects then
-            Create_Directory (The_Name);
+            end;
          end if;
 
       else
@@ -4041,10 +3978,28 @@ package body Prj.Nmsc is
 
          begin
             if Is_Directory (Full_Path) then
-               Get_Names_For (Full_Path);
+               declare
+                  Normed : constant String :=
+                             Normalize_Pathname
+                               (Full_Path,
+                                Resolve_Links  => False,
+                                Case_Sensitive => True);
+
+                  Canonical_Path : constant String :=
+                                     Normalize_Pathname
+                                       (Normed,
+                                        Resolve_Links  => True,
+                                        Case_Sensitive => False);
+
+               begin
+                  Name_Len := Normed'Length;
+                  Name_Buffer (1 .. Name_Len) := Normed;
+                  Display := Name_Find;
 
-            elsif Kind /= "" and then Setup_Projects then
-               Create_Directory (Full_Path);
+                  Name_Len := Canonical_Path'Length;
+                  Name_Buffer (1 .. Name_Len) := Canonical_Path;
+                  Dir := Name_Find;
+               end;
             end if;
          end;
       end if;

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
+
+         --  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,7 +6349,8 @@ package body Sem_Ch3 is
          Next (C);
       end loop;
 
-      Indic := Make_Subtype_Declaration (Loc,
+      Indic :=
+        Make_Subtype_Declaration (Loc,
           Defining_Identifier => Subt,
           Subtype_Indication  =>
             Make_Subtype_Indication (Loc,
@@ -6331,7 +6362,9 @@ package body Sem_Ch3 is
       --  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)
+      then
+         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));
+            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
+               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)