Skip to content

R
riscv-gcc-1
Commit fe685905 by Thomas Quinot Committed by Arnaud Charlet
Options

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
parent 401093c1
Showing with 51 additions and 25 deletions
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
......@@ -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;
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment