old-autovect-branch/gcc/testsuite/ada/acats/tests/c9/c930001.a

   1 -- C930001.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 -- TEST OBJECTIVE:
  27 --      Check when a dependent task and its master both
  28 --      terminate as a result of a terminate alternative that
  29 --      finalization is performed and that the finalization is
  30 --      performed in the proper order.
  31 --
  32 -- TEST DESCRIPTION:
  33 --      A controlled type with finalization is used to determine
  34 --      the order in which finalization occurs.  The finalization
  35 --      procedure records the identity of the object being
  36 --      finalized.
  37 --      Two tasks, one nested inside the other, both contain
  38 --      objects of the above finalization type.  These tasks
  39 --      cooperatively terminate so the termination and finalization
  40 --      order can be noted.
  41 --
  42 --
  43 -- CHANGE HISTORY:
  44 --      08 Jan 96   SAIC    ACVC 2.1
  45 --      09 May 96   SAIC    Addressed Reviewer comments.
  46 --
  47 --!
  48
  49
  50 with Ada.Finalization;
  51 package C930001_0 is
  52     Verbose : constant Boolean := False;
  53
  54     type Ids is range 0..10;
  55     Finalization_Order : array (Ids) of Ids := (Ids => 0);
  56     Finalization_Cnt : Ids := 0;
  57
  58     protected Note is
  59        -- serializes concurrent access to Finalization_* above
  60        procedure Done (Id : Ids);
  61     end Note;
  62
  63     -- Objects of the following type are used to note the order in
  64     -- which finalization occurs.
  65     type Has_Finalization is new Ada.Finalization.Limited_Controlled with
  66           record
  67              Id : Ids;
  68           end record;
  69     procedure Finalize (Object : in out Has_Finalization);
  70 end C930001_0;
  71
  72
  73 with Report;
  74 package body C930001_0 is
  75
  76     protected body Note is
  77         procedure Done (Id : Ids) is
  78         begin
  79             Finalization_Cnt := Finalization_Cnt + 1;
  80             Finalization_Order (Finalization_Cnt) := Id;
  81         end Done;
  82     end Note;
  83
  84     procedure Finalize (Object : in out Has_Finalization) is
  85     begin
  86         Note.Done (Object.Id);
  87         if Verbose then
  88             Report.Comment ("in Finalize for" & Ids'Image (Object.Id));
  89         end if;
  90     end Finalize;
  91 end C930001_0;
  92
  93
  94 with Report;
  95 with ImpDef;
  96 with C930001_0;   use C930001_0;
  97 procedure C930001 is
  98 begin
  99
 100     Report.Test ("C930001", "Check that dependent tasks are terminated" &
 101                             " before the remaining finalization");
 102
 103     declare
 104         task Level_1;
 105         task body Level_1 is
 106             V1a : C930001_0.Has_Finalization;        -------> 4
 107             task Level_2 is
 108                 entry Not_Taken;
 109             end Level_2;
 110             task body Level_2 is
 111                 V2 : C930001_0.Has_Finalization;     -------> 2
 112             begin
 113                 V2.Id := 2;
 114                 C930001_0.Note.Done (1);             -------> 1
 115                 select
 116                     accept Not_Taken;
 117                 or
 118                     terminate;
 119                     -- cooperative termination at this point of
 120                     -- both tasks
 121                 end select;
 122             end Level_2;
 123
 124             -- 7.6.1(11) requires that V1b be finalized before V1a
 125             V1b : C930001_0.Has_Finalization;        -------> 3
 126         begin
 127             V1a.Id := 4;
 128             V1b.Id := 3;
 129         end Level_1;
 130     begin  -- declare
 131         while not Level_1'Terminated loop
 132              delay ImpDef.Switch_To_New_Task;
 133         end loop;
 134         C930001_0.Note.Done (5);                     -------> 5
 135
 136         -- now check the order
 137         for I in Ids range 1..5 loop
 138             if Verbose then
 139                 Report.Comment (Ids'Image (I) &
 140                        Ids'Image (Finalization_Order (I)));
 141             end if;
 142             if Finalization_Order (I) /= I then
 143                 Report.Failed ("Finalization occurred out of order" &
 144                    " expected:" &
 145                    Ids'Image (I) &
 146                    " actual:" &
 147                    Ids'Image (Finalization_Order (I)));
 148             end if;
 149         end loop;
 150     end;
 151
 152     Report.Result;
 153 end C930001;