gcc/testsuite/ada/acats/tests/c9/c910002.a

   1 -- C910002.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 contents of a task object include the values
  28 --      of its discriminants.
  29 --      Check that selected_component notation can be used to
  30 --      denote a discriminant of a task.
  31 --
  32 -- TEST DESCRIPTION:
  33 --      This test declares a task type that contains discriminants.
  34 --      Objects of the task type are created with different values.
  35 --      The task type has nested tasks that are used to check that
  36 --      the discriminate values are the expected values.
  37 --      Note that the names of the discriminants in the body of task
  38 --      type DTT denote the current instance of the unit.
  39 --
  40 --
  41 -- CHANGE HISTORY:
  42 --      12 OCT 95   SAIC    Initial release for 2.1
  43 --       8 MAY 96   SAIC    Incorporated Reviewer comments.
  44 --
  45 --!
  46
  47
  48 with Report;
  49 procedure C910002 is
  50   Verbose : constant Boolean := False;
  51 begin
  52   Report.Test ("C910002",
  53                "Check that selected_component notation can be" &
  54                " used to access task discriminants");
  55   declare
  56
  57     task type DTT
  58          (IA, IB : Integer;
  59           CA, CB : Character) is
  60       entry Check_Values (First_Int : Integer;
  61                           First_Char : Character);
  62     end DTT;
  63
  64     task body DTT is
  65        Int1 : Integer;
  66        Char1 : Character;
  67
  68        -- simple nested task to check the character values
  69        task Check_Chars is
  70           entry Start_Check;
  71        end Check_Chars;
  72        task body Check_Chars is
  73        begin
  74           accept Start_Check;
  75           if DTT.CA /= Char1 or
  76              DTT.CB /= Character'Succ (Char1) then
  77             Report.Failed ("character check failed.  Expected: '" &
  78                      Char1 & Character'Succ (Char1) &
  79                      "' but found '" &
  80                      DTT.CA & DTT.CB & "'");
  81           elsif Verbose then
  82             Report.Comment ("char check for " & Char1);
  83           end if;
  84        exception
  85           when others => Report.Failed ("exception in Check_Chars");
  86        end Check_Chars;
  87
  88        -- use a discriminated task to check the integer values
  89        task type Check_Ints (First : Integer);
  90        task body Check_Ints is
  91        begin
  92           if DTT.IA /= Check_Ints.First or
  93              IB     /= First+1 then
  94             Report.Failed ("integer check failed.  Expected:" &
  95                      Integer'Image (Check_Ints.First) &
  96                      Integer'Image (First+1) &
  97                      " but found" &
  98                      Integer'Image (DTT.IA) & Integer'Image (IB) );
  99           elsif Verbose then
 100             Report.Comment ("int check for" & Integer'Image (First));
 101           end if;
 102        exception
 103           when others => Report.Failed ("exception in Check_Ints");
 104        end Check_Ints;
 105     begin
 106       accept Check_Values (First_Int : Integer;
 107                            First_Char : Character) do
 108         Int1 := First_Int;
 109         Char1 := First_Char;
 110       end Check_Values;
 111
 112       -- kick off the character check
 113       Check_Chars.Start_Check;
 114
 115       -- do the integer check
 116       declare
 117          Int_Checker : Check_Ints (Int1);
 118       begin
 119         null;  -- let task do its thing
 120       end;
 121
 122       -- do one test here too
 123       if DTT.IA /= Int1 then
 124         Report.Failed ("DTT check failed.  Expected:" &
 125               Integer'Image (Int1) &
 126               " but found:" &
 127               Integer'Image (DTT.IA));
 128       elsif Verbose then
 129         Report.Comment ("DTT check for" & Integer'Image (Int1));
 130       end if;
 131     exception
 132       when others => Report.Failed ("exception in DTT");
 133     end DTT;
 134
 135     T1a : DTT (1,  2, 'a', 'b');
 136     T9C : DTT (9, 10, 'C', 'D');
 137   begin   -- test encapsulation
 138     T1a.Check_Values (1, 'a');
 139     T9C.Check_Values (9, 'C');
 140   end;
 141
 142   Report.Result;
 143 end C910002;