[multiple changes]

2004-07-06  Vincent Celier  <celier@gnat.com>

	* vms_conv.ads: Minor reformatting.
	Alphabetical order for enumerated values of type Command_Type, to have
	the command in alphabetical order for the usage.

	* vms_conv.adb (Process_Argument): Set Keep_Temporary_Files to True for
	the special qualifier /KEEP_TEMPORARY_FILES (minimum 6 characters).

	* gnat_ugn.texi: Document new switch -dn for the GNAT driver.

	* makegpr.adb (Global_Archive_Exists): New global Boolean variable
	(Add_Archive_Path): Only add the global archive if there is one.
	(Build_Global_Archive): Set Global_Archive_Exists depending if there is
	or not any object file to put in the global archive, and don't build
	a global archive if there is none.
	(X_Switches): New table
	(Compile_Link_With_Gnatmake): Pass to gnatmake the -X switches stored
	in the X_Switches table, if any.
	(Initialize): Make sure the X_Switches table is empty
	(Scan_Arg): Record -X switches in table X_Switches

	* opt.ads (Keep_Temporary_Files): New Boolean flag, defaulted to False.

	* make.adb: Minor comment fix

	* gnatname.adb (Gnatname): When not on VMS, and gnatname has been
	invoked with directory information, add the directory in front of the
	path.

	* gnatchop.adb (Gnatchop): When not on VMS, and gnatchop has been
	invoked with directory information, add the directory in front of the
	path.

	* gnatcmd.adb (Delete_Temp_Config_Files): Only delete temporary files
	when Keep_Temporary_Files is False.
	(GNATCmd): When not on VMS, and the GNAT driver has been invoked with
	directory information, add the directory in front of the path.
	When not on VMS, handle new switch -dn before the command to set
	Keep_Temporary_Files to True.
	(Non_VMS_Usage): Use lower case for the non VMS usage: this is valid
	everywhere.

	* gnatlink.adb (Gnatlink): When not on VMS, and gnatlink has been
	invoked with directory information, add the directory in front of the
	path.

2004-07-06  Thomas Quinot  <quinot@act-europe.fr>

	* snames.ads, snames.adb (Name_Stub): New name for the distributed
	systems annex.

	* rtsfind.ads: New RTE TC_Object, for DSA/PolyORB.
	New RTEs RAS_Proxy_Type and RAS_Proxy_Type_Access, for DSA.

	* g-socket.adb (To_Timeval): Fix incorrect conversion of
	Selector_Duration to Timeval for the case of 0.0.

	* exp_util.ads (Evolve_Or_Else): Fix overenthusiastic copy/paste of
	documentation from Evolve_And_Then.

2004-07-06  Jose Ruiz  <ruiz@act-europe.fr>

	* s-taprop-tru64.adb, s-taprop-os2.adb,
	s-taprop-mingw.adb, s-taprop-posix.adb: Update comment.

2004-07-06  Robert Dewar  <dewar@gnat.com>

	* s-osinte-hpux.ads, s-osinte-freebsd.ads,
	s-osinte-lynxos.ads, s-taprop-lynxos.adb, s-osinte-tru64.ads,
	s-osinte-aix.ads, s-osinte-irix.ads, s-taprop-irix.adb,
	s-interr-sigaction.adb, s-taprop-irix-athread.adb,
	s-osinte-hpux-dce.adb, s-taprop-hpux-dce.adb,
	s-taprop-linux.adb, s-taprop-dummy.adb, s-taprop-solaris.adb,
	s-interr-vms.adb, s-osinte-vms.ads, s-taprop-vms.adb,
	s-osinte-vxworks.ads, s-osprim-vxworks.adb, a-numaux-x86.adb,
	a-except.adb, a-exexpr.adb, a-intsig.adb, a-tags.adb,
	a-tags.ads, bindgen.ads, checks.adb, checks.adb,
	csets.ads, einfo.ads, einfo.ads, elists.adb, exp_ch4.adb,
	exp_ch7.adb, exp_dist.adb, exp_util.adb, freeze.adb,
	g-dynhta.adb, gnatmem.adb, g-regexp.adb, inline.adb,
	i-os2thr.ads, osint.adb, prj.adb, scng.adb, sem_cat.adb,
	sem_ch10.adb, sem_ch12.adb, sem_ch4.adb, sem_ch7.adb,
	sem_ch8.adb, sem_disp.adb, sem_prag.adb, sem_res.adb,
	sem_type.adb, sem_type.ads, sem_warn.adb, s-ficobl.ads,
	s-finimp.adb, s-htable.adb, sinfo.ads, sinput-l.ads,
	s-interr.adb, s-interr.ads, sprint.adb, s-tarest.adb,
	s-tasini.ads, s-taskin.ads, s-taskin.ads, uname.adb,
	vms_data.ads: Minor reformatting,
	Fix bad box comment format.

	* gnat_rm.texi: Fix minor grammatical error

	* sem_attr.adb, exp_attr.adb: New attribute Has_Access_Values

	* sem_util.ads, sem_util.adb (Requires_Transient_Scope): Allow many
	more cases of discriminated records to be recognized as not needing a
	secondary stack.
	(Has_Access_Values): New function.

	* snames.h, snames.adb, snames.ads: New attribute Has_Access_Values

	* cstand.adb, layout.ads, layout.adb, sem_ch13.ads: Change name
	Set_Prim_Alignment to Set_Elem_Alignment (more accurate correspondence
	with LRM terminology).
	Change terminology in comments primitive type => elementary type.

2004-07-06  Ed Schonberg  <schonberg@gnat.com>

	PR ada/15602
	* sem_ch7.adb (Unit_Requires_Body): For a generic package, the formal
	parameters do not impose any requirements on the presence of a body.

2004-07-06  Ed Schonberg  <schonberg@gnat.com>

	PR ada/15593
	* sem_ch12.adb (Analyze_Package_Instantiation): If the generic is not a
	compilation unit and is in an open scope at the point of instantiation,
	assume that a body may be present later.

2004-07-06  Ed Schonberg  <schonberg@gnat.com>

	* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case 'Size):
	Improve error message when specified size is not supported.

	* sem_ch6.adb (Maybe_Primitive_Operation): A library-level subprogram
	is never a primitive operation.

From-SVN: r84152

1 files changed, 116 insertions, 23 deletions

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index c1ef371..1f23ef3 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -2656,12 +2656,17 @@ package body Sem_Util is
       if Nkind (Decl) = N_Subprogram_Body then
          return Decl;
 
+      --  The below comment is bad, because it is possible for
+      --  Nkind (Decl) to be an N_Subprogram_Body_Stub ???
+
       else           --  Nkind (Decl) = N_Subprogram_Declaration
 
          if Present (Corresponding_Body (Decl)) then
             return Unit_Declaration_Node (Corresponding_Body (Decl));
 
-         else        --  imported subprogram.
+         --  Imported subprogram case
+
+         else
             return Empty;
          end if;
       end if;
@@ -2676,6 +2681,55 @@ package body Sem_Util is
       return Task_Body_Procedure (Declaration_Node (Root_Type (E)));
    end Get_Task_Body_Procedure;
 
+   -----------------------
+   -- Has_Access_Values --
+   -----------------------
+
+   function Has_Access_Values (T : Entity_Id) return Boolean is
+      Typ : constant Entity_Id := Underlying_Type (T);
+
+   begin
+      --  Case of a private type which is not completed yet. This can only
+      --  happen in the case of a generic format type appearing directly, or
+      --  as a component of the type to which this function is being applied
+      --  at the top level. Return False in this case, since we certainly do
+      --  not know that the type contains access types.
+
+      if No (Typ) then
+         return False;
+
+      elsif Is_Access_Type (Typ) then
+         return True;
+
+      elsif Is_Array_Type (Typ) then
+         return Has_Access_Values (Component_Type (Typ));
+
+      elsif Is_Record_Type (Typ) then
+         declare
+            Comp : Entity_Id;
+
+         begin
+            Comp := First_Entity (Typ);
+            while Present (Comp) loop
+               if (Ekind (Comp) = E_Component
+                     or else
+                   Ekind (Comp) = E_Discriminant)
+                 and then Has_Access_Values (Etype (Comp))
+               then
+                  return True;
+               end if;
+
+               Next_Entity (Comp);
+            end loop;
+         end;
+
+         return False;
+
+      else
+         return False;
+      end if;
+   end Has_Access_Values;
+
    ----------------------
    -- Has_Declarations --
    ----------------------
@@ -4654,9 +4708,9 @@ package body Sem_Util is
       procedure Kill_Current_Values_For_Entity_Chain (E : Entity_Id);
       --  Clear current value for entity E and all entities chained to E
 
-      -------------------------------------------
-      --  Kill_Current_Values_For_Entity_Chain --
-      -------------------------------------------
+      ------------------------------------------
+      -- Kill_Current_Values_For_Entity_Chain --
+      ------------------------------------------
 
       procedure Kill_Current_Values_For_Entity_Chain (E : Entity_Id) is
          Ent : Entity_Id;
@@ -4992,7 +5046,6 @@ package body Sem_Util is
       end if;
 
       Formal := First_Formal (S);
-
       while Present (Formal) loop
 
          --  Match the formals in order. If the corresponding actual
@@ -5094,7 +5147,6 @@ package body Sem_Util is
             Actual := First (Actuals);
 
             while Present (Actual) loop
-
                if Nkind (Actual) = N_Parameter_Association
                  and then Actual /= Last
                  and then No (Next_Named_Actual (Actual))
@@ -5669,11 +5721,13 @@ package body Sem_Util is
 
    --  A transient scope is required when variable-sized temporaries are
    --  allocated in the primary or secondary stack, or when finalization
-   --  actions must be generated before the next instruction
+   --  actions must be generated before the next instruction.
 
    function Requires_Transient_Scope (Id : Entity_Id) return Boolean is
       Typ : constant Entity_Id := Underlying_Type (Id);
 
+   --  Start of processing for Requires_Transient_Scope
+
    begin
       --  This is a private type which is not completed yet. This can only
       --  happen in a default expression (of a formal parameter or of a
@@ -5682,23 +5736,22 @@ package body Sem_Util is
       if No (Typ) then
          return False;
 
+      --  Do not expand transient scope for non-existent procedure return
+
       elsif Typ = Standard_Void_Type then
          return False;
 
-      --  The back-end has trouble allocating variable-size temporaries so
-      --  we generate them in the front-end and need a transient scope to
-      --  reclaim them properly
+      --  Elementary types do not require a transient scope
 
-      elsif not Size_Known_At_Compile_Time (Typ) then
-         return True;
+      elsif Is_Elementary_Type (Typ) then
+         return False;
 
-      --  Unconstrained discriminated records always require a variable
-      --  length temporary, since the length may depend on the variant.
+      --  Generally, indefinite subtypes require a transient scope, since the
+      --  back end cannot generate temporaries, since this is not a valid type
+      --  for declaring an object. It might be possible to relax this in the
+      --  future, e.g. by declaring the maximum possible space for the type.
 
-      elsif Is_Record_Type (Typ)
-        and then Has_Discriminants (Typ)
-        and then not Is_Constrained (Typ)
-      then
+      elsif Is_Indefinite_Subtype (Typ) then
          return True;
 
       --  Functions returning tagged types may dispatch on result so their
@@ -5710,13 +5763,53 @@ package body Sem_Util is
       then
          return True;
 
-      --  Unconstrained array types are returned on the secondary stack
+      --  Record type. OK if none of the component types requires a transient
+      --  scope. Note that we already know that this is a definite type (i.e.
+      --  has discriminant defaults if it is a discriminated record).
+
+      elsif Is_Record_Type (Typ) then
+         declare
+            Comp : Entity_Id;
+         begin
+            Comp := First_Entity (Typ);
+            while Present (Comp) loop
+               if Requires_Transient_Scope (Etype (Comp)) then
+                  return True;
+               else
+                  Next_Entity (Comp);
+               end if;
+            end loop;
+         end;
+
+         return False;
+
+      --  String literal types never require transient scope
+
+      elsif Ekind (Typ) = E_String_Literal_Subtype then
+         return False;
+
+      --  Array type. Note that we already know that this is a constrained
+      --  array, since unconstrained arrays will fail the indefinite test.
 
       elsif Is_Array_Type (Typ) then
-         return not Is_Constrained (Typ);
-      end if;
 
-      return False;
+         --  If component type requires a transient scope, the array does too
+
+         if Requires_Transient_Scope (Component_Type (Typ)) then
+            return True;
+
+         --  Otherwise, we only need a transient scope if the size is not
+         --  known at compile time.
+
+         else
+            return not Size_Known_At_Compile_Time (Typ);
+         end if;
+
+      --  All other cases do not require a transient scope
+
+      else
+         return False;
+      end if;
    end Requires_Transient_Scope;
 
    --------------------------
@@ -6573,7 +6666,7 @@ package body Sem_Util is
                  ("found function name, possibly missing Access attribute!",
                    Expr);
 
-         --  catch common error: a prefix or infix operator which is not
+         --  Catch common error: a prefix or infix operator which is not
          --  directly visible because the type isn't.
 
          elsif Nkind (Expr) in N_Op