gcc/testsuite/ada/acats/tests/c7/c761001.a

   1 -- C761001.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 controlled objects declared immediately within a library
  28 --      package are finalized following the completion of the environment
  29 --      task (and prior to termination of the program).
  30 --
  31 -- TEST DESCRIPTION:
  32 --      This test derives a type from Ada.Finalization.Controlled, and
  33 --      declares an object of that type in the body of a library package.
  34 --      The dispatching procedure Finalize is redefined for the derived
  35 --      type to perform a check that it has been called only once, and in
  36 --      turn calls Report.Result.  This test may fail by not calling
  37 --      Report.Result.  This test may also fail by calling Report.Result
  38 --      twice, the first call will report a false pass.
  39 --
  40 --
  41 -- CHANGE HISTORY:
  42 --      06 Dec 94   SAIC    ACVC 2.0
  43 --      13 Nov 95   SAIC    Updated for ACVC 2.0.1
  44 --
  45 --!
  46
  47 with Ada.Finalization;
  48 package C761001_0 is
  49
  50   type Global is new Ada.Finalization.Controlled with null record;
  51   procedure Finalize( It: in out Global );
  52
  53 end C761001_0;
  54
  55 package C761001_1 is
  56
  57   task Library_Task is
  58     entry Never_Called;
  59   end Library_Task;
  60
  61 end C761001_1;
  62
  63 with Report;
  64 with C761001_1;
  65 package body C761001_0 is
  66
  67   My_Object : Global;
  68
  69   Done : Boolean := False;
  70
  71   procedure Finalize( It: in out Global ) is
  72   begin
  73     if not C761001_1.Library_Task'Terminated then
  74       Report.Failed("Library task not terminated before finalize");
  75     end if;
  76     if Done then  -- checking included "just in case"
  77       Report.Comment("Test FAILED, even if previously reporting passed");
  78       Report.Failed("Unwarranted multiple call to finalize");
  79     end if;
  80     Report.Result;
  81     Done := True;
  82   end Finalize;
  83
  84 end C761001_0;
  85
  86 with Report;
  87 package body C761001_1 is
  88
  89   task body Library_Task is
  90   begin
  91     if Report.Ident_Int( 1 ) /= 1 then
  92       Report.Failed( "Baseline failure in Library_Task");
  93     end if;
  94   end Library_Task;
  95
  96 end C761001_1;
  97
  98 with Report;
  99 with C761001_0;
 100
 101 procedure C761001 is
 102
 103 begin  -- Main test procedure.
 104
 105   Report.Test ("C761001", "Check that controlled objects declared "
 106                         & "immediately within a library package are "
 107                         & "finalized following the completion of the "
 108                         & "environment task (and prior to termination "
 109                         & "of the program)");
 110
 111   -- note that if the test DOES call report twice, the first will report a
 112   -- false pass, the second call will correctly fail the test.
 113
 114   -- not calling Report.Result;
 115   -- Result is called as part of the finalization of C761001_0.My_Object.
 116
 117 end C761001;