[Ada] relax Ada 2005 legality check
Arnaud Charlet
charlet@adacore.com
Tue Aug 28 09:35:00 GMT 2007
Tested on i686-linux, committed on trunk
This change relaxes an Ada 2005 legality check for types with access
components in units that have the Remote_Types category (the compiler was
too strict). gnat.dg/remote_type.adb must be accepted without error.
This patch also updates several semantic checks related to categorization
pragmas.
These checks still reflected Ada95 semantics, and some details of Ai95-116
were not fully implemented.
See gnat.dg/specs/ai_116.ads
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.
-------------- next part --------------
Index: sem_cat.ads
===================================================================
--- sem_cat.ads (revision 127358)
+++ sem_cat.ads (working copy)
@@ -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
Index: sem_cat.adb
===================================================================
--- sem_cat.adb (revision 127358)
+++ sem_cat.adb (working copy)
@@ -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
@@ -906,7 +928,7 @@ package body Sem_Cat is
then
Entity_Of_Withed := Entity (Name (Item));
Check_Categorization_Dependencies
- (U, Entity_Of_Withed, Item, Is_Subunit);
+ (U, Entity_Of_Withed, Item, Is_Subunit);
end if;
Next (Item);
@@ -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;
More information about the Gcc-patches
mailing list