--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/c9/c940016.a	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,211 @@
+-- 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;