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