The test presented below deals with the aspect Volatile. Indeed it's illegal to
instantiate non-volatile formal object with volatile actual.
------------
-- Source --
------------
package Volatile is
type Volatile is tagged record
R : Integer;
end record with Volatile; -- Volatile
type Der_Volatile is new Volatile with record
R2 : Integer;
end record; -- Volatile by inheritance
generic
Non_Formal_Object : in out Integer;
package Non_Volatile_Formal is end;
DerVol : Der_Volatile;
package Error is new Non_Volatile_Formal (DerVol.R2);
-- instantiation error since the actual DerVol.R2 is volatile whereas the
-- formal Non_Formal_Object is non-volatile.
end Volatile;
-----------------
-- Compilation --
-----------------
$ gcc -c -gnat12 volatile.ads
volatile.ads:16:52: cannot instantiate non-volatile formal object with volatile
actual
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-08-06 Vincent Pucci <pu...@adacore.com>
* freeze.adb (Freeze_Entity): Inherit_Aspects_At_Freeze_Point
calls added for derived types and subtypes.
* sem_aux.adb, sem_aux.ads (Get_Rep_Item, Get_Rep_Pragma,
Has_Rep_Pragma): New routines.
* sem_ch13.ads (Inherit_Aspects_At_Freeze_Point): New routine.
* sem_ch13.adb (Analyze_Aspect_Specifications): Error message
for aspect Lock_Free fixed.
(Inherits_Aspects_At_Freeze_Point): New routine.
* sem_ch3.adb: Several flag settings removed since inheritance
of aspects must be performed at freeze point.
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 190171)
+++ sem_ch3.adb (working copy)
@@ -4048,12 +4048,9 @@
-- Inherit common attributes
- Set_Is_Generic_Type (Id, Is_Generic_Type (Base_Type (T)));
Set_Is_Volatile (Id, Is_Volatile (T));
Set_Treat_As_Volatile (Id, Treat_As_Volatile (T));
- Set_Is_Atomic (Id, Is_Atomic (T));
- Set_Is_Ada_2005_Only (Id, Is_Ada_2005_Only (T));
- Set_Is_Ada_2012_Only (Id, Is_Ada_2012_Only (T));
+ Set_Is_Generic_Type (Id, Is_Generic_Type (Base_Type (T)));
Set_Convention (Id, Convention (T));
-- If ancestor has predicates then so does the subtype, and in addition
@@ -5855,13 +5852,6 @@
Analyze (N);
- -- If pragma Discard_Names applies on the first subtype of the parent
- -- type, then it must be applied on this subtype as well.
-
- if Einfo.Discard_Names (First_Subtype (Parent_Type)) then
- Set_Discard_Names (Derived_Type);
- end if;
-
-- Apply a range check. Since this range expression doesn't have an
-- Etype, we have to specifically pass the Source_Typ parameter. Is
-- this right???
@@ -7666,8 +7656,6 @@
-- Fields inherited from the Parent_Type
- Set_Discard_Names
- (Derived_Type, Einfo.Discard_Names (Parent_Type));
Set_Has_Specified_Layout
(Derived_Type, Has_Specified_Layout (Parent_Type));
Set_Is_Limited_Composite
@@ -7711,20 +7699,9 @@
Set_OK_To_Reorder_Components
(Derived_Type, OK_To_Reorder_Components (Parent_Full));
- Set_Reverse_Bit_Order
- (Derived_Type, Reverse_Bit_Order (Parent_Full));
- Set_Reverse_Storage_Order
- (Derived_Type, Reverse_Storage_Order (Parent_Full));
end;
end if;
- -- Direct controlled types do not inherit Finalize_Storage_Only flag
-
- if not Is_Controlled (Parent_Type) then
- Set_Finalize_Storage_Only
- (Derived_Type, Finalize_Storage_Only (Parent_Type));
- end if;
-
-- Set fields for private derived types
if Is_Private_Type (Derived_Type) then
@@ -8043,11 +8020,6 @@
-- they are inherited from the parent type, and these invariants can
-- be further inherited, so both flags are set.
- if Has_Inheritable_Invariants (Parent_Type) then
- Set_Has_Inheritable_Invariants (Derived_Type);
- Set_Has_Invariants (Derived_Type);
- end if;
-
-- We similarly inherit predicates
if Has_Predicates (Parent_Type) then
@@ -12218,7 +12190,6 @@
Set_Component_Type (T1, Component_Type (T2));
Set_Component_Size (T1, Component_Size (T2));
Set_Has_Controlled_Component (T1, Has_Controlled_Component (T2));
- Set_Finalize_Storage_Only (T1, Finalize_Storage_Only (T2));
Set_Has_Non_Standard_Rep (T1, Has_Non_Standard_Rep (T2));
Set_Has_Task (T1, Has_Task (T2));
Set_Is_Packed (T1, Is_Packed (T2));
@@ -12237,7 +12208,6 @@
Set_First_Index (T1, First_Index (T2));
Set_Is_Aliased (T1, Is_Aliased (T2));
- Set_Is_Atomic (T1, Is_Atomic (T2));
Set_Is_Volatile (T1, Is_Volatile (T2));
Set_Treat_As_Volatile (T1, Treat_As_Volatile (T2));
Set_Is_Constrained (T1, Is_Constrained (T2));
Index: sem_aux.adb
===================================================================
--- sem_aux.adb (revision 190155)
+++ sem_aux.adb (working copy)
@@ -489,6 +489,40 @@
return Empty;
end Get_Rep_Item;
+ function Get_Rep_Item
+ (E : Entity_Id;
+ Nam1 : Name_Id;
+ Nam2 : Name_Id;
+ Check_Parents : Boolean := True) return Node_Id
+ is
+ Nam1_Item : constant Node_Id := Get_Rep_Item (E, Nam1, Check_Parents);
+ Nam2_Item : constant Node_Id := Get_Rep_Item (E, Nam2, Check_Parents);
+
+ N : Node_Id;
+
+ begin
+ -- Check both Nam1_Item and Nam2_Item are present
+
+ if No (Nam1_Item) then
+ return Nam2_Item;
+ elsif No (Nam2_Item) then
+ return Nam1_Item;
+ end if;
+
+ -- Return the first node encountered in the list
+
+ N := First_Rep_Item (E);
+ while Present (N) loop
+ if N = Nam1_Item or else N = Nam2_Item then
+ return N;
+ end if;
+
+ Next_Rep_Item (N);
+ end loop;
+
+ return Empty;
+ end Get_Rep_Item;
+
--------------------
-- Get_Rep_Pragma --
--------------------
@@ -501,31 +535,41 @@
N : Node_Id;
begin
- N := First_Rep_Item (E);
- while Present (N) loop
- if Nkind (N) = N_Pragma
- and then
- (Pragma_Name (N) = Nam
- or else (Nam = Name_Interrupt_Priority
- and then Pragma_Name (N) = Name_Priority))
- then
- if Check_Parents then
- return N;
+ N := Get_Rep_Item (E, Nam, Check_Parents);
- -- If Check_Parents is False, return N if the pragma doesn't
- -- appear in the Rep_Item chain of the parent.
+ if Present (N) and then Nkind (N) = N_Pragma then
+ return N;
+ end if;
- else
- declare
- Par : constant Entity_Id := Nearest_Ancestor (E);
- -- This node represents the parent type of type E (if any)
+ return Empty;
+ end Get_Rep_Pragma;
- begin
- if No (Par) or else not Present_In_Rep_Item (Par, N) then
- return N;
- end if;
- end;
- end if;
+ function Get_Rep_Pragma
+ (E : Entity_Id;
+ Nam1 : Name_Id;
+ Nam2 : Name_Id;
+ Check_Parents : Boolean := True) return Node_Id
+ is
+ Nam1_Item : constant Node_Id := Get_Rep_Pragma (E, Nam1, Check_Parents);
+ Nam2_Item : constant Node_Id := Get_Rep_Pragma (E, Nam2, Check_Parents);
+
+ N : Node_Id;
+
+ begin
+ -- Check both Nam1_Item and Nam2_Item are present
+
+ if No (Nam1_Item) then
+ return Nam2_Item;
+ elsif No (Nam2_Item) then
+ return Nam1_Item;
+ end if;
+
+ -- Return the first node encountered in the list
+
+ N := First_Rep_Item (E);
+ while Present (N) loop
+ if N = Nam1_Item or else N = Nam2_Item then
+ return N;
end if;
Next_Rep_Item (N);
@@ -547,6 +591,16 @@
return Present (Get_Rep_Item (E, Nam, Check_Parents));
end Has_Rep_Item;
+ function Has_Rep_Item
+ (E : Entity_Id;
+ Nam1 : Name_Id;
+ Nam2 : Name_Id;
+ Check_Parents : Boolean := True) return Boolean
+ is
+ begin
+ return Present (Get_Rep_Item (E, Nam1, Nam2, Check_Parents));
+ end Has_Rep_Item;
+
--------------------
-- Has_Rep_Pragma --
--------------------
@@ -560,6 +614,16 @@
return Present (Get_Rep_Pragma (E, Nam, Check_Parents));
end Has_Rep_Pragma;
+ function Has_Rep_Pragma
+ (E : Entity_Id;
+ Nam1 : Name_Id;
+ Nam2 : Name_Id;
+ Check_Parents : Boolean := True) return Boolean
+ is
+ begin
+ return Present (Get_Rep_Pragma (E, Nam1, Nam2, Check_Parents));
+ end Has_Rep_Pragma;
+
-------------------------------
-- Initialization_Suppressed --
-------------------------------
Index: sem_aux.ads
===================================================================
--- sem_aux.ads (revision 190155)
+++ sem_aux.ads (working copy)
@@ -168,18 +168,47 @@
-- otherwise Empty is returned. A special case is that when Nam is
-- Name_Priority, the call will also find Interrupt_Priority.
+ function Get_Rep_Item
+ (E : Entity_Id;
+ Nam1 : Name_Id;
+ Nam2 : Name_Id;
+ Check_Parents : Boolean := True) return Node_Id;
+ -- Searches the Rep_Item chain for a given entity E, for an instance of a
+ -- rep item (pragma, attribute definition clause, or aspect specification)
+ -- whose name matches one of the given names Nam1 or Nam2. If Check_Parents
+ -- is False then it only returns rep item that has been directly specified
+ -- for E (and not inherited from its parents, if any). If one is found, it
+ -- is returned, otherwise Empty is returned. A special case is that when
+ -- one of the given names is Name_Priority, the call will also find
+ -- Interrupt_Priority.
+
function Get_Rep_Pragma
(E : Entity_Id;
Nam : Name_Id;
Check_Parents : Boolean := True) return Node_Id;
- -- Searches the Rep_Item chain for a given entity E, for an instance
- -- of a representation pragma whose name matches the given name Nam. If
+ -- Searches the Rep_Item chain for a given entity E, for an instance of a
+ -- representation pragma whose name matches the given name Nam. If
-- Check_Parents is False then it only returns representation pragma that
-- has been directly specified for E (and not inherited from its parents,
- -- if any). If one is found, it is returned, otherwise Empty is returned. A
- -- special case is that when Nam is Name_Priority, the call will also find
+ -- if any). If one is found and if it is the first rep item in the list
+ -- that matches Nam, it is returned, otherwise Empty is returned. A special
+ -- case is that when Nam is Name_Priority, the call will also find
-- Interrupt_Priority.
+ function Get_Rep_Pragma
+ (E : Entity_Id;
+ Nam1 : Name_Id;
+ Nam2 : Name_Id;
+ Check_Parents : Boolean := True) return Node_Id;
+ -- Searches the Rep_Item chain for a given entity E, for an instance of a
+ -- representation pragma whose name matches one of the given names Nam1 or
+ -- Nam2. If Check_Parents is False then it only returns representation
+ -- pragma that has been directly specified for E (and not inherited from
+ -- its parents, if any). If one is found and if it is the first rep item in
+ -- the list that matches one of the given names, it is returned, otherwise
+ -- Empty is returned. A special case is that when one of the given names is
+ -- Name_Priority, the call will also find Interrupt_Priority.
+
function Has_Rep_Item
(E : Entity_Id;
Nam : Name_Id;
@@ -191,6 +220,18 @@
-- from its parents, if any). If found then True is returned, otherwise
-- False indicates that no matching entry was found.
+ function Has_Rep_Item
+ (E : Entity_Id;
+ Nam1 : Name_Id;
+ Nam2 : Name_Id;
+ Check_Parents : Boolean := True) return Boolean;
+ -- Searches the Rep_Item chain for the given entity E, for an instance of a
+ -- rep item (pragma, attribute definition clause, or aspect specification)
+ -- with the given names Nam1 or Nam2. If Check_Parents is False then it
+ -- only checks for a rep item that has been directly specified for E (and
+ -- not inherited from its parents, if any). If found then True is returned,
+ -- otherwise False indicates that no matching entry was found.
+
function Has_Rep_Pragma
(E : Entity_Id;
Nam : Name_Id;
@@ -199,9 +240,22 @@
-- representation pragma with the given name Nam. If Check_Parents is False
-- then it only checks for a representation pragma that has been directly
-- specified for E (and not inherited from its parents, if any). If found
- -- then True is returned, otherwise False indicates that no matching entry
- -- was found.
+ -- and if it is the first rep item in the list that matches Nam then True
+ -- is returned, otherwise False indicates that no matching entry was found.
+ function Has_Rep_Pragma
+ (E : Entity_Id;
+ Nam1 : Name_Id;
+ Nam2 : Name_Id;
+ Check_Parents : Boolean := True) return Boolean;
+ -- Searches the Rep_Item chain for the given entity E, for an instance of a
+ -- representation pragma with the given names Nam1 or Nam2. If
+ -- Check_Parents is False then it only checks for a rep item that has been
+ -- directly specified for E (and not inherited from its parents, if any).
+ -- If found and if it is the first rep item in the list that matches one of
+ -- the given names then True is returned, otherwise False indicates that no
+ -- matching entry was found.
+
function In_Generic_Body (Id : Entity_Id) return Boolean;
-- Determine whether entity Id appears inside a generic body
Index: freeze.adb
===================================================================
--- freeze.adb (revision 190155)
+++ freeze.adb (working copy)
@@ -3434,11 +3434,22 @@
end if;
end if;
+ -- A subtype inherits all the type-related representation aspects
+ -- from its parents (RM 13.1(8)).
+
+ Inherit_Aspects_At_Freeze_Point (E);
+
-- For a derived type, freeze its parent type first (RM 13.14(15))
elsif Is_Derived_Type (E) then
Freeze_And_Append (Etype (E), N, Result);
Freeze_And_Append (First_Subtype (Etype (E)), N, Result);
+
+ -- A derived type inherits each type-related representation aspect
+ -- of its parent type that was directly specified before the
+ -- declaration of the derived type (RM 13.1(15)).
+
+ Inherit_Aspects_At_Freeze_Point (E);
end if;
-- For array type, freeze index types and component type first
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 190161)
+++ sem_ch13.adb (working copy)
@@ -856,9 +856,7 @@
-- Start of processing for Analyze_Aspects_At_Freeze_Point
begin
- -- Must be visible in current scope. Note that this is needed for
- -- entities that creates their own scope such as protected objects,
- -- tasks, etc.
+ -- Must be visible in current scope.
if not Scope_Within_Or_Same (Current_Scope, Scope (E)) then
return;
@@ -1650,6 +1648,7 @@
if A_Id = Aspect_Lock_Free then
if Ekind (E) /= E_Protected_Type then
+ Error_Msg_Name_1 := Nam;
Error_Msg_N
("aspect % only applies to a protected object",
Aspect);
@@ -7943,6 +7942,223 @@
end if;
end Get_Alignment_Value;
+ -------------------------------------
+ -- Inherit_Aspects_At_Freeze_Point --
+ -------------------------------------
+
+ procedure Inherit_Aspects_At_Freeze_Point (Typ : Entity_Id) is
+ function Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item
+ (Rep_Item : Node_Id) return Boolean;
+ -- This routine checks if Rep_Item is either a pragma or an aspect
+ -- specification node whose correponding pragma (if any) is present in
+ -- the Rep Item chain of the entity it has been specified to.
+
+ --------------------------------------------------
+ -- Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item --
+ --------------------------------------------------
+
+ function Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item
+ (Rep_Item : Node_Id) return Boolean
+ is
+ begin
+ return Nkind (Rep_Item) = N_Pragma
+ or else Present_In_Rep_Item
+ (Entity (Rep_Item), Aspect_Rep_Item (Rep_Item));
+ end Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item;
+
+ begin
+ -- A representation item is either subtype-specific (Size and Alignment
+ -- clauses) or type-related (all others). Subtype-specific aspects may
+ -- differ for different subtypes of the same type.(RM 13.1.8)
+
+ -- A derived type inherits each type-related representation aspect of
+ -- its parent type that was directly specified before the declaration of
+ -- the derived type. (RM 13.1.15)
+
+ -- A derived subtype inherits each subtype-specific representation
+ -- aspect of its parent subtype that was directly specified before the
+ -- declaration of the derived type .(RM 13.1.15)
+
+ -- The general processing involves inheriting a representation aspect
+ -- from a parent type whenever the first rep item (aspect specification,
+ -- attribute definition clause, pragma) corresponding to the given
+ -- representation aspect in the rep item chain of Typ, if any, isn't
+ -- directly specified to Typ but to one of its parents.
+
+ -- ??? Note that, for now, just a limited number of representation
+ -- aspects have been inherited here so far. Many of them are still
+ -- inherited in Sem_Ch3. This will be fixed soon. Here is a
+ -- non-exhaustive list of aspects that likely also need to be moved to
+ -- this routine: Alignment, Component_Alignment, Component_Size,
+ -- Machine_Radix, Object_Size, Pack, Predicates,
+ -- Preelaborable_Initialization, RM_Size and Small.
+
+ if Nkind (Parent (Typ)) = N_Private_Extension_Declaration then
+ return;
+ end if;
+
+ -- Ada_05/Ada_2005
+
+ if not Has_Rep_Item (Typ, Name_Ada_05, Name_Ada_2005, False)
+ and then Has_Rep_Item (Typ, Name_Ada_05, Name_Ada_2005)
+ and then Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item
+ (Get_Rep_Item (Typ, Name_Ada_05, Name_Ada_2005))
+ then
+ Set_Is_Ada_2005_Only (Typ);
+ end if;
+
+ -- Ada_12/Ada_2012
+
+ if not Has_Rep_Item (Typ, Name_Ada_12, Name_Ada_2012, False)
+ and then Has_Rep_Item (Typ, Name_Ada_12, Name_Ada_2012)
+ and then Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item
+ (Get_Rep_Item (Typ, Name_Ada_12, Name_Ada_2012))
+ then
+ Set_Is_Ada_2012_Only (Typ);
+ end if;
+
+ -- Atomic/Shared
+
+ if not Has_Rep_Item (Typ, Name_Atomic, Name_Shared, False)
+ and then Has_Rep_Pragma (Typ, Name_Atomic, Name_Shared)
+ and then Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item
+ (Get_Rep_Item (Typ, Name_Atomic, Name_Shared))
+ then
+ Set_Is_Atomic (Typ);
+ Set_Treat_As_Volatile (Typ);
+ Set_Is_Volatile (Typ);
+ end if;
+
+ -- Default_Component_Value.
+
+ if Is_Array_Type (Typ)
+ and then Has_Rep_Item (Typ, Name_Default_Component_Value, False)
+ and then Has_Rep_Item (Typ, Name_Default_Component_Value)
+ then
+ Set_Default_Aspect_Component_Value (Typ,
+ Default_Aspect_Component_Value
+ (Entity (Get_Rep_Item (Typ, Name_Default_Component_Value))));
+ end if;
+
+ -- Default_Value.
+
+ if Is_Scalar_Type (Typ)
+ and then Has_Rep_Item (Typ, Name_Default_Value, False)
+ and then Has_Rep_Item (Typ, Name_Default_Value)
+ then
+ Set_Default_Aspect_Value (Typ,
+ Default_Aspect_Value
+ (Entity (Get_Rep_Item (Typ, Name_Default_Value))));
+ end if;
+
+ -- Discard_Names
+
+ if not Has_Rep_Item (Typ, Name_Discard_Names, False)
+ and then Has_Rep_Item (Typ, Name_Discard_Names)
+ and then Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item
+ (Get_Rep_Item (Typ, Name_Discard_Names))
+ then
+ Set_Discard_Names (Typ);
+ end if;
+
+ -- Invariants
+
+ if not Has_Rep_Item (Typ, Name_Invariant, False)
+ and then Has_Rep_Item (Typ, Name_Invariant)
+ and then Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item
+ (Get_Rep_Item (Typ, Name_Invariant))
+ then
+ Set_Has_Invariants (Typ);
+
+ if Class_Present (Get_Rep_Item (Typ, Name_Invariant)) then
+ Set_Has_Inheritable_Invariants (Typ);
+ end if;
+ end if;
+
+ -- Volatile
+
+ if not Has_Rep_Item (Typ, Name_Volatile, False)
+ and then Has_Rep_Item (Typ, Name_Volatile)
+ and then Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item
+ (Get_Rep_Item (Typ, Name_Volatile))
+ then
+ Set_Treat_As_Volatile (Typ);
+ Set_Is_Volatile (Typ);
+ end if;
+
+ -- Inheritance for derived types only
+
+ if Is_Derived_Type (Typ) then
+ declare
+ Bas_Typ : constant Entity_Id := Base_Type (Typ);
+ Imp_Bas_Typ : constant Entity_Id := Implementation_Base_Type (Typ);
+
+ begin
+ -- Atomic_Components
+
+ if not Has_Rep_Item (Typ, Name_Atomic_Components, False)
+ and then Has_Rep_Item (Typ, Name_Atomic_Components)
+ and then Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item
+ (Get_Rep_Item (Typ, Name_Atomic_Components))
+ then
+ Set_Has_Atomic_Components (Imp_Bas_Typ);
+ end if;
+
+ -- Volatile_Components
+
+ if not Has_Rep_Item (Typ, Name_Volatile_Components, False)
+ and then Has_Rep_Item (Typ, Name_Volatile_Components)
+ and then Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item
+ (Get_Rep_Item (Typ, Name_Volatile_Components))
+ then
+ Set_Has_Volatile_Components (Imp_Bas_Typ);
+ end if;
+
+ -- Finalize_Storage_Only.
+
+ if not Has_Rep_Pragma (Typ, Name_Finalize_Storage_Only, False)
+ and then Has_Rep_Pragma (Typ, Name_Finalize_Storage_Only)
+ then
+ Set_Finalize_Storage_Only (Bas_Typ);
+ end if;
+
+ -- Universal_Aliasing
+
+ if not Has_Rep_Item (Typ, Name_Universal_Aliasing, False)
+ and then Has_Rep_Item (Typ, Name_Universal_Aliasing)
+ and then Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item
+ (Get_Rep_Item (Typ, Name_Universal_Aliasing))
+ then
+ Set_Universal_Aliasing (Imp_Bas_Typ);
+ end if;
+
+ -- Record type specific aspects
+
+ if Is_Record_Type (Typ) then
+ -- Bit_Order
+
+ if not Has_Rep_Item (Typ, Name_Bit_Order, False)
+ and then Has_Rep_Item (Typ, Name_Bit_Order)
+ then
+ Set_Reverse_Bit_Order (Bas_Typ,
+ Reverse_Bit_Order (Entity (Name
+ (Get_Rep_Item (Typ, Name_Bit_Order)))));
+ end if;
+
+ -- Scalar_Storage_Order
+
+ if not Has_Rep_Item (Typ, Name_Scalar_Storage_Order, False)
+ and then Has_Rep_Item (Typ, Name_Scalar_Storage_Order)
+ then
+ Set_Reverse_Storage_Order (Bas_Typ,
+ Reverse_Storage_Order (Entity (Name
+ (Get_Rep_Item (Typ, Name_Scalar_Storage_Order)))));
+ end if;
+ end if;
+ end;
+ end if;
+ end Inherit_Aspects_At_Freeze_Point;
+
----------------
-- Initialize --
----------------
Index: sem_ch13.ads
===================================================================
--- sem_ch13.ads (revision 190155)
+++ sem_ch13.ads (working copy)
@@ -310,4 +310,8 @@
-- Performs the processing described above at the freeze all point, and
-- issues appropriate error messages if the visibility has indeed changed.
-- Again, ASN is the N_Aspect_Specification node for the aspect.
+
+ procedure Inherit_Aspects_At_Freeze_Point (Typ : Entity_Id);
+ -- Given an entity Typ that denotes a derived type or a subtype, this
+ -- routine performs the inheritance of aspects at the freeze point.
end Sem_Ch13;
