Subversion Repositories openrisc_me

-- C940016.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.

--*

--

-- TEST OBJECTIVE:

--      Check that an Unchecked_Deallocation of a protected object

--      performs the required finalization on the protected object.

--

-- TEST DESCRIPTION:

--      Test that finalization takes place when an Unchecked_Deallocation

--      deallocates a protected object with queued callers.

--      Try protected objects that have no other finalization code and

--      protected objects with user defined finalization.

--

--

-- CHANGE HISTORY:

--      16 Jan 96   SAIC    ACVC 2.1

--      10 Jul 96   SAIC    Fixed race condition noted by reviewers.

--

--!

with Ada.Finalization;

package C940016_0 is

    Verbose : constant Boolean := False;

    Finalization_Occurred : Boolean := False;

    type Has_Finalization is new Ada.Finalization.Limited_Controlled with

          record

             Placeholder : Integer;

          end record;

    procedure Finalize (Object : in out Has_Finalization);

end C940016_0;

with Report;

with ImpDef;

package body C940016_0 is

    procedure Finalize (Object : in out Has_Finalization) is

    begin

        delay ImpDef.Clear_Ready_Queue;

        Finalization_Occurred := True;

        if Verbose then

            Report.Comment ("in Finalize");

        end if;

    end Finalize;

end C940016_0;

with Report;

with Ada.Finalization;

with C940016_0;

with Ada.Unchecked_Deallocation;

with ImpDef;

procedure C940016 is

   Verbose : constant Boolean := C940016_0.Verbose;

begin

   Report.Test ("C940016", "Check that Unchecked_Deallocation of a" &

                           " protected object finalizes the" &

                           " protected object");

   First_Check: declare

       protected type Semaphore is

           entry Wait;

           procedure Signal;

       private

           Count : Integer := 0;

       end Semaphore;

       protected body Semaphore is

           entry Wait when Count > 0 is

           begin

               Count := Count - 1;

           end Wait;

           procedure Signal is

           begin

              Count := Count + 1;

           end Signal;

       end Semaphore;

       type pSem is access Semaphore;

       procedure Zap_Semaphore is new

           Ada.Unchecked_Deallocation (Semaphore, pSem);

       Sem_Ptr : pSem := new Semaphore;

       -- positive confirmation that Blocker got the exception

       Ok : Boolean := False;

       task Blocker;

       task body Blocker is

       begin

           Sem_Ptr.Wait;

           Report.Failed ("Program_Error not raised in waiting task");

       exception

           when Program_Error =>

               Ok := True;

               if Verbose then

                   Report.Comment ("Blocker received Program_Error");

               end if;

           when others =>

               Report.Failed ("Wrong exception in Blocker");

       end Blocker;

   begin  -- First_Check

       -- wait for Blocker to get blocked on the semaphore

       delay ImpDef.Clear_Ready_Queue;

       Zap_Semaphore (Sem_Ptr);

       -- make sure Blocker has time to complete

       delay ImpDef.Clear_Ready_Queue * 2;

       if not Ok then

           Report.Failed ("finalization not properly performed");

           -- Blocker is probably hung so kill it

           abort Blocker;

       end if;

   end First_Check;

   Second_Check : declare

      -- here we want to check that the raising of Program_Error

      -- occurs before the other finalization actions.

       protected type Semaphore is

           entry Wait;

           procedure Signal;

       private

           Count : Integer := 0;

           Component : C940016_0.Has_Finalization;

       end Semaphore;

       protected body Semaphore is

           entry Wait when Count > 0 is

           begin

               Count := Count - 1;

           end Wait;

           procedure Signal is

           begin

              Count := Count + 1;

           end Signal;

       end Semaphore;

       type pSem is access Semaphore;

       procedure Zap_Semaphore is new

           Ada.Unchecked_Deallocation (Semaphore, pSem);

       Sem_Ptr : pSem := new Semaphore;

       -- positive confirmation that Blocker got the exception

       Ok : Boolean := False;

       task Blocker;

       task body Blocker is

       begin

           Sem_Ptr.Wait;

           Report.Failed ("Program_Error not raised in waiting task 2");

       exception

           when Program_Error =>

               Ok := True;

               if C940016_0.Finalization_Occurred then

                   Report.Failed ("wrong order for finalization 2");

               elsif Verbose then

                   Report.Comment ("Blocker received Program_Error 2");

               end if;

           when others =>

               Report.Failed ("Wrong exception in Blocker 2");

       end Blocker;

   begin  -- Second_Check

       -- wait for Blocker to get blocked on the semaphore

       delay ImpDef.Clear_Ready_Queue;

       Zap_Semaphore (Sem_Ptr);

       -- make sure Blocker has time to complete

       delay ImpDef.Clear_Ready_Queue * 2;

       if not Ok then

           Report.Failed ("finalization not properly performed 2");

           -- Blocker is probably hung so kill it

           abort Blocker;

       end if;

       if not C940016_0.Finalization_Occurred then

           Report.Failed ("user defined finalization didn't happen");

       end if;

   end Second_Check;

   Report.Result;

end C940016;