old-autovect-branch/gcc/testsuite/ada/acats/tests/ca/ca21001.a

   1 -- CA21001.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
   6 --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
   7 --     software and documentation contained herein.  Unlimited rights are
   8 --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
   9 --     the Government intends to confer upon all recipients unlimited rights
  10 --     equal to those held by the Government.  These rights include rights to
  11 --     use, duplicate, release or disclose the released technical data and
  12 --     computer software in whole or in part, in any manner and for any purpose
  13 --     whatsoever, and to have or permit others to do so.
  14 --
  15 --                                    DISCLAIMER
  16 --
  17 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  18 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  19 --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
  20 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  21 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  22 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  23 --*
  24 --
  25 -- OBJECTIVE
  26 --     Check the requirements of the revised 10.2.1(11) from Technical
  27 --     Corrigendum 1 (originally discussed as AI95-00002).
  28 --     A package subunit whose parent is a preelaborated subprogram need
  29 --     not be preelaborable.
  30 --
  31 -- TEST DESCRIPTION
  32 --     We create several preelaborated library procedures with
  33 --     non-preelaborable package body subunits.  We try various levels
  34 --     of nesting of package and procedure subunits.
  35 --
  36 -- CHANGE HISTORY:
  37 --      29 JUN 1999   RAD   Initial Version
  38 --      23 SEP 1999   RLB   Improved comments, renamed, issued.
  39 --
  40 --!
  41
  42 procedure CA21001_1(X: out Integer);
  43     pragma Preelaborate(CA21001_1);
  44
  45 procedure CA21001_1(X: out Integer) is
  46     function F return Integer is separate;
  47
  48     package Sub is
  49         function G(X: Integer) return Integer;
  50             -- Returns X + 1.
  51         Not_Preelaborable: Integer := F; -- OK, by AI-2.
  52     end Sub;
  53
  54     package body Sub is separate;
  55
  56 begin
  57     X := -1;
  58     X := F;
  59     X := Sub.G(X);
  60 end CA21001_1;
  61
  62 separate(CA21001_1)
  63 package body Sub is
  64     package Sub_Sub is
  65         -- Empty.
  66     end Sub_Sub;
  67     package body Sub_Sub is separate;
  68
  69     function G(X: Integer) return Integer is separate;
  70 begin
  71     Not_Preelaborable := G(F); -- OK, by AI-2.
  72     if Not_Preelaborable /= 101 then
  73         raise Program_Error; -- Can't call Report.Failed, here,
  74             -- because Report is not preelaborated.
  75     end if;
  76 end Sub;
  77
  78 separate(CA21001_1.Sub)
  79 package body Sub_Sub is
  80 begin
  81     X := X; -- OK by AI-2.
  82 end Sub_Sub;
  83
  84 separate(CA21001_1.Sub)
  85 function G(X: Integer) return Integer is
  86
  87     package G_Sub is
  88         function H(X: Integer) return Integer;
  89             -- Returns X + 1.
  90         Not_Preelaborable: Integer := F; -- OK, by AI-2.
  91     end G_Sub;
  92     package body G_Sub is separate;
  93
  94 begin
  95     return G_Sub.H(X);
  96 end G;
  97
  98 separate(CA21001_1.Sub.G)
  99 package body G_Sub is
 100     function H(X: Integer) return Integer is separate;
 101 begin
 102     Not_Preelaborable := H(F); -- OK, by AI-2.
 103     if Not_Preelaborable /= 101 then
 104         raise Program_Error; -- Can't call Report.Failed, here,
 105             -- because Report is not preelaborated.
 106     end if;
 107 end G_Sub;
 108
 109 separate(CA21001_1.Sub.G.G_Sub)
 110 function H(X: Integer) return Integer is
 111 begin
 112     return X + 1;
 113 end H;
 114
 115 separate(CA21001_1)
 116 function F return Integer is
 117
 118     package F_Sub is
 119         -- Empty.
 120     end F_Sub;
 121
 122     package body F_Sub is separate;
 123 begin
 124     return 100;
 125 end F;
 126
 127 separate(CA21001_1.F)
 128 package body F_Sub is
 129     True_Var: Boolean;
 130 begin
 131     True_Var := True;
 132     if True_Var then -- OK by AI-2.
 133         X := X;
 134     else
 135         X := X + 2;
 136     end if;
 137 end F_Sub;
 138
 139 with Report; use Report;
 140 with CA21001_1;
 141 procedure CA21001 is
 142     X: Integer := 0;
 143 begin
 144     Test("CA21001",
 145          "Test that a package subunit whose parent is a preelaborated"
 146          & " subprogram need not be preelaborable");
 147     CA21001_1(X);
 148     if X /= 101 then
 149         Failed("Bad value for X");
 150     end if;
 151     Result;
 152 end CA21001;