gcc/ada/exp_ch13.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             E X P _ C H 1 3                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Atree;    use Atree;
  27 with Checks;   use Checks;
  28 with Einfo;    use Einfo;
  29 with Elists;   use Elists;
  30 with Errout;   use Errout;
  31 with Exp_Ch3;  use Exp_Ch3;
  32 with Exp_Ch6;  use Exp_Ch6;
  33 with Exp_Imgv; use Exp_Imgv;
  34 with Exp_Tss;  use Exp_Tss;
  35 with Exp_Util; use Exp_Util;
  36 with Namet;    use Namet;
  37 with Nlists;   use Nlists;
  38 with Nmake;    use Nmake;
  39 with Opt;      use Opt;
  40 with Rtsfind;  use Rtsfind;
  41 with Sem;      use Sem;
  42 with Sem_Aux;  use Sem_Aux;
  43 with Sem_Ch3;  use Sem_Ch3;
  44 with Sem_Ch7;  use Sem_Ch7;
  45 with Sem_Ch8;  use Sem_Ch8;
  46 with Sem_Eval; use Sem_Eval;
  47 with Sem_Util; use Sem_Util;
  48 with Sinfo;    use Sinfo;
  49 with Snames;   use Snames;
  50 with Stand;    use Stand;
  51 with Tbuild;   use Tbuild;
  52 with Uintp;    use Uintp;
  53 with Validsw;  use Validsw;
  54
  55 package body Exp_Ch13 is
  56
  57    -----------------------
  58    -- Local Subprograms --
  59    -----------------------
  60
  61    procedure Build_Predicate_Function
  62      (Typ   : Entity_Id;
  63       FDecl : out Node_Id;
  64       FBody : out Node_Id);
  65    --  If Typ has predicates (indicated by Has_Predicates being set for Typ,
  66    --  then either there are pragma Invariant entries on the rep chain for the
  67    --  type (note that Predicate aspects are converted to pragam Predicate), or
  68    --  there are inherited aspects from a parent type, or ancestor subtypes,
  69    --  or interfaces. This procedure builds the spec and body for the Predicate
  70    --  function that tests these predicates, returning them in PDecl and Pbody
  71    --  and setting Predicate_Procedure for Typ. In some error situations no
  72    --  procedure is built, in which case PDecl/PBody are empty on return.
  73
  74    ------------------------------
  75    -- Build_Predicate_Function --
  76    ------------------------------
  77
  78    --  The procedure that is constructed here has the form
  79
  80    --  function typPredicate (Ixxx : typ) return Boolean is
  81    --  begin
  82    --     return
  83    --        exp1 and then exp2 and then ...
  84    --        and then typ1Predicate (typ1 (Ixxx))
  85    --        and then typ2Predicate (typ2 (Ixxx))
  86    --        and then ...;
  87    --  end typPredicate;
  88
  89    --  Here exp1, and exp2 are expressions from Predicate pragmas. Note that
  90    --  this is the point at which these expressions get analyzed, providing the
  91    --  required delay, and typ1, typ2, are entities from which predicates are
  92    --  inherited. Note that we do NOT generate Check pragmas, that's because we
  93    --  use this function even if checks are off, e.g. for membership tests.
  94
  95    procedure Build_Predicate_Function
  96      (Typ   : Entity_Id;
  97       FDecl : out Node_Id;
  98       FBody : out Node_Id)
  99    is
 100       Loc  : constant Source_Ptr := Sloc (Typ);
 101       Spec : Node_Id;
 102       SId  : Entity_Id;
 103
 104       Expr : Node_Id;
 105       --  This is the expression for the return statement in the function. It
 106       --  is build by connecting the component predicates with AND THEN.
 107
 108       procedure Add_Call (T : Entity_Id);
 109       --  Includes a call to the predicate function for type T in Expr if T
 110       --  has predicates and Predicate_Function (T) is non-empty.
 111
 112       procedure Add_Predicates;
 113       --  Appends expressions for any Predicate pragmas in the rep item chain
 114       --  Typ to Expr. Note that we look only at items for this exact entity.
 115       --  Inheritance of predicates for the parent type is done by calling the
 116       --  Predicate_Function of the parent type, using Add_Call above.
 117
 118       Object_Name : constant Name_Id := New_Internal_Name ('I');
 119       --  Name for argument of Predicate procedure
 120
 121       --------------
 122       -- Add_Call --
 123       --------------
 124
 125       procedure Add_Call (T : Entity_Id) is
 126          Exp : Node_Id;
 127
 128       begin
 129          if Present (T) and then Present (Predicate_Function (T)) then
 130             Set_Has_Predicates (Typ);
 131
 132             --  Build the call to the predicate function of T
 133
 134             Exp :=
 135               Make_Predicate_Call
 136                 (T,
 137                  Convert_To (T,
 138                    Make_Identifier (Loc, Chars => Object_Name)));
 139
 140             --  Add call to evolving expression, using AND THEN if needed
 141
 142             if No (Expr) then
 143                Expr := Exp;
 144             else
 145                Expr :=
 146                  Make_And_Then (Loc,
 147                    Left_Opnd  => Relocate_Node (Expr),
 148                    Right_Opnd => Exp);
 149             end if;
 150
 151             --  Output info message on inheritance if required
 152
 153             if Opt.List_Inherited_Aspects then
 154                Error_Msg_Sloc := Sloc (Predicate_Function (T));
 155                Error_Msg_Node_2 := T;
 156                Error_Msg_N ("?info: & inherits predicate from & #", Typ);
 157             end if;
 158          end if;
 159       end Add_Call;
 160
 161       --------------------
 162       -- Add_Predicates --
 163       --------------------
 164
 165       procedure Add_Predicates is
 166          Ritem : Node_Id;
 167          Arg1  : Node_Id;
 168          Arg2  : Node_Id;
 169
 170          function Replace_Node (N : Node_Id) return Traverse_Result;
 171          --  Process single node for traversal to replace type references
 172
 173          procedure Replace_Type is new Traverse_Proc (Replace_Node);
 174          --  Traverse an expression changing every occurrence of an entity
 175          --  reference to type T with a reference to the object argument.
 176
 177          ------------------
 178          -- Replace_Node --
 179          ------------------
 180
 181          function Replace_Node (N : Node_Id) return Traverse_Result is
 182          begin
 183             --  Case of entity name referencing the type
 184
 185             if Is_Entity_Name (N) and then Entity (N) = Typ then
 186
 187                --  Replace with object
 188
 189                Rewrite (N,
 190                  Make_Identifier (Loc,
 191                    Chars => Object_Name));
 192
 193                --  All done with this node
 194
 195                return Skip;
 196
 197             --  Not an occurrence of the type entity, keep going
 198
 199             else
 200                return OK;
 201             end if;
 202          end Replace_Node;
 203
 204       --  Start of processing for Add_Predicates
 205
 206       begin
 207          Ritem := First_Rep_Item (Typ);
 208          while Present (Ritem) loop
 209             if Nkind (Ritem) = N_Pragma
 210               and then Pragma_Name (Ritem) = Name_Predicate
 211             then
 212                Arg1 := First (Pragma_Argument_Associations (Ritem));
 213                Arg2 := Next (Arg1);
 214
 215                Arg1 := Get_Pragma_Arg (Arg1);
 216                Arg2 := Get_Pragma_Arg (Arg2);
 217
 218                --  See if this predicate pragma is for the current type
 219
 220                if Entity (Arg1) = Typ then
 221
 222                   --  We have a match, this entry is for our subtype
 223
 224                   --  First We need to replace any occurrences of the name of
 225                   --  the type with references to the object. We do this by
 226                   --  first doing a preanalysis, to identify all the entities,
 227                   --  then we traverse looking for the type entity, doing the
 228                   --  needed substitution. The preanalysis is done with the
 229                   --  special OK_To_Reference flag set on the type, so that if
 230                   --  we get an occurrence of this type, it will be recognized
 231                   --  as legitimate.
 232
 233                   Set_OK_To_Reference (Typ, True);
 234                   Preanalyze_Spec_Expression (Arg2, Standard_Boolean);
 235                   Set_OK_To_Reference (Typ, False);
 236                   Replace_Type (Arg2);
 237
 238                   --  OK, replacement complete, now we can add the expression
 239
 240                   if No (Expr) then
 241                      Expr := Relocate_Node (Arg2);
 242                   else
 243                      Expr :=
 244                        Make_And_Then (Loc,
 245                          Left_Opnd  => Relocate_Node (Expr),
 246                          Right_Opnd => Relocate_Node (Arg2));
 247                   end if;
 248                end if;
 249             end if;
 250
 251             Next_Rep_Item (Ritem);
 252          end loop;
 253       end Add_Predicates;
 254
 255    --  Start of processing for Build_Predicate_Function
 256
 257    begin
 258       --  Initialize for construction of statement list
 259
 260       Expr  := Empty;
 261       FDecl := Empty;
 262       FBody := Empty;
 263
 264       --  Return if already built or if type does not have predicates
 265
 266       if not Has_Predicates (Typ)
 267         or else Present (Predicate_Function (Typ))
 268       then
 269          return;
 270       end if;
 271
 272       --  Add Predicates for the current type
 273
 274       Add_Predicates;
 275
 276       --  Add predicates for ancestor if present
 277
 278       declare
 279          Atyp : constant Entity_Id := Nearest_Ancestor (Typ);
 280       begin
 281          if Present (Atyp) then
 282             Add_Call (Atyp);
 283          end if;
 284       end;
 285
 286       --  Add predicates of any interfaces of a tagged type
 287
 288       if Is_Tagged_Type (Typ) then
 289          declare
 290             Iface_List : Elist_Id;
 291             Elmt       : Elmt_Id;
 292
 293          begin
 294             Collect_Interfaces (Typ, Iface_List);
 295
 296             if Present (Iface_List) then
 297                loop
 298                   Elmt := First_Elmt (Iface_List);
 299                   exit when No (Elmt);
 300
 301                   Add_Call (Node (Elmt));
 302                   Remove_Elmt (Iface_List, Elmt);
 303                end loop;
 304             end if;
 305          end;
 306       end if;
 307
 308       if Present (Expr) then
 309
 310          --  Build function declaration
 311
 312          pragma Assert (Has_Predicates (Typ));
 313          SId :=
 314            Make_Defining_Identifier (Loc,
 315              Chars => New_External_Name (Chars (Typ), "Predicate"));
 316          Set_Has_Predicates (SId);
 317          Set_Predicate_Function (Typ, SId);
 318
 319          Spec :=
 320            Make_Function_Specification (Loc,
 321              Defining_Unit_Name       => SId,
 322              Parameter_Specifications => New_List (
 323                Make_Parameter_Specification (Loc,
 324                  Defining_Identifier =>
 325                    Make_Defining_Identifier (Loc, Chars => Object_Name),
 326                  Parameter_Type      => New_Occurrence_Of (Typ, Loc))),
 327              Result_Definition        =>
 328                New_Occurrence_Of (Standard_Boolean, Loc));
 329
 330          FDecl :=
 331            Make_Subprogram_Declaration (Loc,
 332              Specification => Spec);
 333
 334          --  Build function body
 335
 336          SId :=
 337            Make_Defining_Identifier (Loc,
 338              Chars => New_External_Name (Chars (Typ), "Predicate"));
 339
 340          Spec :=
 341            Make_Function_Specification (Loc,
 342              Defining_Unit_Name       => SId,
 343              Parameter_Specifications => New_List (
 344                Make_Parameter_Specification (Loc,
 345                  Defining_Identifier =>
 346                    Make_Defining_Identifier (Loc, Chars => Object_Name),
 347                  Parameter_Type =>
 348                    New_Occurrence_Of (Typ, Loc))),
 349              Result_Definition        =>
 350                New_Occurrence_Of (Standard_Boolean, Loc));
 351
 352          FBody :=
 353            Make_Subprogram_Body (Loc,
 354              Specification              => Spec,
 355              Declarations               => Empty_List,
 356              Handled_Statement_Sequence =>
 357                Make_Handled_Sequence_Of_Statements (Loc,
 358                  Statements => New_List (
 359                    Make_Simple_Return_Statement (Loc,
 360                      Expression => Expr))));
 361       end if;
 362    end Build_Predicate_Function;
 363
 364    ------------------------------------------
 365    -- Expand_N_Attribute_Definition_Clause --
 366    ------------------------------------------
 367
 368    --  Expansion action depends on attribute involved
 369
 370    procedure Expand_N_Attribute_Definition_Clause (N : Node_Id) is
 371       Loc : constant Source_Ptr := Sloc (N);
 372       Exp : constant Node_Id    := Expression (N);
 373       Ent : Entity_Id;
 374       V   : Node_Id;
 375
 376    begin
 377       Ent := Entity (Name (N));
 378
 379       if Is_Type (Ent) then
 380          Ent := Underlying_Type (Ent);
 381       end if;
 382
 383       case Get_Attribute_Id (Chars (N)) is
 384
 385          -------------
 386          -- Address --
 387          -------------
 388
 389          when Attribute_Address =>
 390
 391             --  If there is an initialization which did not come from the
 392             --  source program, then it is an artifact of our expansion, and we
 393             --  suppress it. The case we are most concerned about here is the
 394             --  initialization of a packed array to all false, which seems
 395             --  inappropriate for variable to which an address clause is
 396             --  applied. The expression may itself have been rewritten if the
 397             --  type is packed array, so we need to examine whether the
 398             --  original node is in the source. An exception though is the case
 399             --  of an access variable which is default initialized to null, and
 400             --  such initialization is retained.
 401
 402             --  Furthermore, if the initialization is the equivalent aggregate
 403             --  of the type initialization procedure, it replaces an implicit
 404             --  call to the init proc, and must be respected. Note that for
 405             --  packed types we do not build equivalent aggregates.
 406
 407             --  Also, if Init_Or_Norm_Scalars applies, then we need to retain
 408             --  any default initialization for objects of scalar types and
 409             --  types with scalar components. Normally a composite type will
 410             --  have an init_proc in the presence of Init_Or_Norm_Scalars,
 411             --  so when that flag is set we have just have to do a test for
 412             --  scalar and string types (the predefined string types such as
 413             --  String and Wide_String don't have an init_proc).
 414
 415             declare
 416                Decl : constant Node_Id := Declaration_Node (Ent);
 417                Typ  : constant Entity_Id := Etype (Ent);
 418
 419             begin
 420                if Nkind (Decl) = N_Object_Declaration
 421                   and then Present (Expression (Decl))
 422                   and then Nkind (Expression (Decl)) /= N_Null
 423                   and then
 424                    not Comes_From_Source (Original_Node (Expression (Decl)))
 425                then
 426                   if Present (Base_Init_Proc (Typ))
 427                     and then
 428                       Present (Static_Initialization (Base_Init_Proc (Typ)))
 429                   then
 430                      null;
 431
 432                   elsif Init_Or_Norm_Scalars
 433                     and then
 434                       (Is_Scalar_Type (Typ) or else Is_String_Type (Typ))
 435                   then
 436                      null;
 437
 438                   else
 439                      Set_Expression (Decl, Empty);
 440                   end if;
 441
 442                --  An object declaration to which an address clause applies
 443                --  has a delayed freeze, but the address expression itself
 444                --  must be elaborated at the point it appears. If the object
 445                --  is controlled, additional checks apply elsewhere.
 446
 447                elsif Nkind (Decl) = N_Object_Declaration
 448                  and then not Needs_Constant_Address (Decl, Typ)
 449                then
 450                   Remove_Side_Effects (Exp);
 451                end if;
 452             end;
 453
 454          ---------------
 455          -- Alignment --
 456          ---------------
 457
 458          when Attribute_Alignment =>
 459
 460             --  As required by Gigi, we guarantee that the operand is an
 461             --  integer literal (this simplifies things in Gigi).
 462
 463             if Nkind (Exp) /= N_Integer_Literal then
 464                Rewrite
 465                  (Exp, Make_Integer_Literal (Loc, Expr_Value (Exp)));
 466             end if;
 467
 468          ------------------
 469          -- Storage_Size --
 470          ------------------
 471
 472          when Attribute_Storage_Size =>
 473
 474             --  If the type is a task type, then assign the value of the
 475             --  storage size to the Size variable associated with the task.
 476             --    task_typeZ := expression
 477
 478             if Ekind (Ent) = E_Task_Type then
 479                Insert_Action (N,
 480                  Make_Assignment_Statement (Loc,
 481                    Name => New_Reference_To (Storage_Size_Variable (Ent), Loc),
 482                    Expression =>
 483                      Convert_To (RTE (RE_Size_Type), Expression (N))));
 484
 485             --  For Storage_Size for an access type, create a variable to hold
 486             --  the value of the specified size with name typeV and expand an
 487             --  assignment statement to initialize this value.
 488
 489             elsif Is_Access_Type (Ent) then
 490
 491                --  We don't need the variable for a storage size of zero
 492
 493                if not No_Pool_Assigned (Ent) then
 494                   V :=
 495                     Make_Defining_Identifier (Loc,
 496                       Chars => New_External_Name (Chars (Ent), 'V'));
 497
 498                   --  Insert the declaration of the object
 499
 500                   Insert_Action (N,
 501                     Make_Object_Declaration (Loc,
 502                       Defining_Identifier => V,
 503                       Object_Definition  =>
 504                         New_Reference_To (RTE (RE_Storage_Offset), Loc),
 505                       Expression =>
 506                         Convert_To (RTE (RE_Storage_Offset), Expression (N))));
 507
 508                   Set_Storage_Size_Variable (Ent, Entity_Id (V));
 509                end if;
 510             end if;
 511
 512          --  Other attributes require no expansion
 513
 514          when others =>
 515             null;
 516
 517       end case;
 518    end Expand_N_Attribute_Definition_Clause;
 519
 520    ----------------------------
 521    -- Expand_N_Freeze_Entity --
 522    ----------------------------
 523
 524    procedure Expand_N_Freeze_Entity (N : Node_Id) is
 525       E              : constant Entity_Id := Entity (N);
 526       E_Scope        : Entity_Id;
 527       S              : Entity_Id;
 528       In_Other_Scope : Boolean;
 529       In_Outer_Scope : Boolean;
 530       Decl           : Node_Id;
 531       Delete         : Boolean := False;
 532
 533    begin
 534       --  If there are delayed aspect specifications, we insert them just
 535       --  before the freeze node. They are already analyzed so we don't need
 536       --  to reanalyze them (they were analyzed before the type was frozen),
 537       --  but we want them in the tree for the back end, and so that the
 538       --  listing from sprint is clearer on where these occur logically.
 539
 540       if Has_Delayed_Aspects (E) then
 541          declare
 542             Aitem : Node_Id;
 543             Ritem : Node_Id;
 544
 545          begin
 546             Ritem := First_Rep_Item (E);
 547             while Present (Ritem) loop
 548                if Nkind (Ritem) = N_Aspect_Specification then
 549                   Aitem := Aspect_Rep_Item (Ritem);
 550                   pragma Assert (Is_Delayed_Aspect (Aitem));
 551                   Insert_Before (N, Aitem);
 552                end if;
 553
 554                Next_Rep_Item (Ritem);
 555             end loop;
 556          end;
 557       end if;
 558
 559       --  Processing for objects with address clauses
 560
 561       if Is_Object (E) and then Present (Address_Clause (E)) then
 562          Apply_Address_Clause_Check (E, N);
 563          return;
 564
 565       --  Only other items requiring any front end action are types and
 566       --  subprograms.
 567
 568       elsif not Is_Type (E) and then not Is_Subprogram (E) then
 569          return;
 570       end if;
 571
 572       --  Here E is a type or a subprogram
 573
 574       E_Scope := Scope (E);
 575
 576       --  This is an error protection against previous errors
 577
 578       if No (E_Scope) then
 579          return;
 580       end if;
 581
 582       --  Remember that we are processing a freezing entity and its freezing
 583       --  nodes. This flag (non-zero = set) is used to avoid the need of
 584       --  climbing through the tree while processing the freezing actions (ie.
 585       --  to avoid generating spurious warnings or to avoid killing constant
 586       --  indications while processing the code associated with freezing
 587       --  actions). We use a counter to deal with nesting.
 588
 589       Inside_Freezing_Actions := Inside_Freezing_Actions + 1;
 590
 591       --  If we are freezing entities defined in protected types, they belong
 592       --  in the enclosing scope, given that the original type has been
 593       --  expanded away. The same is true for entities in task types, in
 594       --  particular the parameter records of entries (Entities in bodies are
 595       --  all frozen within the body). If we are in the task body, this is a
 596       --  proper scope. If we are within a subprogram body, the proper scope
 597       --  is the corresponding spec. This may happen for itypes generated in
 598       --  the bodies of protected operations.
 599
 600       if Ekind (E_Scope) = E_Protected_Type
 601         or else (Ekind (E_Scope) = E_Task_Type
 602                    and then not Has_Completion (E_Scope))
 603       then
 604          E_Scope := Scope (E_Scope);
 605
 606       elsif Ekind (E_Scope) = E_Subprogram_Body then
 607          E_Scope := Corresponding_Spec (Unit_Declaration_Node (E_Scope));
 608       end if;
 609
 610       S := Current_Scope;
 611       while S /= Standard_Standard and then S /= E_Scope loop
 612          S := Scope (S);
 613       end loop;
 614
 615       In_Other_Scope := not (S = E_Scope);
 616       In_Outer_Scope := (not In_Other_Scope) and then (S /= Current_Scope);
 617
 618       --  If the entity being frozen is defined in a scope that is not
 619       --  currently on the scope stack, we must establish the proper
 620       --  visibility before freezing the entity and related subprograms.
 621
 622       if In_Other_Scope then
 623          Push_Scope (E_Scope);
 624          Install_Visible_Declarations (E_Scope);
 625
 626          if Is_Package_Or_Generic_Package (E_Scope) or else
 627             Is_Protected_Type (E_Scope)             or else
 628             Is_Task_Type (E_Scope)
 629          then
 630             Install_Private_Declarations (E_Scope);
 631          end if;
 632
 633       --  If the entity is in an outer scope, then that scope needs to
 634       --  temporarily become the current scope so that operations created
 635       --  during type freezing will be declared in the right scope and
 636       --  can properly override any corresponding inherited operations.
 637
 638       elsif In_Outer_Scope then
 639          Push_Scope (E_Scope);
 640       end if;
 641
 642       --  If type, freeze the type
 643
 644       if Is_Type (E) then
 645          Delete := Freeze_Type (N);
 646
 647          --  And for enumeration type, build the enumeration tables
 648
 649          if Is_Enumeration_Type (E) then
 650             Build_Enumeration_Image_Tables (E, N);
 651          end if;
 652
 653       --  If subprogram, freeze the subprogram
 654
 655       elsif Is_Subprogram (E) then
 656          Freeze_Subprogram (N);
 657
 658          --  Ada 2005 (AI-251): Remove the freezing node associated with the
 659          --  entities internally used by the frontend to register primitives
 660          --  covering abstract interfaces. The call to Freeze_Subprogram has
 661          --  already expanded the code that fills the corresponding entry in
 662          --  its secondary dispatch table and therefore the code generator
 663          --  has nothing else to do with this freezing node.
 664
 665          Delete := Present (Interface_Alias (E));
 666       end if;
 667
 668       --  Analyze actions generated by freezing. The init_proc contains source
 669       --  expressions that may raise Constraint_Error, and the assignment
 670       --  procedure for complex types needs checks on individual component
 671       --  assignments, but all other freezing actions should be compiled with
 672       --  all checks off.
 673
 674       if Present (Actions (N)) then
 675          Decl := First (Actions (N));
 676          while Present (Decl) loop
 677             if Nkind (Decl) = N_Subprogram_Body
 678               and then (Is_Init_Proc (Defining_Entity (Decl))
 679                           or else
 680                             Chars (Defining_Entity (Decl)) = Name_uAssign)
 681             then
 682                Analyze (Decl);
 683
 684             --  A subprogram body created for a renaming_as_body completes
 685             --  a previous declaration, which may be in a different scope.
 686             --  Establish the proper scope before analysis.
 687
 688             elsif Nkind (Decl) = N_Subprogram_Body
 689               and then Present (Corresponding_Spec (Decl))
 690               and then Scope (Corresponding_Spec (Decl)) /= Current_Scope
 691             then
 692                Push_Scope (Scope (Corresponding_Spec (Decl)));
 693                Analyze (Decl, Suppress => All_Checks);
 694                Pop_Scope;
 695
 696             --  We treat generated equality specially, if validity checks are
 697             --  enabled, in order to detect components default-initialized
 698             --  with invalid values.
 699
 700             elsif Nkind (Decl) = N_Subprogram_Body
 701               and then Chars (Defining_Entity (Decl)) = Name_Op_Eq
 702               and then Validity_Checks_On
 703               and then Initialize_Scalars
 704             then
 705                declare
 706                   Save_Force : constant Boolean := Force_Validity_Checks;
 707                begin
 708                   Force_Validity_Checks := True;
 709                   Analyze (Decl);
 710                   Force_Validity_Checks := Save_Force;
 711                end;
 712
 713             else
 714                Analyze (Decl, Suppress => All_Checks);
 715             end if;
 716
 717             Next (Decl);
 718          end loop;
 719       end if;
 720
 721       --  If we are to delete this N_Freeze_Entity, do so by rewriting so that
 722       --  a loop on all nodes being inserted will work propertly.
 723
 724       if Delete then
 725          Rewrite (N, Make_Null_Statement (Sloc (N)));
 726       end if;
 727
 728       --  If freezing a type entity which has predicates, this is where we
 729       --  build and insert the predicate function for the type.
 730
 731       if Is_Type (E) and then Has_Predicates (E) then
 732          declare
 733             FDecl : Node_Id;
 734             FBody : Node_Id;
 735
 736          begin
 737             Build_Predicate_Function (E, FDecl, FBody);
 738
 739             if Present (FDecl) then
 740                Insert_After (N, FBody);
 741                Insert_After (N, FDecl);
 742             end if;
 743          end;
 744       end if;
 745
 746       --  Pop scope if we installed one for the analysis
 747
 748       if In_Other_Scope then
 749          if Ekind (Current_Scope) = E_Package then
 750             End_Package_Scope (E_Scope);
 751          else
 752             End_Scope;
 753          end if;
 754
 755       elsif In_Outer_Scope then
 756          Pop_Scope;
 757       end if;
 758
 759       --  Restore previous value of the nesting-level counter that records
 760       --  whether we are inside a (possibly nested) call to this procedure.
 761
 762       Inside_Freezing_Actions := Inside_Freezing_Actions - 1;
 763    end Expand_N_Freeze_Entity;
 764
 765    -------------------------------------------
 766    -- Expand_N_Record_Representation_Clause --
 767    -------------------------------------------
 768
 769    --  The only expansion required is for the case of a mod clause present,
 770    --  which is removed, and translated into an alignment representation
 771    --  clause inserted immediately after the record rep clause with any
 772    --  initial pragmas inserted at the start of the component clause list.
 773
 774    procedure Expand_N_Record_Representation_Clause (N : Node_Id) is
 775       Loc     : constant Source_Ptr := Sloc (N);
 776       Rectype : constant Entity_Id  := Entity (Identifier (N));
 777       Mod_Val : Uint;
 778       Citems  : List_Id;
 779       Repitem : Node_Id;
 780       AtM_Nod : Node_Id;
 781
 782    begin
 783       if Present (Mod_Clause (N)) and then not Ignore_Rep_Clauses then
 784          Mod_Val := Expr_Value (Expression (Mod_Clause (N)));
 785          Citems  := Pragmas_Before (Mod_Clause (N));
 786
 787          if Present (Citems) then
 788             Append_List_To (Citems, Component_Clauses (N));
 789             Set_Component_Clauses (N, Citems);
 790          end if;
 791
 792          AtM_Nod :=
 793            Make_Attribute_Definition_Clause (Loc,
 794              Name       => New_Reference_To (Base_Type (Rectype), Loc),
 795              Chars      => Name_Alignment,
 796              Expression => Make_Integer_Literal (Loc, Mod_Val));
 797
 798          Set_From_At_Mod (AtM_Nod);
 799          Insert_After (N, AtM_Nod);
 800          Set_Mod_Clause (N, Empty);
 801       end if;
 802
 803       --  If the record representation clause has no components, then
 804       --  completely remove it.  Note that we also have to remove
 805       --  ourself from the Rep Item list.
 806
 807       if Is_Empty_List (Component_Clauses (N)) then
 808          if First_Rep_Item (Rectype) = N then
 809             Set_First_Rep_Item (Rectype, Next_Rep_Item (N));
 810          else
 811             Repitem := First_Rep_Item (Rectype);
 812             while Present (Next_Rep_Item (Repitem)) loop
 813                if Next_Rep_Item (Repitem) = N then
 814                   Set_Next_Rep_Item (Repitem, Next_Rep_Item (N));
 815                   exit;
 816                end if;
 817
 818                Next_Rep_Item (Repitem);
 819             end loop;
 820          end if;
 821
 822          Rewrite (N,
 823            Make_Null_Statement (Loc));
 824       end if;
 825    end Expand_N_Record_Representation_Clause;
 826
 827 end Exp_Ch13;