Subversion Repositories openrisc_2011-10-31

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                               F R E E Z E                                --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2009, 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- --

-- ware  Foundation;  either version 3,  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.                                     --

--                                                                          --

-- You should have received a copy of the GNU General Public License along  --

-- with this program; see file COPYING3.  If not see                        --

-- <http://www.gnu.org/licenses/>.                                          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

------------------------------------------------------------------------------

with Atree;    use Atree;

with Debug;    use Debug;

with Einfo;    use Einfo;

with Elists;   use Elists;

with Errout;   use Errout;

with Exp_Ch3;  use Exp_Ch3;

with Exp_Ch7;  use Exp_Ch7;

with Exp_Disp; use Exp_Disp;

with Exp_Pakd; use Exp_Pakd;

with Exp_Util; use Exp_Util;

with Exp_Tss;  use Exp_Tss;

with Layout;   use Layout;

with Namet;    use Namet;

with Nlists;   use Nlists;

with Nmake;    use Nmake;

with Opt;      use Opt;

with Restrict; use Restrict;

with Rident;   use Rident;

with Sem;      use Sem;

with Sem_Aux;  use Sem_Aux;

with Sem_Cat;  use Sem_Cat;

with Sem_Ch6;  use Sem_Ch6;

with Sem_Ch7;  use Sem_Ch7;

with Sem_Ch8;  use Sem_Ch8;

with Sem_Ch13; use Sem_Ch13;

with Sem_Eval; use Sem_Eval;

with Sem_Mech; use Sem_Mech;

with Sem_Prag; use Sem_Prag;

with Sem_Res;  use Sem_Res;

with Sem_Util; use Sem_Util;

with Sinfo;    use Sinfo;

with Snames;   use Snames;

with Stand;    use Stand;

with Targparm; use Targparm;

with Tbuild;   use Tbuild;

with Ttypes;   use Ttypes;

with Uintp;    use Uintp;

with Urealp;   use Urealp;

package body Freeze is

   -----------------------

   -- Local Subprograms --

   -----------------------

   procedure Adjust_Esize_For_Alignment (Typ : Entity_Id);

   --  Typ is a type that is being frozen. If no size clause is given,

   --  but a default Esize has been computed, then this default Esize is

   --  adjusted up if necessary to be consistent with a given alignment,

   --  but never to a value greater than Long_Long_Integer'Size. This

   --  is used for all discrete types and for fixed-point types.

   procedure Build_And_Analyze_Renamed_Body

     (Decl  : Node_Id;

      New_S : Entity_Id;

      After : in out Node_Id);

   --  Build body for a renaming declaration, insert in tree and analyze

   procedure Check_Address_Clause (E : Entity_Id);

   --  Apply legality checks to address clauses for object declarations,

   --  at the point the object is frozen.

   procedure Check_Strict_Alignment (E : Entity_Id);

   --  E is a base type. If E is tagged or has a component that is aliased

   --  or tagged or contains something this is aliased or tagged, set

   --  Strict_Alignment.

   procedure Check_Unsigned_Type (E : Entity_Id);

   pragma Inline (Check_Unsigned_Type);

   --  If E is a fixed-point or discrete type, then all the necessary work

   --  to freeze it is completed except for possible setting of the flag

   --  Is_Unsigned_Type, which is done by this procedure. The call has no

   --  effect if the entity E is not a discrete or fixed-point type.

   procedure Freeze_And_Append

     (Ent    : Entity_Id;

      Loc    : Source_Ptr;

      Result : in out List_Id);

   --  Freezes Ent using Freeze_Entity, and appends the resulting list of

   --  nodes to Result, modifying Result from No_List if necessary.

   procedure Freeze_Enumeration_Type (Typ : Entity_Id);

   --  Freeze enumeration type. The Esize field is set as processing

   --  proceeds (i.e. set by default when the type is declared and then

   --  adjusted by rep clauses. What this procedure does is to make sure

   --  that if a foreign convention is specified, and no specific size

   --  is given, then the size must be at least Integer'Size.

   procedure Freeze_Static_Object (E : Entity_Id);

   --  If an object is frozen which has Is_Statically_Allocated set, then

   --  all referenced types must also be marked with this flag. This routine

   --  is in charge of meeting this requirement for the object entity E.

   procedure Freeze_Subprogram (E : Entity_Id);

   --  Perform freezing actions for a subprogram (create extra formals,

   --  and set proper default mechanism values). Note that this routine

   --  is not called for internal subprograms, for which neither of these

   --  actions is needed (or desirable, we do not want for example to have

   --  these extra formals present in initialization procedures, where they

   --  would serve no purpose). In this call E is either a subprogram or

   --  a subprogram type (i.e. an access to a subprogram).

   function Is_Fully_Defined (T : Entity_Id) return Boolean;

   --  True if T is not private and has no private components, or has a full

   --  view. Used to determine whether the designated type of an access type

   --  should be frozen when the access type is frozen. This is done when an

   --  allocator is frozen, or an expression that may involve attributes of

   --  the designated type. Otherwise freezing the access type does not freeze

   --  the designated type.

   procedure Process_Default_Expressions

     (E     : Entity_Id;

      After : in out Node_Id);

   --  This procedure is called for each subprogram to complete processing

   --  of default expressions at the point where all types are known to be

   --  frozen. The expressions must be analyzed in full, to make sure that

   --  all error processing is done (they have only been pre-analyzed). If

   --  the expression is not an entity or literal, its analysis may generate

   --  code which must not be executed. In that case we build a function

   --  body to hold that code. This wrapper function serves no other purpose

   --  (it used to be called to evaluate the default, but now the default is

   --  inlined at each point of call).

   procedure Set_Component_Alignment_If_Not_Set (Typ : Entity_Id);

   --  Typ is a record or array type that is being frozen. This routine

   --  sets the default component alignment from the scope stack values

   --  if the alignment is otherwise not specified.

   procedure Check_Debug_Info_Needed (T : Entity_Id);

   --  As each entity is frozen, this routine is called to deal with the

   --  setting of Debug_Info_Needed for the entity. This flag is set if

   --  the entity comes from source, or if we are in Debug_Generated_Code

   --  mode or if the -gnatdV debug flag is set. However, it never sets

   --  the flag if Debug_Info_Off is set. This procedure also ensures that

   --  subsidiary entities have the flag set as required.

   procedure Undelay_Type (T : Entity_Id);

   --  T is a type of a component that we know to be an Itype.

   --  We don't want this to have a Freeze_Node, so ensure it doesn't.

   --  Do the same for any Full_View or Corresponding_Record_Type.

   procedure Warn_Overlay

     (Expr : Node_Id;

      Typ  : Entity_Id;

      Nam  : Node_Id);

   --  Expr is the expression for an address clause for entity Nam whose type

   --  is Typ. If Typ has a default initialization, and there is no explicit

   --  initialization in the source declaration, check whether the address

   --  clause might cause overlaying of an entity, and emit a warning on the

   --  side effect that the initialization will cause.

   -------------------------------

   -- Adjust_Esize_For_Alignment --

   -------------------------------

   procedure Adjust_Esize_For_Alignment (Typ : Entity_Id) is

      Align : Uint;

   begin

      if Known_Esize (Typ) and then Known_Alignment (Typ) then

         Align := Alignment_In_Bits (Typ);

         if Align > Esize (Typ)

           and then Align <= Standard_Long_Long_Integer_Size

         then

            Set_Esize (Typ, Align);

         end if;

      end if;

   end Adjust_Esize_For_Alignment;

   ------------------------------------

   -- Build_And_Analyze_Renamed_Body --

   ------------------------------------

   procedure Build_And_Analyze_Renamed_Body

     (Decl  : Node_Id;

      New_S : Entity_Id;

      After : in out Node_Id)

   is

      Body_Node : constant Node_Id := Build_Renamed_Body (Decl, New_S);

   begin

      Insert_After (After, Body_Node);

      Mark_Rewrite_Insertion (Body_Node);

      Analyze (Body_Node);

      After := Body_Node;

   end Build_And_Analyze_Renamed_Body;

   ------------------------

   -- Build_Renamed_Body --

   ------------------------

   function Build_Renamed_Body

     (Decl  : Node_Id;

      New_S : Entity_Id) return Node_Id

   is

      Loc : constant Source_Ptr := Sloc (New_S);

      --  We use for the source location of the renamed body, the location

      --  of the spec entity. It might seem more natural to use the location

      --  of the renaming declaration itself, but that would be wrong, since

      --  then the body we create would look as though it was created far

      --  too late, and this could cause problems with elaboration order

      --  analysis, particularly in connection with instantiations.

      N          : constant Node_Id := Unit_Declaration_Node (New_S);

      Nam        : constant Node_Id := Name (N);

      Old_S      : Entity_Id;

      Spec       : constant Node_Id := New_Copy_Tree (Specification (Decl));

      Actuals    : List_Id := No_List;

      Call_Node  : Node_Id;

      Call_Name  : Node_Id;

      Body_Node  : Node_Id;

      Formal     : Entity_Id;

      O_Formal   : Entity_Id;

      Param_Spec : Node_Id;

      Pref : Node_Id := Empty;

      --  If the renamed entity is a primitive operation given in prefix form,

      --  the prefix is the target object and it has to be added as the first

      --  actual in the generated call.

   begin

      --  Determine the entity being renamed, which is the target of the call

      --  statement. If the name is an explicit dereference, this is a renaming

      --  of a subprogram type rather than a subprogram. The name itself is

      --  fully analyzed.

      if Nkind (Nam) = N_Selected_Component then

         Old_S := Entity (Selector_Name (Nam));

      elsif Nkind (Nam) = N_Explicit_Dereference then

         Old_S := Etype (Nam);

      elsif Nkind (Nam) = N_Indexed_Component then

         if Is_Entity_Name (Prefix (Nam)) then

            Old_S := Entity (Prefix (Nam));

         else

            Old_S := Entity (Selector_Name (Prefix (Nam)));

         end if;

      elsif Nkind (Nam) = N_Character_Literal then

         Old_S := Etype (New_S);

      else

         Old_S := Entity (Nam);

      end if;

      if Is_Entity_Name (Nam) then

         --  If the renamed entity is a predefined operator, retain full name

         --  to ensure its visibility.

         if Ekind (Old_S) = E_Operator

           and then Nkind (Nam) = N_Expanded_Name

         then

            Call_Name := New_Copy (Name (N));

         else

            Call_Name := New_Reference_To (Old_S, Loc);

         end if;

      else

         if Nkind (Nam) = N_Selected_Component

           and then Present (First_Formal (Old_S))

           and then

             (Is_Controlling_Formal (First_Formal (Old_S))

                or else Is_Class_Wide_Type (Etype (First_Formal (Old_S))))

         then

            --  Retrieve the target object, to be added as a first actual

            --  in the call.

            Call_Name := New_Occurrence_Of (Old_S, Loc);

            Pref := Prefix (Nam);

         else

            Call_Name := New_Copy (Name (N));

         end if;

         --  The original name may have been overloaded, but

         --  is fully resolved now.

         Set_Is_Overloaded (Call_Name, False);

      end if;

      --  For simple renamings, subsequent calls can be expanded directly as

      --  called to the renamed entity. The body must be generated in any case

      --  for calls they may appear elsewhere.

      if (Ekind (Old_S) = E_Function

           or else Ekind (Old_S) = E_Procedure)

        and then Nkind (Decl) = N_Subprogram_Declaration

      then

         Set_Body_To_Inline (Decl, Old_S);

      end if;

      --  The body generated for this renaming is an internal artifact, and

      --  does not  constitute a freeze point for the called entity.

      Set_Must_Not_Freeze (Call_Name);

      Formal := First_Formal (Defining_Entity (Decl));

      if Present (Pref) then

         declare

            Pref_Type : constant Entity_Id := Etype (Pref);

            Form_Type : constant Entity_Id := Etype (First_Formal (Old_S));

         begin

            --  The controlling formal may be an access parameter, or the

            --  actual may be an access value, so adjust accordingly.

            if Is_Access_Type (Pref_Type)

              and then not Is_Access_Type (Form_Type)

            then

               Actuals := New_List

                 (Make_Explicit_Dereference (Loc, Relocate_Node (Pref)));

            elsif Is_Access_Type (Form_Type)

              and then not Is_Access_Type (Pref)

            then

               Actuals := New_List

                 (Make_Attribute_Reference (Loc,

                   Attribute_Name => Name_Access,

                   Prefix => Relocate_Node (Pref)));

            else

               Actuals := New_List (Pref);

            end if;

         end;

      elsif Present (Formal) then

         Actuals := New_List;

      else

         Actuals := No_List;

      end if;

      if Present (Formal) then

         while Present (Formal) loop

            Append (New_Reference_To (Formal, Loc), Actuals);

            Next_Formal (Formal);

         end loop;

      end if;

      --  If the renamed entity is an entry, inherit its profile. For other

      --  renamings as bodies, both profiles must be subtype conformant, so it

      --  is not necessary to replace the profile given in the declaration.

      --  However, default values that are aggregates are rewritten when

      --  partially analyzed, so we recover the original aggregate to insure

      --  that subsequent conformity checking works. Similarly, if the default

      --  expression was constant-folded, recover the original expression.

      Formal := First_Formal (Defining_Entity (Decl));

      if Present (Formal) then

         O_Formal := First_Formal (Old_S);

         Param_Spec := First (Parameter_Specifications (Spec));

         while Present (Formal) loop

            if Is_Entry (Old_S) then

               if Nkind (Parameter_Type (Param_Spec)) /=

                                                    N_Access_Definition

               then

                  Set_Etype (Formal, Etype (O_Formal));

                  Set_Entity (Parameter_Type (Param_Spec), Etype (O_Formal));

               end if;

            elsif Nkind (Default_Value (O_Formal)) = N_Aggregate

              or else Nkind (Original_Node (Default_Value (O_Formal))) /=

                                           Nkind (Default_Value (O_Formal))

            then

               Set_Expression (Param_Spec,

                 New_Copy_Tree (Original_Node (Default_Value (O_Formal))));

            end if;

            Next_Formal (Formal);

            Next_Formal (O_Formal);

            Next (Param_Spec);

         end loop;

      end if;

      --  If the renamed entity is a function, the generated body contains a

      --  return statement. Otherwise, build a procedure call. If the entity is

      --  an entry, subsequent analysis of the call will transform it into the

      --  proper entry or protected operation call. If the renamed entity is

      --  a character literal, return it directly.

      if Ekind (Old_S) = E_Function

        or else Ekind (Old_S) = E_Operator

        or else (Ekind (Old_S) = E_Subprogram_Type

                  and then Etype (Old_S) /= Standard_Void_Type)

      then

         Call_Node :=

           Make_Simple_Return_Statement (Loc,

              Expression =>

                Make_Function_Call (Loc,

                  Name => Call_Name,

                  Parameter_Associations => Actuals));

      elsif Ekind (Old_S) = E_Enumeration_Literal then

         Call_Node :=

           Make_Simple_Return_Statement (Loc,

              Expression => New_Occurrence_Of (Old_S, Loc));

      elsif Nkind (Nam) = N_Character_Literal then

         Call_Node :=

           Make_Simple_Return_Statement (Loc,

             Expression => Call_Name);

      else

         Call_Node :=

           Make_Procedure_Call_Statement (Loc,

             Name => Call_Name,

             Parameter_Associations => Actuals);

      end if;

      --  Create entities for subprogram body and formals

      Set_Defining_Unit_Name (Spec,

        Make_Defining_Identifier (Loc, Chars => Chars (New_S)));

      Param_Spec := First (Parameter_Specifications (Spec));

      while Present (Param_Spec) loop

         Set_Defining_Identifier (Param_Spec,

           Make_Defining_Identifier (Loc,

             Chars => Chars (Defining_Identifier (Param_Spec))));

         Next (Param_Spec);

      end loop;

      Body_Node :=

        Make_Subprogram_Body (Loc,

          Specification => Spec,

          Declarations => New_List,

          Handled_Statement_Sequence =>

            Make_Handled_Sequence_Of_Statements (Loc,

              Statements => New_List (Call_Node)));

      if Nkind (Decl) /= N_Subprogram_Declaration then

         Rewrite (N,

           Make_Subprogram_Declaration (Loc,

             Specification => Specification (N)));

      end if;

      --  Link the body to the entity whose declaration it completes. If

      --  the body is analyzed when the renamed entity is frozen, it may

      --  be necessary to restore the proper scope (see package Exp_Ch13).

      if Nkind (N) =  N_Subprogram_Renaming_Declaration

        and then Present (Corresponding_Spec (N))

      then

         Set_Corresponding_Spec (Body_Node, Corresponding_Spec (N));

      else

         Set_Corresponding_Spec (Body_Node, New_S);

      end if;

      return Body_Node;

   end Build_Renamed_Body;

   --------------------------

   -- Check_Address_Clause --

   --------------------------

   procedure Check_Address_Clause (E : Entity_Id) is

      Addr : constant Node_Id   := Address_Clause (E);

      Expr : Node_Id;

      Decl : constant Node_Id   := Declaration_Node (E);

      Typ  : constant Entity_Id := Etype (E);

   begin

      if Present (Addr) then

         Expr := Expression (Addr);

         --  If we have no initialization of any kind, then we don't need to

         --  place any restrictions on the address clause, because the object

         --  will be elaborated after the address clause is evaluated. This

         --  happens if the declaration has no initial expression, or the type

         --  has no implicit initialization, or the object is imported.

         --  The same holds for all initialized scalar types and all access

         --  types. Packed bit arrays of size up to 64 are represented using a

         --  modular type with an initialization (to zero) and can be processed

         --  like other initialized scalar types.

         --  If the type is controlled, code to attach the object to a

         --  finalization chain is generated at the point of declaration,

         --  and therefore the elaboration of the object cannot be delayed:

         --  the address expression must be a constant.

         if (No (Expression (Decl))

              and then not Needs_Finalization (Typ)

              and then

                (not Has_Non_Null_Base_Init_Proc (Typ)

                  or else Is_Imported (E)))

           or else

             (Present (Expression (Decl))

               and then Is_Scalar_Type (Typ))

           or else

             Is_Access_Type (Typ)

           or else

             (Is_Bit_Packed_Array (Typ)

               and then

                 Is_Modular_Integer_Type (Packed_Array_Type (Typ)))

         then

            null;

         --  Otherwise, we require the address clause to be constant because

         --  the call to the initialization procedure (or the attach code) has

         --  to happen at the point of the declaration.

         --  Actually the IP call has been moved to the freeze actions

         --  anyway, so maybe we can relax this restriction???

         else

            Check_Constant_Address_Clause (Expr, E);

            --  Has_Delayed_Freeze was set on E when the address clause was

            --  analyzed. Reset the flag now unless freeze actions were

            --  attached to it in the mean time.

            if No (Freeze_Node (E)) then

               Set_Has_Delayed_Freeze (E, False);

            end if;

         end if;

         if not Error_Posted (Expr)

           and then not Needs_Finalization (Typ)

         then

            Warn_Overlay (Expr, Typ, Name (Addr));

         end if;

      end if;

   end Check_Address_Clause;

   -----------------------------

   -- Check_Compile_Time_Size --

   -----------------------------

   procedure Check_Compile_Time_Size (T : Entity_Id) is

      procedure Set_Small_Size (T : Entity_Id; S : Uint);

      --  Sets the compile time known size (32 bits or less) in the Esize

      --  field, of T checking for a size clause that was given which attempts

      --  to give a smaller size, and also checking for an alignment clause.

      function Size_Known (T : Entity_Id) return Boolean;

      --  Recursive function that does all the work

      function Static_Discriminated_Components (T : Entity_Id) return Boolean;

      --  If T is a constrained subtype, its size is not known if any of its

      --  discriminant constraints is not static and it is not a null record.

      --  The test is conservative and doesn't check that the components are

      --  in fact constrained by non-static discriminant values. Could be made

      --  more precise ???

      --------------------

      -- Set_Small_Size --

      --------------------

      procedure Set_Small_Size (T : Entity_Id; S : Uint) is

      begin

         if S > 32 then

            return;

         --  Don't bother if alignment clause with a value other than 1 is

         --  present, because size may be padded up to meet back end alignment

         --  requirements, and only the back end knows the rules!

         elsif Known_Alignment (T) and then Alignment (T) /= 1 then

            return;

         --  Check for bad size clause given

         elsif Has_Size_Clause (T) then

            if RM_Size (T) < S then

               Error_Msg_Uint_1 := S;

               Error_Msg_NE

                 ("size for& too small, minimum allowed is ^",

                  Size_Clause (T), T);

            elsif Unknown_Esize (T) then

               Set_Esize (T, S);

            end if;

         --  Set sizes if not set already

         else

            if Unknown_Esize (T) then

               Set_Esize (T, S);

            end if;

            if Unknown_RM_Size (T) then

               Set_RM_Size (T, S);

            end if;

         end if;

      end Set_Small_Size;

      ----------------

      -- Size_Known --

      ----------------

      function Size_Known (T : Entity_Id) return Boolean is

         Index : Entity_Id;

         Comp  : Entity_Id;

         Ctyp  : Entity_Id;

         Low   : Node_Id;

         High  : Node_Id;

      begin

         if Size_Known_At_Compile_Time (T) then

            return True;

         --  Always True for scalar types. This is true even for generic formal

         --  scalar types. We used to return False in the latter case, but the

         --  size is known at compile time, even in the template, we just do

         --  not know the exact size but that's not the point of this routine.

         elsif Is_Scalar_Type (T)

           or else Is_Task_Type (T)

         then

            return True;

         --  Array types

         elsif Is_Array_Type (T) then

            --  String literals always have known size, and we can set it

            if Ekind (T) = E_String_Literal_Subtype then

               Set_Small_Size (T, Component_Size (T)

                               * String_Literal_Length (T));

               return True;

            --  Unconstrained types never have known at compile time size

            elsif not Is_Constrained (T) then

               return False;

            --  Don't do any recursion on type with error posted, since we may

            --  have a malformed type that leads us into a loop.

            elsif Error_Posted (T) then

               return False;

            --  Otherwise if component size unknown, then array size unknown

            elsif not Size_Known (Component_Type (T)) then

               return False;

            end if;

            --  Check for all indexes static, and also compute possible size

            --  (in case it is less than 32 and may be packable).

            declare

               Esiz : Uint := Component_Size (T);

               Dim  : Uint;

            begin

               Index := First_Index (T);

               while Present (Index) loop

                  if Nkind (Index) = N_Range then

                     Get_Index_Bounds (Index, Low, High);

                  elsif Error_Posted (Scalar_Range (Etype (Index))) then

                     return False;

                  else

                     Low  := Type_Low_Bound (Etype (Index));

                     High := Type_High_Bound (Etype (Index));

                  end if;

                  if not Compile_Time_Known_Value (Low)

                    or else not Compile_Time_Known_Value (High)

                    or else Etype (Index) = Any_Type

                  then

                     return False;

                  else

                     Dim := Expr_Value (High) - Expr_Value (Low) + 1;

                     if Dim >= 0 then

                        Esiz := Esiz * Dim;

                     else

                        Esiz := Uint_0;

                     end if;

                  end if;

                  Next_Index (Index);

               end loop;

               Set_Small_Size (T, Esiz);

               return True;

            end;

         --  Access types always have known at compile time sizes

         elsif Is_Access_Type (T) then

            return True;

         --  For non-generic private types, go to underlying type if present

         elsif Is_Private_Type (T)

           and then not Is_Generic_Type (T)

           and then Present (Underlying_Type (T))

         then

            --  Don't do any recursion on type with error posted, since we may

            --  have a malformed type that leads us into a loop.

            if Error_Posted (T) then

               return False;

            else

               return Size_Known (Underlying_Type (T));

            end if;

         --  Record types

         elsif Is_Record_Type (T) then

            --  A class-wide type is never considered to have a known size

            if Is_Class_Wide_Type (T) then

               return False;

            --  A subtype of a variant record must not have non-static

            --  discriminanted components.

            elsif T /= Base_Type (T)

              and then not Static_Discriminated_Components (T)

            then

               return False;

            --  Don't do any recursion on type with error posted, since we may

            --  have a malformed type that leads us into a loop.

            elsif Error_Posted (T) then

               return False;

            end if;

            --  Now look at the components of the record

            declare

               --  The following two variables are used to keep track of the

               --  size of packed records if we can tell the size of the packed