Subversion Repositories openrisc_2011-10-31

-- 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;