OSDN Git Service

Fix typo in previous patch.
[pf3gnuchains/gcc-fork.git] / gcc / ada / sem_aux.adb
index 9f7342a..c1b3a33 100755 (executable)
@@ -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- --
@@ -119,7 +119,7 @@ package body Sem_Aux is
       elsif Nkind (D) = N_Object_Renaming_Declaration then
          return Renamed_Object (Ent);
 
-      --  If this is a component declaration whose entity is constant, it is
+      --  If this is a component declaration whose entity is constant, it is
       --  a prival within a protected function (and so has no constant value).
 
       elsif Nkind (D) = N_Component_Declaration then
@@ -312,11 +312,11 @@ package body Sem_Aux is
       Ent : Entity_Id;
 
    begin
-      --  If the base type has no freeze node, it is a type in standard,
+      --  If the base type has no freeze node, it is a type in Standard,
       --  and always acts as its own first subtype unless it is one of the
       --  predefined integer types. If the type is formal, it is also a first
       --  subtype, and its base type has no freeze node. On the other hand, a
-      --  subtype of a generic formal is not its own first_subtype. Its base
+      --  subtype of a generic formal is not its own first subtype. Its base
       --  type, if anonymous, is attached to the formal type decl. from which
       --  the first subtype is obtained.
 
@@ -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;