sem_cat.ads, [...] (Has_Stream_Attribute_Definition): New formal At_Any_Place indicating...

2007-08-14  Thomas Quinot  <quinot@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* sem_cat.ads, sem_cat.adb (Has_Stream_Attribute_Definition): New
	formal At_Any_Place indicating, when True, that we want to test for
	availability of the stream attribute at any place (as opposed to the
	current visibility context only).
	(Missing_Read_Write_Attributes): A stream attribute is missing for the
	purpose of enforcing E.2.2(8) only if it is not available at any place.
	Take into account the Ada2005 pragma Has_Preelaborable_Initialization
	when checking the legality of an extension aggregate in a preelaborable
	package. Treat the literal null as a valid default expression in a
	component declaration for a type with preelaborable initialization.
	A limited interface is a legal progenitor for the designated type of a
	remote access to class-wide type.

From-SVN: r127445

gcc/ada/sem_cat.adb

@@ -71,10 +71,9 @@ package body Sem_Cat is
    --  that no component is declared with a non-static default value.
 
    function Missing_Read_Write_Attributes (E : Entity_Id) return Boolean;
-   --  Return True if the entity or one of its subcomponent is an access
-   --  type which does not have user-defined Read and Write attribute.
-   --  Additionally, in Ada 2005 mode, stream attributes are considered missing
-   --  if the attribute definition clause is not visible.
+   --  Return True if the entity or one of its subcomponents is of an access
+   --  type that does not have user-defined Read and Write attributes visible
+   --  at any place.
 
    function In_RCI_Declaration (N : Node_Id) return Boolean;
    --  Determines if a declaration is  within the visible part of  a Remote
@@ -314,7 +313,9 @@ package body Sem_Cat is
    -------------------------------------
 
    function Has_Stream_Attribute_Definition
-     (Typ : Entity_Id; Nam : TSS_Name_Type) return Boolean
+     (Typ          : Entity_Id;
+      Nam          : TSS_Name_Type;
+      At_Any_Place : Boolean := False) return Boolean
    is
       Rep_Item : Node_Id;
    begin
@@ -322,7 +323,8 @@ package body Sem_Cat is
       --  the list until we find the requested attribute definition clause.
       --  In Ada 2005 mode, clauses are ignored if they are not currently
       --  visible (this is tested using the corresponding Entity, which is
-      --  inserted by the expander at the point where the clause occurs).
+      --  inserted by the expander at the point where the clause occurs),
+      --  unless At_Any_Place is true.
 
       Rep_Item := First_Rep_Item (Typ);
       while Present (Rep_Item) loop
@@ -349,8 +351,13 @@ package body Sem_Cat is
          Next_Rep_Item (Rep_Item);
       end loop;
 
+      --  If At_Any_Place is true, return True if the attribute is available
+      --  at any place; if it is false, return True only if the attribute is
+      --  currently visible.
+
       return Present (Rep_Item)
         and then (Ada_Version < Ada_05
+                   or else At_Any_Place
                    or else not Is_Hidden (Entity (Rep_Item)));
    end Has_Stream_Attribute_Definition;
 
@@ -508,8 +515,24 @@ package body Sem_Cat is
         and then Is_Limited_Record (E)
       then
          return True;
+
+      --  A limited interface is not currently a legal ancestor for the
+      --  designated type of an RACW type, because a type that implements
+      --  such an interface need not be limited. However, the ARG seems to
+      --  incline towards allowing an access to classwide limited interface
+      --  type as a remote access type. This may be revised when the ARG
+      --  rules on this question, but it seems safe to allow it for now,
+      --  in order to see whether it is a useful extension for distributed
+      --  programming, in particular for Brad Moore's buffer taxonomy.
+
+      elsif Is_Limited_Record (E)
+        and then Is_Limited_Interface (E)
+      then
+         return True;
+
       elsif Nkind (P) = N_Private_Extension_Declaration then
          return Is_Recursively_Limited_Private (Etype (E));
+
       elsif Nkind (P) = N_Formal_Type_Declaration
         and then Ekind (E) = E_Record_Type_With_Private
         and then Is_Generic_Type (E)
@@ -531,8 +554,8 @@ package body Sem_Cat is
       U_E            : constant Entity_Id := Underlying_Type (E);
 
       function Has_Read_Write_Attributes (E : Entity_Id) return Boolean;
-      --  Return True if entity has visible attribute definition clauses for
-      --  Read and Write attributes.
+      --  Return True if entity has attribute definition clauses for Read and
+      --  Write attributes that are visible at some place.
 
       -------------------------------
       -- Has_Read_Write_Attributes --
@@ -541,8 +564,10 @@ package body Sem_Cat is
       function Has_Read_Write_Attributes (E : Entity_Id) return Boolean is
       begin
          return True
-           and then Has_Stream_Attribute_Definition (E, TSS_Stream_Read)
-           and then Has_Stream_Attribute_Definition (E, TSS_Stream_Write);
+           and then Has_Stream_Attribute_Definition (E,
+                      TSS_Stream_Read,  At_Any_Place => True)
+           and then Has_Stream_Attribute_Definition (E,
+                      TSS_Stream_Write, At_Any_Place => True);
       end Has_Read_Write_Attributes;
 
    --  Start of processing for Missing_Read_Write_Attributes
@@ -824,16 +849,13 @@ package body Sem_Cat is
         and then (not Inside_A_Generic
                    or else Present (Enclosing_Generic_Body (N)))
       then
-         --  We relax the restriction of 10.2.1(9) within GNAT
-         --  units to allow packages such as Ada.Strings.Unbounded
-         --  to be implemented (i.p., Null_Unbounded_String).
-         --  (There are ACVC tests that check that the restriction
-         --  is enforced, but note that AI-161, once approved,
-         --  will relax the restriction prohibiting default-
-         --  initialized objects of private and controlled
-         --  types.)
+         --  If the type is private, it must have the Ada 2005 pragma
+         --  Has_Preelaborable_Initialization.
+         --  The check is omitted within predefined units. This is probably
+         --  obsolete code to fix the Ada95 weakness in this area ???
 
          if Is_Private_Type (T)
+           and then not Has_Pragma_Preelab_Init (T)
            and then not Is_Internal_File_Name
                           (Unit_File_Name (Get_Source_Unit (N)))
          then
@@ -1854,11 +1876,11 @@ package body Sem_Cat is
                if Ada_Version >= Ada_05 then
                   Error_Msg_N
                     ("\must have visible Read and Write attribute " &
-                     "definition clauses ('R'M E.2.2(8))", U_Typ);
+                     "definition clauses (RM E.2.2(8))", U_Typ);
                else
                   Error_Msg_N
                     ("\must have Read and Write attribute " &
-                     "definition clauses ('R'M E.2.2(8))", U_Typ);
+                     "definition clauses (RM E.2.2(8))", U_Typ);
                end if;
             end if;
          end if;

gcc/ada/sem_cat.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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- --
@@ -42,14 +42,18 @@ with Types;   use Types;
 package Sem_Cat is
 
    function Has_Stream_Attribute_Definition
-     (Typ : Entity_Id; Nam : TSS_Name_Type) return Boolean;
+     (Typ          : Entity_Id;
+      Nam          : TSS_Name_Type;
+      At_Any_Place : Boolean := False) return Boolean;
    --  True when there is a attribute definition clause specifying attribute
    --  Nam for Typ. In Ada 2005 mode, returns True only when the attribute
-   --  definition clause is visible. Note that attribute definition clauses
+   --  definition clause is visible, unless At_Any_Place is True (in which case
+   --  no visiblity test is made, and True is returned as long as an attribute
+   --  is visible at any place). Note that attribute definition clauses
    --  inherited from parent types are taken into account by this predicate
    --  (to test for presence of an attribute definition clause for one
    --  specific type, excluding inherited definitions, the flags
-   --  Has_Specicied_Stream_* can be used instead).
+   --  Has_Specified_Stream_* can be used instead).
 
    function In_Preelaborated_Unit return Boolean;
    --  Determines if the current scope is within a preelaborated compilation