gcc/testsuite/ada/acats/tests/c3/c3a1002.a

   1 -- C3A1002.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- OBJECTIVE:
  27 --      Check that the full type completing a type with no discriminant part
  28 --      or an unknown discriminant part may have explicitly declared or
  29 --      inherited discriminants.
  30 --      Check for cases where the types are tagged records and task types.
  31 --
  32 -- TEST DESCRIPTION:
  33 --      Declare two groups of incomplete types: one group with no discriminant
  34 --      part and one group with unknown discriminant part.  Both groups of
  35 --      incomplete types are completed with both explicit and inherited
  36 --      discriminants.  Discriminants for task types are declared with both
  37 --      default and non default values.  Discriminants for tagged types are
  38 --      only declared without default values.
  39 --      In the main program, verify that objects of both groups of incomplete
  40 --      types can be created by default values or by assignments.
  41 --
  42 --
  43 -- CHANGE HISTORY:
  44 --      23 Oct 95   SAIC    Initial prerelease version.
  45 --      19 Oct 96   SAIC    ACVC 2.1: modified test description.  Initialized
  46 --                          Int_Val.
  47 --
  48 --!
  49
  50 package C3A1002_0 is
  51
  52    subtype Small_Int is Integer range 1 .. 15;
  53
  54    type Enu_Type is (M, F);
  55
  56    type Tag_Type is tagged
  57      record
  58         I : Small_Int := 1;
  59      end record;
  60
  61    type NTag_Type (D : Small_Int) is new Tag_Type with
  62      record
  63         S : String (1 .. D) := "Aloha";
  64      end record;
  65
  66    type Incomplete1;                               -- no discriminant
  67
  68    type Incomplete2 (<>);                          -- unknown discriminant
  69
  70    type Incomplete3;                               -- no discriminant
  71
  72    type Incomplete4 (<>);                          -- unknown discriminant
  73
  74    type Incomplete5;                               -- no discriminant
  75
  76    type Incomplete6 (<>);                          -- unknown discriminant
  77
  78    type Incomplete1 (D1 : Enu_Type) is tagged      -- no discriminant/
  79      record                                        -- explicit discriminant
  80         case D1 is
  81            when M => MInteger : Small_Int := 9;
  82            when F => FInteger : Small_Int := 8;
  83         end case;
  84      end record;
  85
  86    type Incomplete2 (D2 : Small_Int) is new       -- unknown discriminant/
  87      Incomplete1 (D1 => F) with record            -- explicit discriminant
  88         ID : String (1 .. D2) := "ACVC95";
  89      end record;
  90
  91    type Incomplete3 is new                         -- no discriminant/
  92      NTag_Type with record                         -- inherited discriminant
  93         E : Enu_Type := M;
  94      end record;
  95
  96    type Incomplete4 is new                         -- unknown discriminant/
  97      NTag_Type (D => 3) with record                -- inherited discriminant
  98         E : Enu_Type := F;
  99      end record;
 100
 101    task type Incomplete5 (D5 : Enu_Type) is      -- no discriminant/
 102       entry Read_Disc (P : out Enu_Type);        -- explicit discriminant
 103    end Incomplete5;
 104
 105    task type Incomplete6
 106      (D6 : Small_Int := 4) is                    -- unknown discriminant/
 107       entry Read_Int (P : out Small_Int);        -- explicit discriminant
 108    end Incomplete6;
 109
 110 end C3A1002_0;
 111
 112      --==================================================================--
 113
 114 package body C3A1002_0 is
 115
 116    task body Incomplete5 is
 117    begin
 118       select
 119          accept Read_Disc (P : out Enu_Type) do
 120             P := D5;
 121          end Read_Disc;
 122       or
 123          terminate;
 124       end select;
 125
 126    end Incomplete5;
 127
 128    ----------------------------------------------------------------------
 129    task body Incomplete6 is
 130    begin
 131       select
 132          accept Read_Int (P : out Small_Int) do
 133             P := D6;
 134          end Read_Int;
 135       or
 136          terminate;
 137       end select;
 138
 139    end Incomplete6;
 140
 141 end C3A1002_0;
 142
 143      --==================================================================--
 144
 145 with Report;
 146
 147 with C3A1002_0;
 148 use  C3A1002_0;
 149
 150 procedure C3A1002 is
 151
 152    Enum_Val : Enu_Type := M;
 153
 154    Int_Val  : Small_Int := 15;
 155
 156    -- Discriminant value comes from default.
 157
 158    Incomplete6_Obj_1  :  Incomplete6;
 159
 160    -- Discriminant value comes from explicit constraint.
 161
 162    Incomplete1_Obj_1  :  Incomplete1 (M);
 163
 164    Incomplete2_Obj_1  :  Incomplete2 (6);
 165
 166    Incomplete5_Obj_1  :  Incomplete5 (F);
 167
 168    Incomplete6_Obj_2  :  Incomplete6 (7);
 169
 170    -- Discriminant value comes from assignment.
 171
 172    Incomplete1_Obj_2  :  Incomplete1
 173                       := (F, 12);
 174
 175    Incomplete3_Obj_1  :  Incomplete3
 176                       := (D => 2, S => "Hi", I => 10, E => F);
 177
 178    Incomplete4_Obj_1  :  Incomplete4
 179                       := (E => M, D => 3, S => "Bye", I => 14);
 180
 181 begin
 182
 183    Report.Test ("C3A1002", "Check that the full type completing a type " &
 184                 "with no discriminant part or an unknown discriminant "  &
 185                 "part may have explicitly declared or inherited "        &
 186                 "discriminants.  Check for cases where the types are "   &
 187                 "tagged records and task types");
 188
 189    -- Check the initial values.
 190
 191    if (Incomplete6_Obj_1.D6 /= 4) then
 192       Report.Failed ("Wrong initial value for Incomplete6_Obj_1");
 193    end if;
 194
 195    -- Check the explicit values.
 196
 197    if (Incomplete1_Obj_1.D1       /= M) or
 198       (Incomplete1_Obj_1.MInteger /= 9) then
 199         Report.Failed ("Wrong values for Incomplete1_Obj_1");
 200    end if;
 201
 202    if (Incomplete2_Obj_1.D2       /= 6) or
 203       (Incomplete2_Obj_1.FInteger /= 8) or
 204       (Incomplete2_Obj_1.ID       /= "ACVC95") then
 205          Report.Failed ("Wrong values for Incomplete2_Obj_1");
 206    end if;
 207
 208    if (Incomplete5_Obj_1.D5 /= F) then
 209       Report.Failed ("Wrong value for Incomplete5_Obj_1");
 210    end if;
 211
 212    Incomplete5_Obj_1.Read_Disc (Enum_Val);
 213
 214    if (Enum_Val /= F) then
 215       Report.Failed ("Wrong value for Enum_Val");
 216    end if;
 217
 218    if (Incomplete6_Obj_2.D6 /= 7) then
 219       Report.Failed ("Wrong value for Incomplete6_Obj_2");
 220    end if;
 221
 222    Incomplete6_Obj_1.Read_Int (Int_Val);
 223
 224    if (Int_Val /= 4) then
 225       Report.Failed ("Wrong value for Int_Val");
 226    end if;
 227
 228    -- Check the assigned values.
 229
 230    if (Incomplete1_Obj_2.D1       /= F)  or
 231       (Incomplete1_Obj_2.FInteger /= 12) then
 232          Report.Failed ("Wrong values for Incomplete1_Obj_2");
 233    end if;
 234
 235    if (Incomplete3_Obj_1.D /= 2 ) or
 236       (Incomplete3_Obj_1.I /= 10) or
 237       (Incomplete3_Obj_1.E /= F ) or
 238       (Incomplete3_Obj_1.S /= "Hi") then
 239          Report.Failed ("Wrong values for Incomplete3_Obj_1");
 240    end if;
 241
 242    if (Incomplete4_Obj_1.E /= M )      or
 243       (Incomplete4_Obj_1.D /= 3)       or
 244       (Incomplete4_Obj_1.S /= "Bye")   or
 245       (Incomplete4_Obj_1.I /= 14)      then
 246          Report.Failed ("Wrong values for Incomplete4_Obj_1");
 247    end if;
 248
 249    Report.Result;
 250
 251 end C3A1002;