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-2016, 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 Exp_Ch3;  use Exp_Ch3;
  30 with Exp_Ch6;  use Exp_Ch6;
  31 with Exp_Imgv; use Exp_Imgv;
  32 with Exp_Tss;  use Exp_Tss;
  33 with Exp_Util; use Exp_Util;
  34 with Freeze;   use Freeze;
  35 with Ghost;    use Ghost;
  36 with Namet;    use Namet;
  37 with Nlists;   use Nlists;
  38 with Nmake;    use Nmake;
  39 with Opt;      use Opt;
  40 with Restrict; use Restrict;
  41 with Rident;   use Rident;
  42 with Rtsfind;  use Rtsfind;
  43 with Sem;      use Sem;
  44 with Sem_Aux;  use Sem_Aux;
  45 with Sem_Ch7;  use Sem_Ch7;
  46 with Sem_Ch8;  use Sem_Ch8;
  47 with Sem_Eval; use Sem_Eval;
  48 with Sem_Util; use Sem_Util;
  49 with Sinfo;    use Sinfo;
  50 with Snames;   use Snames;
  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    -- Expand_N_Attribute_Definition_Clause --
  59    ------------------------------------------
  60
  61    --  Expansion action depends on attribute involved
  62
  63    procedure Expand_N_Attribute_Definition_Clause (N : Node_Id) is
  64       Loc : constant Source_Ptr := Sloc (N);
  65       Exp : constant Node_Id    := Expression (N);
  66       Ent : Entity_Id;
  67       V   : Node_Id;
  68
  69    begin
  70       Ent := Entity (Name (N));
  71
  72       if Is_Type (Ent) then
  73          Ent := Underlying_Type (Ent);
  74       end if;
  75
  76       case Get_Attribute_Id (Chars (N)) is
  77
  78          -------------
  79          -- Address --
  80          -------------
  81
  82          when Attribute_Address =>
  83
  84             --  If there is an initialization which did not come from the
  85             --  source program, then it is an artifact of our expansion, and we
  86             --  suppress it. The case we are most concerned about here is the
  87             --  initialization of a packed array to all false, which seems
  88             --  inappropriate for variable to which an address clause is
  89             --  applied. The expression may itself have been rewritten if the
  90             --  type is packed array, so we need to examine whether the
  91             --  original node is in the source. An exception though is the case
  92             --  of an access variable which is default initialized to null, and
  93             --  such initialization is retained.
  94
  95             --  Furthermore, if the initialization is the equivalent aggregate
  96             --  of the type initialization procedure, it replaces an implicit
  97             --  call to the init proc, and must be respected. Note that for
  98             --  packed types we do not build equivalent aggregates.
  99
 100             --  Also, if Init_Or_Norm_Scalars applies, then we need to retain
 101             --  any default initialization for objects of scalar types and
 102             --  types with scalar components. Normally a composite type will
 103             --  have an init_proc in the presence of Init_Or_Norm_Scalars,
 104             --  so when that flag is set we have just have to do a test for
 105             --  scalar and string types (the predefined string types such as
 106             --  String and Wide_String don't have an init_proc).
 107
 108             declare
 109                Decl : constant Node_Id := Declaration_Node (Ent);
 110                Typ  : constant Entity_Id := Etype (Ent);
 111
 112             begin
 113                if Nkind (Decl) = N_Object_Declaration
 114                   and then Present (Expression (Decl))
 115                   and then Nkind (Expression (Decl)) /= N_Null
 116                   and then
 117                    not Comes_From_Source (Original_Node (Expression (Decl)))
 118                then
 119                   if Present (Base_Init_Proc (Typ))
 120                     and then
 121                       Present (Static_Initialization (Base_Init_Proc (Typ)))
 122                   then
 123                      null;
 124
 125                   elsif Init_Or_Norm_Scalars
 126                     and then
 127                       (Is_Scalar_Type (Typ) or else Is_String_Type (Typ))
 128                   then
 129                      null;
 130
 131                   else
 132                      Set_Expression (Decl, Empty);
 133                   end if;
 134
 135                --  An object declaration to which an address clause applies
 136                --  has a delayed freeze, but the address expression itself
 137                --  must be elaborated at the point it appears. If the object
 138                --  is controlled, additional checks apply elsewhere.
 139                --  If the attribute comes from an aspect specification it
 140                --  is being elaborated at the freeze point and side effects
 141                --  need not be removed (and shouldn't, if the expression
 142                --  depends on other entities that have delayed freeze).
 143                --  This is another consequence of the delayed analysis of
 144                --  aspects, and a real semantic difference.
 145
 146                elsif Nkind (Decl) = N_Object_Declaration
 147                  and then not Needs_Constant_Address (Decl, Typ)
 148                  and then not From_Aspect_Specification (N)
 149                then
 150                   Remove_Side_Effects (Exp);
 151                end if;
 152             end;
 153
 154          ---------------
 155          -- Alignment --
 156          ---------------
 157
 158          when Attribute_Alignment =>
 159
 160             --  As required by Gigi, we guarantee that the operand is an
 161             --  integer literal (this simplifies things in Gigi).
 162
 163             if Nkind (Exp) /= N_Integer_Literal then
 164                Rewrite
 165                  (Exp, Make_Integer_Literal (Loc, Expr_Value (Exp)));
 166             end if;
 167
 168             --  A complex case arises if the alignment clause applies to an
 169             --  unconstrained object initialized with a function call. The
 170             --  result of the call is placed on the secondary stack, and the
 171             --  declaration is rewritten as a renaming of a dereference, which
 172             --  fails expansion. We must introduce a temporary and assign its
 173             --  value to the existing entity.
 174
 175             if Nkind (Parent (Ent)) = N_Object_Renaming_Declaration
 176               and then not Is_Entity_Name (Renamed_Object (Ent))
 177             then
 178                declare
 179                   Loc      : constant Source_Ptr := Sloc (N);
 180                   Decl     : constant Node_Id    := Parent (Ent);
 181                   Temp     : constant Entity_Id  := Make_Temporary (Loc, 'T');
 182                   New_Decl : Node_Id;
 183
 184                begin
 185                   --  Replace entity with temporary and reanalyze
 186
 187                   Set_Defining_Identifier (Decl, Temp);
 188                   Set_Analyzed (Decl, False);
 189                   Analyze (Decl);
 190
 191                   --  Introduce new declaration for entity but do not reanalyze
 192                   --  because entity is already in scope. Type and expression
 193                   --  are already resolved.
 194
 195                   New_Decl :=
 196                     Make_Object_Declaration (Loc,
 197                       Defining_Identifier => Ent,
 198                       Object_Definition   =>
 199                         New_Occurrence_Of (Etype (Ent), Loc),
 200                       Expression          => New_Occurrence_Of (Temp, Loc));
 201
 202                   Set_Renamed_Object (Ent, Empty);
 203                   Insert_After (Decl, New_Decl);
 204                   Set_Analyzed (Decl);
 205                end;
 206             end if;
 207
 208          ------------------
 209          -- Storage_Size --
 210          ------------------
 211
 212          when Attribute_Storage_Size =>
 213
 214             --  If the type is a task type, then assign the value of the
 215             --  storage size to the Size variable associated with the task.
 216             --  Insert the assignment right after the declaration of the Size
 217             --  variable.
 218
 219             --  Generate:
 220
 221             --  task_typeZ := expression
 222
 223             if Ekind (Ent) = E_Task_Type then
 224                declare
 225                   Assign : Node_Id;
 226
 227                begin
 228                   Assign :=
 229                     Make_Assignment_Statement (Loc,
 230                       Name =>
 231                         New_Occurrence_Of (Storage_Size_Variable (Ent), Loc),
 232                       Expression =>
 233                         Convert_To (RTE (RE_Size_Type), Expression (N)));
 234
 235                   --  If the clause is not generated by an aspect, insert
 236                   --  the assignment here.  Freezing rules ensure that this
 237                   --  is safe, or clause will have been rejected already.
 238
 239                   if Is_List_Member (N) then
 240                      Insert_After (N, Assign);
 241
 242                   --  Otherwise, insert assignment after task declaration.
 243
 244                   else
 245                      Insert_After
 246                        (Parent (Storage_Size_Variable (Entity (N))), Assign);
 247                   end if;
 248
 249                   Analyze (Assign);
 250                end;
 251
 252             --  For Storage_Size for an access type, create a variable to hold
 253             --  the value of the specified size with name typeV and expand an
 254             --  assignment statement to initialize this value.
 255
 256             elsif Is_Access_Type (Ent) then
 257
 258                --  We don't need the variable for a storage size of zero
 259
 260                if not No_Pool_Assigned (Ent) then
 261                   V :=
 262                     Make_Defining_Identifier (Loc,
 263                       Chars => New_External_Name (Chars (Ent), 'V'));
 264
 265                   --  Insert the declaration of the object
 266
 267                   Insert_Action (N,
 268                     Make_Object_Declaration (Loc,
 269                       Defining_Identifier => V,
 270                       Object_Definition  =>
 271                         New_Occurrence_Of (RTE (RE_Storage_Offset), Loc),
 272                       Expression =>
 273                         Convert_To (RTE (RE_Storage_Offset), Expression (N))));
 274
 275                   Set_Storage_Size_Variable (Ent, Entity_Id (V));
 276                end if;
 277             end if;
 278
 279          --  Other attributes require no expansion
 280
 281          when others =>
 282             null;
 283
 284       end case;
 285    end Expand_N_Attribute_Definition_Clause;
 286
 287    -----------------------------
 288    -- Expand_N_Free_Statement --
 289    -----------------------------
 290
 291    procedure Expand_N_Free_Statement (N : Node_Id) is
 292       Expr : constant Node_Id := Expression (N);
 293       Typ  : Entity_Id;
 294
 295    begin
 296       --  Certain run-time configurations and targets do not provide support
 297       --  for controlled types.
 298
 299       if Restriction_Active (No_Finalization) then
 300          return;
 301       end if;
 302
 303       --  Use the base type to perform the check for finalization master
 304
 305       Typ := Etype (Expr);
 306
 307       if Ekind (Typ) = E_Access_Subtype then
 308          Typ := Etype (Typ);
 309       end if;
 310
 311       --  Handle private access types
 312
 313       if Is_Private_Type (Typ)
 314         and then Present (Full_View (Typ))
 315       then
 316          Typ := Full_View (Typ);
 317       end if;
 318
 319       --  Do not create a custom Deallocate when freeing an object with
 320       --  suppressed finalization. In such cases the object is never attached
 321       --  to a master, so it does not need to be detached. Use a regular free
 322       --  statement instead.
 323
 324       if No (Finalization_Master (Typ)) then
 325          return;
 326       end if;
 327
 328       --  Use a temporary to store the result of a complex expression. Perform
 329       --  the following transformation:
 330       --
 331       --     Free (Complex_Expression);
 332       --
 333       --     Temp : constant Type_Of_Expression := Complex_Expression;
 334       --     Free (Temp);
 335
 336       if Nkind (Expr) /= N_Identifier then
 337          declare
 338             Expr_Typ : constant Entity_Id  := Etype (Expr);
 339             Loc      : constant Source_Ptr := Sloc (N);
 340             New_Expr : Node_Id;
 341             Temp_Id  : Entity_Id;
 342
 343          begin
 344             Temp_Id := Make_Temporary (Loc, 'T');
 345             Insert_Action (N,
 346               Make_Object_Declaration (Loc,
 347                 Defining_Identifier => Temp_Id,
 348                 Object_Definition =>
 349                   New_Occurrence_Of (Expr_Typ, Loc),
 350                 Expression =>
 351                   Relocate_Node (Expr)));
 352
 353             New_Expr := New_Occurrence_Of (Temp_Id, Loc);
 354             Set_Etype (New_Expr, Expr_Typ);
 355
 356             Set_Expression (N, New_Expr);
 357          end;
 358       end if;
 359
 360       --  Create a custom Deallocate for a controlled object. This routine
 361       --  ensures that the hidden list header will be deallocated along with
 362       --  the actual object.
 363
 364       Build_Allocate_Deallocate_Proc (N, Is_Allocate => False);
 365    end Expand_N_Free_Statement;
 366
 367    ----------------------------
 368    -- Expand_N_Freeze_Entity --
 369    ----------------------------
 370
 371    procedure Expand_N_Freeze_Entity (N : Node_Id) is
 372       E : constant Entity_Id := Entity (N);
 373
 374       Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode;
 375
 376       Decl           : Node_Id;
 377       Delete         : Boolean := False;
 378       E_Scope        : Entity_Id;
 379       In_Other_Scope : Boolean;
 380       In_Outer_Scope : Boolean;
 381
 382    begin
 383       --  Ensure that all freezing activities are properly flagged as Ghost
 384
 385       Set_Ghost_Mode_From_Entity (E);
 386
 387       --  If there are delayed aspect specifications, we insert them just
 388       --  before the freeze node. They are already analyzed so we don't need
 389       --  to reanalyze them (they were analyzed before the type was frozen),
 390       --  but we want them in the tree for the back end, and so that the
 391       --  listing from sprint is clearer on where these occur logically.
 392
 393       if Has_Delayed_Aspects (E) then
 394          declare
 395             Aitem : Node_Id;
 396             Ritem : Node_Id;
 397
 398          begin
 399             --  Look for aspect specs for this entity
 400
 401             Ritem := First_Rep_Item (E);
 402             while Present (Ritem) loop
 403                if Nkind (Ritem) = N_Aspect_Specification
 404                  and then Entity (Ritem) = E
 405                then
 406                   Aitem := Aspect_Rep_Item (Ritem);
 407
 408                   --  Skip this for aspects (e.g. Current_Value) for which
 409                   --  there is no corresponding pragma or attribute.
 410
 411                   if Present (Aitem)
 412
 413                     --  Also skip if we have a null statement rather than a
 414                     --  delayed aspect (this happens when we are ignoring rep
 415                     --  items from use of the -gnatI switch).
 416
 417                     and then Nkind (Aitem) /= N_Null_Statement
 418                   then
 419                      pragma Assert (Is_Delayed_Aspect (Aitem));
 420                      Insert_Before (N, Aitem);
 421                   end if;
 422                end if;
 423
 424                Next_Rep_Item (Ritem);
 425             end loop;
 426          end;
 427       end if;
 428
 429       --  Processing for objects
 430
 431       if Is_Object (E) then
 432          if Present (Address_Clause (E)) then
 433             Apply_Address_Clause_Check (E, N);
 434          end if;
 435
 436          --  Analyze actions in freeze node, if any
 437
 438          if Present (Actions (N)) then
 439             declare
 440                Act : Node_Id;
 441             begin
 442                Act := First (Actions (N));
 443                while Present (Act) loop
 444                   Analyze (Act);
 445                   Next (Act);
 446                end loop;
 447             end;
 448          end if;
 449
 450          --  If initialization statements have been captured in a compound
 451          --  statement, insert them back into the tree now.
 452
 453          Explode_Initialization_Compound_Statement (E);
 454          Ghost_Mode := Save_Ghost_Mode;
 455          return;
 456
 457       --  Only other items requiring any front end action are types and
 458       --  subprograms.
 459
 460       elsif not Is_Type (E) and then not Is_Subprogram (E) then
 461          Ghost_Mode := Save_Ghost_Mode;
 462          return;
 463       end if;
 464
 465       --  Here E is a type or a subprogram
 466
 467       E_Scope := Scope (E);
 468
 469       --  This is an error protection against previous errors
 470
 471       if No (E_Scope) then
 472          Check_Error_Detected;
 473          Ghost_Mode := Save_Ghost_Mode;
 474          return;
 475       end if;
 476
 477       --  The entity may be a subtype declared for a constrained record
 478       --  component, in which case the relevant scope is the scope of
 479       --  the record. This happens for class-wide subtypes created for
 480       --  a constrained type extension with inherited discriminants.
 481
 482       if Is_Type (E_Scope)
 483         and then Ekind (E_Scope) not in Concurrent_Kind
 484       then
 485          E_Scope := Scope (E_Scope);
 486       end if;
 487
 488       --  Remember that we are processing a freezing entity and its freezing
 489       --  nodes. This flag (non-zero = set) is used to avoid the need of
 490       --  climbing through the tree while processing the freezing actions (ie.
 491       --  to avoid generating spurious warnings or to avoid killing constant
 492       --  indications while processing the code associated with freezing
 493       --  actions). We use a counter to deal with nesting.
 494
 495       Inside_Freezing_Actions := Inside_Freezing_Actions + 1;
 496
 497       --  If we are freezing entities defined in protected types, they belong
 498       --  in the enclosing scope, given that the original type has been
 499       --  expanded away. The same is true for entities in task types, in
 500       --  particular the parameter records of entries (Entities in bodies are
 501       --  all frozen within the body). If we are in the task body, this is a
 502       --  proper scope. If we are within a subprogram body, the proper scope
 503       --  is the corresponding spec. This may happen for itypes generated in
 504       --  the bodies of protected operations.
 505
 506       if Ekind (E_Scope) = E_Protected_Type
 507         or else (Ekind (E_Scope) = E_Task_Type
 508                   and then not Has_Completion (E_Scope))
 509       then
 510          E_Scope := Scope (E_Scope);
 511
 512       elsif Ekind (E_Scope) = E_Subprogram_Body then
 513          E_Scope := Corresponding_Spec (Unit_Declaration_Node (E_Scope));
 514       end if;
 515
 516       --  If the scope of the entity is in open scopes, it is the current one
 517       --  or an enclosing one, including a loop, a block, or a subprogram.
 518
 519       if In_Open_Scopes (E_Scope) then
 520          In_Other_Scope := False;
 521          In_Outer_Scope := E_Scope /= Current_Scope;
 522
 523       --  Otherwise it is a local package or a different compilation unit
 524
 525       else
 526          In_Other_Scope := True;
 527          In_Outer_Scope := False;
 528       end if;
 529
 530       --  If the entity being frozen is defined in a scope that is not
 531       --  currently on the scope stack, we must establish the proper
 532       --  visibility before freezing the entity and related subprograms.
 533
 534       if In_Other_Scope then
 535          Push_Scope (E_Scope);
 536
 537          --  Finalizers are little odd in terms of freezing. The spec of the
 538          --  procedure appears in the declarations while the body appears in
 539          --  the statement part of a single construct. Since the finalizer must
 540          --  be called by the At_End handler of the construct, the spec is
 541          --  manually frozen right after its declaration. The only side effect
 542          --  of this action appears in contexts where the construct is not in
 543          --  its final resting place. These contexts are:
 544
 545          --    * Entry bodies - The declarations and statements are moved to
 546          --      the procedure equivalen of the entry.
 547          --    * Protected subprograms - The declarations and statements are
 548          --      moved to the non-protected version of the subprogram.
 549          --    * Task bodies - The declarations and statements are moved to the
 550          --      task body procedure.
 551
 552          --  Visible declarations do not need to be installed in these three
 553          --  cases since it does not make semantic sense to do so. All entities
 554          --  referenced by a finalizer are visible and already resolved, plus
 555          --  the enclosing scope may not have visible declarations at all.
 556
 557          if Ekind (E) = E_Procedure
 558            and then Is_Finalizer (E)
 559            and then
 560              (Is_Entry (E_Scope)
 561                 or else (Is_Subprogram (E_Scope)
 562                           and then Is_Protected_Type (Scope (E_Scope)))
 563                 or else Is_Task_Type (E_Scope))
 564          then
 565             null;
 566          else
 567             Install_Visible_Declarations (E_Scope);
 568          end if;
 569
 570          if Is_Package_Or_Generic_Package (E_Scope) or else
 571             Is_Protected_Type (E_Scope)             or else
 572             Is_Task_Type (E_Scope)
 573          then
 574             Install_Private_Declarations (E_Scope);
 575          end if;
 576
 577       --  If the entity is in an outer scope, then that scope needs to
 578       --  temporarily become the current scope so that operations created
 579       --  during type freezing will be declared in the right scope and
 580       --  can properly override any corresponding inherited operations.
 581
 582       elsif In_Outer_Scope then
 583          Push_Scope (E_Scope);
 584       end if;
 585
 586       --  If type, freeze the type
 587
 588       if Is_Type (E) then
 589          Delete := Freeze_Type (N);
 590
 591          --  And for enumeration type, build the enumeration tables
 592
 593          if Is_Enumeration_Type (E) then
 594             Build_Enumeration_Image_Tables (E, N);
 595          end if;
 596
 597       --  If subprogram, freeze the subprogram
 598
 599       elsif Is_Subprogram (E) then
 600          Exp_Ch6.Freeze_Subprogram (N);
 601
 602          --  Ada 2005 (AI-251): Remove the freezing node associated with the
 603          --  entities internally used by the frontend to register primitives
 604          --  covering abstract interfaces. The call to Freeze_Subprogram has
 605          --  already expanded the code that fills the corresponding entry in
 606          --  its secondary dispatch table and therefore the code generator
 607          --  has nothing else to do with this freezing node.
 608
 609          Delete := Present (Interface_Alias (E));
 610       end if;
 611
 612       --  Analyze actions generated by freezing. The init_proc contains source
 613       --  expressions that may raise Constraint_Error, and the assignment
 614       --  procedure for complex types needs checks on individual component
 615       --  assignments, but all other freezing actions should be compiled with
 616       --  all checks off.
 617
 618       if Present (Actions (N)) then
 619          Decl := First (Actions (N));
 620          while Present (Decl) loop
 621             if Nkind (Decl) = N_Subprogram_Body
 622               and then (Is_Init_Proc (Defining_Entity (Decl))
 623                           or else
 624                             Chars (Defining_Entity (Decl)) = Name_uAssign)
 625             then
 626                Analyze (Decl);
 627
 628             --  A subprogram body created for a renaming_as_body completes
 629             --  a previous declaration, which may be in a different scope.
 630             --  Establish the proper scope before analysis.
 631
 632             elsif Nkind (Decl) = N_Subprogram_Body
 633               and then Present (Corresponding_Spec (Decl))
 634               and then Scope (Corresponding_Spec (Decl)) /= Current_Scope
 635             then
 636                Push_Scope (Scope (Corresponding_Spec (Decl)));
 637                Analyze (Decl, Suppress => All_Checks);
 638                Pop_Scope;
 639
 640             --  We treat generated equality specially, if validity checks are
 641             --  enabled, in order to detect components default-initialized
 642             --  with invalid values.
 643
 644             elsif Nkind (Decl) = N_Subprogram_Body
 645               and then Chars (Defining_Entity (Decl)) = Name_Op_Eq
 646               and then Validity_Checks_On
 647               and then Initialize_Scalars
 648             then
 649                declare
 650                   Save_Force : constant Boolean := Force_Validity_Checks;
 651                begin
 652                   Force_Validity_Checks := True;
 653                   Analyze (Decl);
 654                   Force_Validity_Checks := Save_Force;
 655                end;
 656
 657             --  All other freezing actions
 658
 659             else
 660                Analyze (Decl, Suppress => All_Checks);
 661             end if;
 662
 663             Next (Decl);
 664          end loop;
 665       end if;
 666
 667       --  If we are to delete this N_Freeze_Entity, do so by rewriting so that
 668       --  a loop on all nodes being inserted will work propertly.
 669
 670       if Delete then
 671          Rewrite (N, Make_Null_Statement (Sloc (N)));
 672       end if;
 673
 674       --  Pop scope if we installed one for the analysis
 675
 676       if In_Other_Scope then
 677          if Ekind (Current_Scope) = E_Package then
 678             End_Package_Scope (E_Scope);
 679          else
 680             End_Scope;
 681          end if;
 682
 683       elsif In_Outer_Scope then
 684          Pop_Scope;
 685       end if;
 686
 687       --  Restore previous value of the nesting-level counter that records
 688       --  whether we are inside a (possibly nested) call to this procedure.
 689
 690       Inside_Freezing_Actions := Inside_Freezing_Actions - 1;
 691       Ghost_Mode := Save_Ghost_Mode;
 692    end Expand_N_Freeze_Entity;
 693
 694    -------------------------------------------
 695    -- Expand_N_Record_Representation_Clause --
 696    -------------------------------------------
 697
 698    --  The only expansion required is for the case of a mod clause present,
 699    --  which is removed, and translated into an alignment representation
 700    --  clause inserted immediately after the record rep clause with any
 701    --  initial pragmas inserted at the start of the component clause list.
 702
 703    procedure Expand_N_Record_Representation_Clause (N : Node_Id) is
 704       Loc     : constant Source_Ptr := Sloc (N);
 705       Rectype : constant Entity_Id  := Entity (Identifier (N));
 706       Mod_Val : Uint;
 707       Citems  : List_Id;
 708       Repitem : Node_Id;
 709       AtM_Nod : Node_Id;
 710
 711    begin
 712       if Present (Mod_Clause (N)) and then not Ignore_Rep_Clauses then
 713          Mod_Val := Expr_Value (Expression (Mod_Clause (N)));
 714          Citems  := Pragmas_Before (Mod_Clause (N));
 715
 716          if Present (Citems) then
 717             Append_List_To (Citems, Component_Clauses (N));
 718             Set_Component_Clauses (N, Citems);
 719          end if;
 720
 721          AtM_Nod :=
 722            Make_Attribute_Definition_Clause (Loc,
 723              Name       => New_Occurrence_Of (Base_Type (Rectype), Loc),
 724              Chars      => Name_Alignment,
 725              Expression => Make_Integer_Literal (Loc, Mod_Val));
 726
 727          Set_From_At_Mod (AtM_Nod);
 728          Insert_After (N, AtM_Nod);
 729          Set_Mod_Clause (N, Empty);
 730       end if;
 731
 732       --  If the record representation clause has no components, then
 733       --  completely remove it.  Note that we also have to remove
 734       --  ourself from the Rep Item list.
 735
 736       if Is_Empty_List (Component_Clauses (N)) then
 737          if First_Rep_Item (Rectype) = N then
 738             Set_First_Rep_Item (Rectype, Next_Rep_Item (N));
 739          else
 740             Repitem := First_Rep_Item (Rectype);
 741             while Present (Next_Rep_Item (Repitem)) loop
 742                if Next_Rep_Item (Repitem) = N then
 743                   Set_Next_Rep_Item (Repitem, Next_Rep_Item (N));
 744                   exit;
 745                end if;
 746
 747                Next_Rep_Item (Repitem);
 748             end loop;
 749          end if;
 750
 751          Rewrite (N,
 752            Make_Null_Statement (Loc));
 753       end if;
 754    end Expand_N_Record_Representation_Clause;
 755
 756 end Exp_Ch13;