-- C761001.A -- -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained -- unlimited rights in the software and documentation contained herein. -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making -- this public release, the Government intends to confer upon all -- recipients unlimited rights equal to those held by the Government. -- These rights include rights to use, duplicate, release or disclose the -- released technical data and computer software in whole or in part, in -- any manner and for any purpose whatsoever, and to have or permit others -- to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. --* -- -- OBJECTIVE: -- Check that controlled objects declared immediately within a library -- package are finalized following the completion of the environment -- task (and prior to termination of the program). -- -- TEST DESCRIPTION: -- This test derives a type from Ada.Finalization.Controlled, and -- declares an object of that type in the body of a library package. -- The dispatching procedure Finalize is redefined for the derived -- type to perform a check that it has been called only once, and in -- turn calls Report.Result. This test may fail by not calling -- Report.Result. This test may also fail by calling Report.Result -- twice, the first call will report a false pass. -- -- -- CHANGE HISTORY: -- 06 Dec 94 SAIC ACVC 2.0 -- 13 Nov 95 SAIC Updated for ACVC 2.0.1 -- --! with Ada.Finalization; package C761001_0 is type Global is new Ada.Finalization.Controlled with null record; procedure Finalize( It: in out Global ); end C761001_0; package C761001_1 is task Library_Task is entry Never_Called; end Library_Task; end C761001_1; with Report; with C761001_1; package body C761001_0 is My_Object : Global; Done : Boolean := False; procedure Finalize( It: in out Global ) is begin if not C761001_1.Library_Task'Terminated then Report.Failed("Library task not terminated before finalize"); end if; if Done then -- checking included "just in case" Report.Comment("Test FAILED, even if previously reporting passed"); Report.Failed("Unwarranted multiple call to finalize"); end if; Report.Result; Done := True; end Finalize; end C761001_0; with Report; package body C761001_1 is task body Library_Task is begin if Report.Ident_Int( 1 ) /= 1 then Report.Failed( "Baseline failure in Library_Task"); end if; end Library_Task; end C761001_1; with Report; with C761001_0; procedure C761001 is begin -- Main test procedure. Report.Test ("C761001", "Check that controlled objects declared " & "immediately within a library package are " & "finalized following the completion of the " & "environment task (and prior to termination " & "of the program)"); -- note that if the test DOES call report twice, the first will report a -- false pass, the second call will correctly fail the test. -- not calling Report.Result; -- Result is called as part of the finalization of C761001_0.My_Object. end C761001;