diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c9/c940016.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c9/c940016.a | 211 |
1 files changed, 0 insertions, 211 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c9/c940016.a b/gcc/testsuite/ada/acats/tests/c9/c940016.a deleted file mode 100644 index 2226eefb40d..00000000000 --- a/gcc/testsuite/ada/acats/tests/c9/c940016.a +++ /dev/null @@ -1,211 +0,0 @@ --- 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; |