home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Geek Gadgets 1
/
ADE-1.bin
/
ade-dist
/
gnat-2.06-src.tgz
/
tar.out
/
fsf
/
gnat
/
ada
/
freeze.adb
< prev
next >
Wrap
Text File
|
1996-09-28
|
34KB
|
963 lines
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- F R E E Z E --
-- --
-- B o d y --
-- --
-- $Revision: 1.30 $ --
-- --
-- Copyright (c) 1992,1993,1994,1995 NYU, All Rights Reserved --
-- --
-- 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
with Exp_Util; use Exp_Util;
with Itypes; use Itypes;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Output; use Output;
with Sem; use Sem;
with Sem_Ch7; use Sem_Ch7;
with Sem_Ch8; use Sem_Ch8;
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Uintp; use Uintp;
package body Freeze is
----------------
-- Freeze_All --
----------------
-- Note: the easy coding for this procedure would be to just build a
-- single list of freeze nodes and then insert them and analyze them
-- all at once. This won't work, because the analysis of earlier freeze
-- nodes may recursively freeze types which would otherwise appear later
-- on in the freeze list. So we must analyze and expand the freeze nodes
-- as they are generated.
procedure Freeze_All (From : Entity_Id; After : in out Node_Id) is
Loc : constant Source_Ptr := Sloc (Last_Entity (Current_Scope));
E : Entity_Id;
F : Entity_Id;
Dexpr : Node_Id;
procedure Freeze_All_Ent (From : Entity_Id; After : in out Node_Id);
-- This is the internal recursive routine that does freezing of
-- entities (but NOT the analysis of default expressions, which
-- should not be recursive, we don't want to analyze those till
-- we are sure that ALL the types are frozen).
procedure Freeze_All_Ent
(From : Entity_Id;
After : in out Node_Id)
is
E : Entity_Id;
Flist : List_Id;
Lastn : Node_Id;
begin
E := From;
while Present (E) loop
if not Is_Frozen (E) then
Flist := Freeze_Entity (E, Loc);
if Is_Non_Empty_List (Flist) then
Lastn := Last (Flist);
Insert_List_After_And_Analyze (After, Flist);
After := Lastn;
end if;
-- If the entity is an inner package which is not a package
-- renaming, then its entities must be frozen at this point.
-- Note that such entities do NOT get frozen at the end of
-- the nested package itself (only library packages freeze).
-- Same is true for task declarations, where anonymous records
-- created for entry parameters must be frozen.
if Ekind (E) = E_Package
and then No (Renamed_Object (E))
and then not Is_Child_Unit (E)
then
New_Scope (E);
Install_Visible_Declarations (E);
Install_Private_Declarations (E);
Freeze_All (First_Entity (E), After);
End_Package_Scope (E);
elsif Ekind (E) in Task_Kind
and then
(Nkind (Parent (E)) = N_Task_Type_Declaration
or else
Nkind (Parent (E)) = N_Single_Task_Declaration)
then
New_Scope (E);
Freeze_All (First_Entity (E), After);
End_Scope;
end if;
end if;
E := Next_Entity (E);
end loop;
end Freeze_All_Ent;
-- Start of processing for Freeze_All
begin
Freeze_All_Ent (From, After);
-- Now that all types are frozen, we can analyze and resolve any
-- default expressions in subprogram specifications (we can't do
-- this earlier, because we have to wait till the types are sure
-- to be frozen).
-- Loop through entities
E := From;
while Present (E) loop
if Is_Subprogram (E)
or else Ekind (E) = E_Entry
or else Ekind (E) = E_Entry_Family
then
-- Loop through formals of one subprogram specification
-- and look for in parameters with default expressions.
-- They have been analyzed, but not frozen yet, and are
-- resolved with their own type if the context is generic,
-- to avoid anomalies with private types.
F := First_Formal (E);
while Present (F) loop
if Ekind (F) = E_In_Parameter then
Dexpr := Default_Value (F);
if Present (Dexpr) then
Analyze (Dexpr);
if Ekind (Scope (E)) = E_Generic_Package then
Resolve (Dexpr, Etype (Dexpr));
else
Resolve (Dexpr, Etype (F));
end if;
end if;
end if;
F := Next_Formal (F);
end loop;
end if;
E := Next_Entity (E);
end loop;
end Freeze_All;
-------------------
-- Freeze_Before --
-------------------
procedure Freeze_Before (N : Node_Id; T : Entity_Id) is
Freeze_Nodes : constant List_Id := Freeze_Entity (T, Sloc (N));
F : Node_Id;
begin
F := First (Freeze_Nodes);
if Present (F) then
if Nkind (N) = N_Object_Declaration then
-- Implicit types are transfered into the Freeze Node because
-- they may be frozen here!
Transfer_Itypes (From => N, To => F);
end if;
Insert_Actions (N, Freeze_Nodes);
end if;
end Freeze_Before;
-------------------
-- Freeze_Entity --
-------------------
function Freeze_Entity (E : Entity_Id; Loc : Source_Ptr) return List_Id is
Comp : Entity_Id;
Elmt : Elmt_Id;
F_Node : Node_Id;
Op_List : Elist_Id;
Result : List_Id;
Subp : Entity_Id;
Indx : Node_Id;
Formal : Entity_Id;
procedure Freeze_Aux (Frst : Entity_Id);
-- Freeze the given entity when it must be frozen before or after the
-- current entity (makes a recursive call to Freeze_Entity and then
-- appends the result to the current freeze list).
procedure Freeze_Aux (Frst : Entity_Id) is
begin
Append_List (Freeze_Entity (Frst, Loc), Result);
end Freeze_Aux;
-- Start of processing for Freeze_Entity
begin
-- Do not freeze if already frozen since we only need one freeze node.
if Is_Frozen (E) then
return Empty_List;
end if;
-- Here to freeze the entity
Result := New_List;
Set_Is_Frozen (E);
-- Case of entity being frozen is other than a type
if not Is_Type (E) then
-- For a subprogram, freeze all parameter types and also the return
-- type (RM 13.14(13)). However skip this for internal subprograms.
if Is_Subprogram (E) then
if not Is_Internal (E) then
Formal := First_Formal (E);
while Present (Formal) loop
Freeze_Aux (Etype (Formal));
Formal := Next_Formal (Formal);
end loop;
Freeze_Aux (Etype (E));
end if;
-- If entity has a type, freeze it first (RM 13.14(10))
elsif Present (Etype (E)) then
Freeze_Aux (Etype (E));
end if;
-- Case of a type or subtype being frozen
else
Check_Compile_Time_Size (E);
-- For a subtype, freeze the base type of the entity before freezing
-- the entity itself, (RM 13.14(14)).
if E /= Base_Type (E) then
Freeze_Aux (Base_Type (E));
-- For a derived type, freeze its parent type first (RM 13.14(14))
elsif Is_Derived_Type (E) then
Freeze_Aux (Etype (E));
end if;
-- For array type, freeze index types and component type first
-- before freezing the array (RM 13.14(14)).
if Is_Array_Type (E) then
Freeze_Aux (Component_Type (E));
Indx := First_Index (E);
while Present (Indx) loop
Freeze_Aux (Etype (Indx));
Indx := Next_Index (Indx);
end loop;
-- For a class wide type, the corresponding specific type is
-- frozen as well (RM 13.14(14))
elsif Is_Class_Wide_Type (E) then
Freeze_Aux (Root_Type (E));
-- For record type, freeze the all component types (RM 13.14(14).
-- We test for E_Record_Type here, rather than using Is_Record_Type,
-- because we don't want to attempt the freeze for the case of a
-- private type with record extension (we will do that later when
-- the full type is frozen).
elsif Ekind (E) = E_Record_Type then
Comp := First_Entity (E);
while Present (Comp) loop
Freeze_Aux (Etype (Comp));
Comp := Next_Entity (Comp);
end loop;
-- Tagged records
if Is_Tagged_Type (E)
and then Ekind (E) = E_Record_Type
then
-- This is also an opportunity for some semantic checks on
-- primitive subprograms of the type. In particular this is
-- where we check that all abstract subprograms have been
-- overridden as required, and that we have not overridden
-- a non-abstract subprogram with an abstract one incorrectly.
Op_List := Primitive_Operations (E);
-- Loop to check primitive operations
Elmt := First_Elmt (Op_List);
while Present (Elmt) loop
Subp := Node (Elmt);
if Is_Abstract (Subp) and then not Is_Abstract (E) then
if Present (Alias (Subp)) then
Error_Msg_NE
("type must be declared abstract or & overriden",
E, Subp);
else
Error_Msg_NE
("non-abstract type has abstract subprogram&",
E, Subp);
end if;
end if;
-- Usually inherited primitives are not delayed but the
-- first Ada extension of a CPP_Class is an exception
-- since the address of the inherited subprogram has to
-- be inserted in the new Ada Dispatch Table and this is
-- a freezing action (usually the inherited primitive
-- address is inserted in the DT by Inherit_DT)
if Is_CPP_Class (Etype (E))
and then not Is_CPP_Class (E)
and then Present (Alias (Subp))
then
Set_Has_Delayed_Freeze (Subp);
end if;
Elmt := Next_Elmt (Elmt);
end loop;
end if;
-- For a concurrent type, freeze corresponding record type. This
-- does not correpond to any specific rule in the RM, but the
-- record type is essentially part of the concurrent type.
-- Freeze as well all local entities. This includes record types
-- created for entry parameter blocks, and whatever local entities
-- may appear in the private part.
elsif Is_Concurrent_Type (E) then
if Present (Corresponding_Record_Type (E)) then
Freeze_Aux (Corresponding_Record_Type (E));
end if;
Comp := First_Entity (E);
while Present (Comp) loop
Freeze_Aux (Etype (Comp));
Comp := Next_Entity (Comp);
end loop;
-- For enumeration type, freeze type of literal table and table
-- itself before we freeze the enumeration type if one exists.
-- Again, this does not correspond to any specific rule in the RM,
-- but the table is an essentially part of the enumeration type.
elsif Is_Enumeration_Type (E) then
if Present (Lit_Name_Table (E)) then
Freeze_Aux (Lit_Name_Table (E));
end if;
-- Private types are required to point to the same freeze node
-- as their corresponding full views. The freeze node itself
-- has to point to the partial view of the entity (because
-- from the partial view, we can retrieve the full view, but
-- not the reverse). However, in order to freeze correctly,
-- we need to freeze the full view. If we are freezing at the
-- end of a scope (or within the scope of the private type),
-- the partial and full views will have been swapped, the
-- full view appears first in the entity chain and the swapping
-- mechanism enusres that the pointers are properly set (on
-- scope exit.
-- If we encounter the full view before the private view
-- (e.g. when freezing from another scope), we freeze the
-- full view, and then set the pointers appropriately since
-- we cannot rely swapping to fix things up (subtypes in an
-- outer scope might not get swapped).
elsif Is_Incomplete_Or_Private_Type (E) then
-- Case of full view present
if Present (Full_View (E)) then
-- If full view has already been frozen, then no
-- further processing is required
if Is_Frozen (Full_View (E)) then
return Result;
-- Otherwise freeze full view and patch the pointers
else
Freeze_Aux (Full_View (E));
if Has_Delayed_Freeze (E) then
F_Node := Freeze_Node (Full_View (E));
Set_Freeze_Node (E, F_Node);
Set_Entity (F_Node, E);
end if;
return Result;
end if;
-- Case of no full view present, freeze the partial view!
else
null;
end if;
elsif Ekind (E) = E_Subprogram_Type then
Formal := First_Formal (E);
while Present (Formal) loop
Freeze_Aux (Etype (Formal));
Formal := Next_Formal (Formal);
end loop;
end if;
-- Generic types are never seen by the back-end, and are also not
-- processed by the expander (since the expander is turned off for
-- generic processing), so we never need freeze nodes for them.
if Is_Generic_Type (E) then
return Result;
end if;
end if;
-- Here is where we logically freeze the current entity. If it has a
-- freeze node, then this is the point at which the freeze node is
-- linked into the result list.
if Has_Delayed_Freeze (E) then
-- If a freeze node is already allocated, use it, otherwise allocate
-- a new one. The preallocation happens in the case of anonymous base
-- types, where we preallocate so that we can set First_Subtype_Link.
-- Note that we reset the Sloc to the current freeze location.
if Present (Freeze_Node (E)) then
F_Node := Freeze_Node (E);
Set_Sloc (F_Node, Loc);
else
F_Node := New_Node (N_Freeze_Entity, Loc);
Set_Freeze_Node (E, F_Node);
Set_TSS_Elist (F_Node, No_Elist);
Set_Actions (F_Node, No_List);
end if;
Set_Entity (F_Node, E);
Append (F_Node, Result);
end if;
-- Freeze the first subtype of a type after the type. This has to be
-- done after freezing the type, since obviously the first subtype
-- depends on its own base type.
if Is_Type (E) then
Freeze_Aux (First_Subtype (E));
-- If we just froze a tagged non-class wide record, then freeze the
-- corresponding class-wide type. This must be done after the tagged
-- type itself is frozen, because the class-wide type refers to the
-- tagged type which generates the class.
if Is_Tagged_Type (E)
and then not Is_Class_Wide_Type (E)
and then Present (Class_Wide_Type (E))
then
Freeze_Aux (Class_Wide_Type (E));
end if;
end if;
return Result;
end Freeze_Entity;
-----------------------
-- Freeze_Expression --
-----------------------
procedure Freeze_Expression (N : Node_Id) is
Typ : Entity_Id;
Nam : Entity_Id;
Desig_Typ : Entity_Id;
P : Node_Id;
Parent_P : Node_Id;
Null_Stmt : Node_Id;
In_Init : Boolean := False;
function In_Init_Proc (N : Node_Id) return Boolean;
-- Given an N_Handled_Sequence_Of_Statemens node N, determines whether
-- it is the handled statement sequence of an expander generated
-- initialization procedure, and if so returns True and also sets
-- In_Init to True. Otherwise returns False and In_Init is unchanged.
function In_Init_Proc (N : Node_Id) return Boolean is
P : Node_Id;
begin
if Nkind (N) = N_Subprogram_Body then
P := N;
else
P := Parent (N);
end if;
if Nkind (P) /= N_Subprogram_Body then
return False;
else
P := Defining_Unit_Name (Specification (P));
if Nkind (P) = N_Defining_Identifier
and then Chars (P) = Name_uInit_Proc
then
-- Make a note of it.
In_Init := True;
return True;
else
return False;
end if;
end if;
end In_Init_Proc;
-- Start of processing for Freeze_Expression
begin
-- If expression is non-static, then it does not freeze in a default
-- expression, see section "Handling of Default Expressions" in the
-- spec of package Sem for further details. Note that we have to
-- make sure that we actually have a real expression (if we have
-- a subtype indication, we can't test Is_Static_Expression!)
if In_Default_Expression
and then Nkind (N) in N_Subexpr
and then not Is_Static_Expression (N)
then
return;
end if;
-- Freeze type of expression if not frozen already
if Nkind (N) in N_Has_Etype
and then not Is_Frozen (Etype (N))
then
Typ := Etype (N);
else
Typ := Empty;
end if;
-- For entity name, freeze entity if not frozen already. A special
-- exception occurs for an identifier that did not come from source.
-- We don't let such identifiers freeze a non-internal entity, i.e.
-- an entity that did come from source, since such an identifier was
-- generated by the expander, and cannot have any semantic effect on
-- the freezing semantics. For example, this stops the parameter of
-- an initialization procedure from freezing the variable.
if Is_Entity_Name (N)
and then not Is_Frozen (Entity (N))
and then (Nkind (N) /= N_Identifier
or else Comes_From_Source (N)
or else not Comes_From_Source (Entity (N)))
then
Nam := Entity (N);
-- A special adjustment. If the expression is an identifier that
-- did not come from the source program, then don't let it
-- internal entity
-- non-internal
else
Nam := Empty;
end if;
-- For an allocator, freeze designated type if not frozen already
if Nkind (N) = N_Allocator
and then not Is_Frozen (Designated_Type (Etype (N)))
then
Desig_Typ := Designated_Type (Etype (N));
else
Desig_Typ := Empty;
end if;
-- All done if nothing needs freezing
if No (Typ)
and then No (Nam)
and then No (Desig_Typ)
then
return;
end if;
-- Loop for looking at the right place to insert the freeze nodes
-- exiting from the loop when it is appropriate to insert the freeze
-- node before the current node P.
-- Also checks some special exceptions to the freezing rules. These
-- cases result in a direct return, bypassing the freeze action.
P := N;
loop
Parent_P := Parent (P);
-- If we don't have a parent, then we are not in a well-formed
-- tree. This is an unusual case, but there are some legitimate
-- situations in which this occurs, notably when the expressions
-- in the range of a type declaration are resolved. We simply
-- ignore the freeze request in this case. Is this right ???
if No (Parent_P) then
return;
end if;
-- See if we have got to an appropriate point in the tree
case Nkind (Parent_P) is
-- A special test for the exception of (RM 13.14(8)) for the
-- case of per-object expressions (RM 3.8(18)) occurring in a
-- component definition or a discrete subtype definition. Note
-- that we test for a component declaration which includes both
-- cases we are interested in, and furthermore the tree does not
-- have explicit nodes for either of these two constructs.
when N_Component_Declaration =>
-- The case we want to test for here is an identifier that is
-- a per-object expression, this is either a discriminant that
-- appears in a context other than the component declaration
-- or it is a reference to the type of the enclosing construct.
-- For either of these cases, we skip the freezing
if not In_Default_Expression
and then Nkind (N) = N_Identifier
and then (Present (Entity (N)))
then
-- We recognize the discriminant case by just looking for
-- a reference to a discriminant. It can only be one for
-- the enclosing construct. Skip freezing in this case.
if Ekind (Entity (N)) = E_Discriminant then
return;
-- For the case of a reference to the enclosing record,
-- (or task or protected type), we look for a type that
-- matches the current scope.
elsif Entity (N) = Current_Scope then
return;
end if;
end if;
-- If we have an enumeration literal that appears as the
-- choice in the aggregate of an enumeration representation
-- clause, then freezing does not occur (RM 13.14(9)).
when N_Enumeration_Representation_Clause =>
-- The case we are looking for is an enumeration literal
if Nkind (N) = N_Identifier
and then Is_Enumeration_Type (Etype (N))
then
-- If enumeration literal appears directly as the choice,
-- do not freeze (this is the normal non-overloade case)
if Nkind (Parent (N)) = N_Component_Association
and then First (Choices (Parent (N))) = N
then
return;
-- If enumeration literal appears as the name of a
-- function which is the choice, then also do not freeze.
-- This happens in the overloaded literal case, where the
-- enumeration literal is temporarily changed to a function
-- call for overloading analysis purposes.
elsif Nkind (Parent (N)) = N_Function_Call
and then Nkind (Parent (Parent (N))) =
N_Component_Association
and then First (Choices (Parent (Parent (N)))) =
Parent (N)
then
return;
end if;
end if;
-- Normally if the parent is a handled sequence of statements,
-- or a subprogram body ???
-- then the current node must be a statement, and that is an
-- appropriate place to insert a freeze node.
when N_Subprogram_Body |
N_Handled_Sequence_Of_Statements =>
-- The exception occurs when the sequence of statements is
-- for an initialization procedure, in this case we want to
-- freeze outside this body, not inside it.
exit when not In_Init_Proc (Parent_P);
-- If parent is a body or a spec or a block, the the current
-- node is a statement or declaration and we can insert the
-- freeze node before it.
when N_Package_Specification |
N_Package_Body |
N_Task_Body |
N_Protected_Body |
N_Entry_Body |
N_Block_Statement => exit;
-- The expander is allowed to define types in any statements list,
-- so any of the following parent nodes also mark a freezing point
-- if the actual node is in a list of statements or declarations.
when N_Exception_Handler |
N_If_Statement |
N_Elsif_Part |
N_Case_Statement_Alternative |
N_Loop_Statement |
N_Selective_Accept |
N_Accept_Alternative |
N_Delay_Alternative |
N_Conditional_Entry_Call |
N_Entry_Call_Alternative |
N_Triggering_Alternative |
N_Abortable_Part =>
exit when Is_List_Member (P);
-- If the type is defined inside an expression-action and the
-- expression uses this type, freeze it at the end of the action
-- part. To simplify processing, just create a Null_Statement at
-- the end and freeze before this dummy node.
when N_Expression_Actions =>
if Present (Typ)
and then Present (Parent (Typ))
and then Parent (Parent (Typ)) = Parent_P
then
Null_Stmt :=
Make_Null_Statement (Sloc (Parent_P));
Append_To (Actions (Parent_P), Null_Stmt);
P := Null_Stmt;
exit;
end if;
-- For all other cases, keep looking at parents
when others =>
null;
end case;
-- We fall through the case if we did not yet find the proper
-- place in the free for inserting the freeze node, so climb!
P := Parent_P;
end loop;
-- If the expression appears in a record or an initialization
-- procedure, the freeze nodes are collected and attached to
-- the current scope, to be inserted an analyzed on exit from
-- the scope, to insure that generated entities appear in the
-- correct scope. If the expression is a default for a discriminant
-- specification, the scope is still void. The expression can also
-- appear in the discriminant part of a private or concurrent type.
if (Is_Type (Current_Scope)
and then (not Is_Concurrent_Type (Current_Scope)
or else not Has_Completion (Current_Scope)))
or else Ekind (Current_Scope) = E_Void
or else In_Init
then
declare
Loc : constant Source_Ptr := Sloc (Current_Scope);
Freeze_Nodes : List_Id := New_List;
begin
if Present (Desig_Typ) then
Append_List (Freeze_Entity (Desig_Typ, Loc), Freeze_Nodes);
end if;
if Present (Typ) then
Append_List (Freeze_Entity (Typ, Loc), Freeze_Nodes);
end if;
if Present (Nam) then
Append_List (Freeze_Entity (Nam, Loc), Freeze_Nodes);
end if;
if not Is_Empty_List (Freeze_Nodes) then
if No (Scope_Stack.Table
(Scope_Stack.Last).Pending_Freeze_Nodes)
then
Scope_Stack.Table (Scope_Stack.Last).Pending_Freeze_Nodes :=
Freeze_Nodes;
else
Append_List (Freeze_Nodes, Scope_Stack.Table
(Scope_Stack.Last).Pending_Freeze_Nodes);
end if;
end if;
end;
return;
end if;
-- Freeze the designated type of an allocator (RM 13.14(12))
if Present (Desig_Typ) then
Freeze_Before (P, Desig_Typ);
end if;
-- Freeze type of expression (RM 13.14(9)). Note that we took care of
-- the enumeration representation clause exception in the loop above.
if Present (Typ) then
Freeze_Before (P, Typ);
end if;
-- Freeze name if one is present (RM 13.14(10))
if Present (Nam) then
Freeze_Before (P, Nam);
end if;
end Freeze_Expression;
-----------------------------
-- Check_Compile_Time_Size --
-----------------------------
procedure Check_Compile_Time_Size (T : Entity_Id) is
function Size_Known (T : Entity_Id) return Boolean;
-- Recursive function that does all the work.
function Size_Known (T : Entity_Id) return Boolean is
Index : Entity_Id;
Comp : Entity_Id;
Low : Node_Id;
High : Node_Id;
begin
if Is_Scalar_Type (T) then
return not Is_Generic_Type (T);
elsif Esize (T) /= 0 then
return True;
elsif Is_Array_Type (T) then
if not Size_Known (Component_Type (T)) then
return False;
end if;
Index := First_Index (T);
while Present (Index) loop
if Nkind (Index) = N_Range then
Get_Index_Bounds (Index, Low, High);
else
Low := Type_Low_Bound (Etype (Index));
High := Type_High_Bound (Etype (Index));
end if;
if not Is_Static_Expression (Low)
or else not Is_Static_Expression (High)
then
return False;
end if;
Index := Next_Index (Index);
end loop;
return True;
elsif Is_Access_Type (T) then
return True;
elsif Is_Private_Type (T)
and then not Is_Generic_Type (T)
and then Present (Underlying_Type (T))
then
return Size_Known (Underlying_Type (T));
elsif Is_Record_Type (T) then
if Is_Class_Wide_Type (T) then
return False;
elsif Has_Discriminants (T)
and then Present (Parent (T))
and then Nkind (Parent (T)) = N_Full_Type_Declaration
and then Nkind (Type_Definition (Parent (T)))
= N_Record_Definition
and then not Null_Present (Type_Definition (Parent (T)))
and then Present (Variant_Part
(Component_List (Type_Definition (Parent (T)))))
then
return False;
else
Comp := First_Component (T);
while Present (Comp) loop
if not Is_Type (Comp)
and then not Size_Known (Etype (Comp))
then
return False;
end if;
Comp := Next_Component (Comp);
end loop;
return True;
end if;
else
return False;
end if;
end Size_Known;
begin
Set_Size_Known_At_Compile_Time (T, Size_Known (T));
end Check_Compile_Time_Size;
end Freeze;
