Subversion Repositories openrisc_me

-- C940014.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 as part of the finalization of a protected object

--      each call remaining on an entry queue of the objet is removed

--      from its queue and Program_Error is raised at the place of

--      the corresponding entry_call_statement.

--

-- TEST DESCRIPTION:

--      The example in 9.4(20a-20f);6.0 demonstrates how to cause a

--      protected object to finalize while tasks are still waiting

--      on its entry queues.  The first part of this test mirrors

--      that example.  The second part of the test expands upon

--      the example code to add an object with finalization code

--      to the protected object.  The finalization code should be

--      executed after Program_Error is raised in the callers left

--      on the entry queues.

--

--

-- CHANGE HISTORY:

--      08 Jan 96   SAIC    Initial Release for 2.1

--      10 Jul 96   SAIC    Incorporated Reviewer comments to fix race

--                          condition.

--

--!

with Ada.Finalization;

package C940014_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 C940014_0;

with Report;

with ImpDef;

package body C940014_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 C940014_0;

with Report;

with ImpDef;

with Ada.Finalization;

with C940014_0;

procedure C940014 is

   Verbose : constant Boolean := C940014_0.Verbose;

begin

   Report.Test ("C940014", "Check that the finalization of a protected" &

                           " object results in program_error being raised" &

                           " at the point of the entry call statement for" &

                           " any tasks remaining on any entry queue");

   First_Check: declare

       -- example from ARM 9.4(20a-f);6.0 with minor mods

       task T is

           entry E;

       end T;

       task body T is

           protected PO is

               entry Ee;

           end PO;

           protected body PO is

               entry Ee when Report.Ident_Bool (False) is

               begin

                   null;

               end Ee;

           end PO;

       begin

           accept E do

                requeue PO.Ee;

           end E;

           if Verbose then

                Report.Comment ("task about to terminate");

           end if;

       end T;

   begin  -- First_Check

       begin

           T.E;

           delay ImpDef.Clear_Ready_Queue;

           Report.Failed ("exception not raised in First_Check");

       exception

           when Program_Error =>

               if Verbose then

                   Report.Comment ("ARM Example passed");

               end if;

           when others =>

               Report.Failed ("wrong exception in First_Check");

       end;

   end First_Check;

   Second_Check : declare

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

      -- occurs before the other finalization actions.

       task T is

           entry E;

       end T;

       task body T is

           protected PO is

               entry Ee;

           private

               Component : C940014_0.Has_Finalization;

           end PO;

           protected body PO is

               entry Ee when Report.Ident_Bool (False) is

               begin

                   null;

               end Ee;

           end PO;

       begin

           accept E do

                requeue PO.Ee;

           end E;

           if Verbose then

                Report.Comment ("task about to terminate");

           end if;

       end T;

   begin  -- Second_Check

       T.E;

       delay ImpDef.Clear_Ready_Queue;

       Report.Failed ("exception not raised in Second_Check");

   exception

       when Program_Error =>

           if C940014_0.Finalization_Occurred then

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

           elsif Verbose then

               Report.Comment ("Second_Check passed");

           end if;

       when others =>

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

   end Second_Check;

   Report.Result;

end C940014;