[multiple changes]

2009-06-25  Vincent Celier  <celier@adacore.com>

	* vms_data.ads: Minor comment change

2009-06-25  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch5.adb (Expand_N_Extended_Return_Statement): Don't build an
	assignment statement to targeting a caller-provided object when the
	result type is an interface type.

	* exp_ch6.adb (Expand_Call): Remove redundant test of
	Is_Limited_Interface (Is_Inherently_Limited is sufficient).
	(Is_Build_In_Place_Function): Remove test for Is_Limited_Interface.

	* sem_aggr.adb (Check_Expr_OK_In_Limited_Aggregate): Add type in call
	to OK_For_Limited_Init.

	* sem_aux.adb (Is_Inherently_Limited_Type): Revise limited type
	condition so that True is returned for all limited interfaces, not
	just synchronized ones. Ignore components of an interface type when
	checking for limited components (such a component can be a parent
	component).

	* sem_ch3.ads (OK_For_Limited_Init_In_05): Add type parameter.
	(OK_For_Limited_Init): Add type parameter.

	* sem_ch3.adb (Check_Initialization): Add type in call to
	OK_For_Limited_Init.
	(OK_For_Limited_Init): Add new type param in call to
	OK_For_Limited_Init_In_05.
	(OK_For_Limited_Init_In_05): Permit arbitrary expressions of a
	nonlimited type when the context type is a limited interface. Add type
	on recursive calls.

	* sem_ch4.adb (Analyze_Allocator): Add type in call to
	OK_For_Limited_Init.

	* sem_ch6.adb (Check_Limited_Return): Add type in call to
	OK_For_Limited_Init.

	* sem_ch12.adb (Analyze_Formal_Object_Declaration): Add type in call to
	OK_For_Limited_Init.
	(Instantiate_Object): Add type in call to OK_For_Limited_Init.

	* sem_type.adb (Interface_Present_In_Ancestor): In the case of a
	class-wide interface, get the base type before applying Etype, in order
	to account for class-wide subtypes.

From-SVN: r148938

1 files changed, 20 insertions, 6 deletions

diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index f2f55ce..6513e73 100755
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -594,11 +594,16 @@ package body Sem_Aux is
          return True;
 
       elsif Is_Record_Type (Btype) then
+
+         --  Note that we return True for all limited interfaces, even though
+         --  (unsynchronized) limited interfaces can have descendants that are
+         --  nonlimited, because this is a predicate on the type itself, and
+         --  things like functions with limited interface results need to be
+         --  handled as build in place even though they might return objects
+         --  of a type that is not inherently limited.
+
          if Is_Limited_Record (Btype) then
-            return not Is_Interface (Btype)
-              or else Is_Protected_Interface (Btype)
-              or else Is_Synchronized_Interface (Btype)
-              or else Is_Task_Interface (Btype);
+            return True;
 
          elsif Is_Class_Wide_Type (Btype) then
             return Is_Inherently_Limited_Type (Root_Type (Btype));
@@ -610,7 +615,16 @@ package body Sem_Aux is
             begin
                C := First_Component (Btype);
                while Present (C) loop
-                  if Is_Inherently_Limited_Type (Etype (C)) then
+
+                  --  Don't consider components with interface types (which can
+                  --  only occur in the case of a _parent component anyway).
+                  --  They don't have any components, plus it would cause this
+                  --  function to return true for nonlimited types derived from
+                  --  limited intefaces.
+
+                  if not Is_Interface (Etype (C))
+                    and then Is_Inherently_Limited_Type (Etype (C))
+                  then
                      return True;
                   end if;