--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/c9/c94008c.ada	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,265 @@
+-- C94008C.ADA
+
+--                             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.
+--*
+-- CHECK THAT SELECT WITH TERMINATE ALTERNATIVE WORKS CORRECTLY WITH
+-- NESTED TASKS.
+
+-- THIS TEST CONTAINS RACE CONDITIONS AND USES A GENERIC INSTANCE THAT
+-- CONTAINS TASKS.
+
+-- JEAN-PIERRE ROSEN 24 FEBRUARY 1984
+-- JRK 4/7/86
+-- JBG 8/29/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C94008C IS
+
+
+-- GENERIC UNIT FOR DOING UPDATES OF SHARED VARIABLES
+     GENERIC
+          TYPE HOLDER_TYPE IS PRIVATE;
+          TYPE VALUE_TYPE IS PRIVATE;
+          INITIAL_VALUE : HOLDER_TYPE;
+          WITH PROCEDURE SET (HOLDER : OUT HOLDER_TYPE;
+                              VALUE  : IN  HOLDER_TYPE) IS <>;
+          WITH PROCEDURE UPDATE (HOLDER : IN OUT HOLDER_TYPE;
+                                 VALUE  : IN  VALUE_TYPE) IS <>;
+     PACKAGE SHARED IS
+          PROCEDURE SET (VALUE : IN HOLDER_TYPE);
+          PROCEDURE UPDATE (VALUE : IN VALUE_TYPE);
+          FUNCTION GET RETURN HOLDER_TYPE;
+     END SHARED;
+
+     PACKAGE BODY SHARED IS
+          TASK SHARE IS
+               ENTRY SET    (VALUE : IN HOLDER_TYPE);
+               ENTRY UPDATE (VALUE : IN VALUE_TYPE);
+               ENTRY READ   (VALUE : OUT HOLDER_TYPE);
+          END SHARE;
+
+          TASK BODY SHARE IS
+               VARIABLE : HOLDER_TYPE;
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT SET (VALUE : IN HOLDER_TYPE) DO
+                              SHARED.SET (VARIABLE, VALUE);
+                         END SET;
+                    OR
+                         ACCEPT UPDATE (VALUE : IN VALUE_TYPE) DO
+                              SHARED.UPDATE (VARIABLE, VALUE);
+                         END UPDATE;
+                    OR
+                         ACCEPT READ (VALUE : OUT HOLDER_TYPE) DO
+                              VALUE := VARIABLE;
+                         END READ;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END SHARE;
+
+          PROCEDURE SET (VALUE : IN HOLDER_TYPE) IS
+          BEGIN
+               SHARE.SET (VALUE);
+          END SET;
+
+          PROCEDURE UPDATE (VALUE : IN VALUE_TYPE) IS
+          BEGIN
+               SHARE.UPDATE (VALUE);
+          END UPDATE;
+
+          FUNCTION GET RETURN HOLDER_TYPE IS
+               VALUE : HOLDER_TYPE;
+          BEGIN
+               SHARE.READ (VALUE);
+               RETURN VALUE;
+          END GET;
+
+     BEGIN
+          SHARE.SET (INITIAL_VALUE);    -- SET INITIAL VALUE
+     END SHARED;
+
+     PACKAGE EVENTS IS
+
+          TYPE EVENT_TYPE IS
+               RECORD
+                    TRACE  : STRING (1..4) := "....";
+                    LENGTH : NATURAL := 0;
+               END RECORD;
+
+          PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER);
+          PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE);
+     END EVENTS;
+
+     PACKAGE COUNTER IS
+          PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER);
+          PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER);
+     END COUNTER;
+
+     PACKAGE BODY COUNTER IS
+          PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER) IS
+          BEGIN
+               VAR := VAR + VAL;
+          END UPDATE;
+
+          PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER) IS
+          BEGIN
+               VAR := VAL;
+          END SET;
+     END COUNTER;
+
+     PACKAGE BODY EVENTS IS
+          PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER) IS
+          BEGIN
+               VAR.LENGTH := VAR.LENGTH + 1;
+               VAR.TRACE(VAR.LENGTH) := VAL;
+          END UPDATE;
+
+          PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE) IS
+          BEGIN
+               VAR := VAL;
+          END SET;
+
+     END EVENTS;
+
+     USE EVENTS, COUNTER;
+
+     PACKAGE TRACE IS NEW SHARED (EVENT_TYPE, CHARACTER, ("....", 0));
+     PACKAGE TERMINATE_COUNT IS NEW SHARED (INTEGER, INTEGER, 0);
+
+     FUNCTION ENTER_TERMINATE RETURN BOOLEAN IS
+     BEGIN
+          TERMINATE_COUNT.UPDATE (1);
+          RETURN TRUE;
+     END ENTER_TERMINATE;
+
+BEGIN -- C94008C
+
+     TEST ("C94008C", "CHECK CORRECT OPERATION OF SELECT WITH " &
+                      "TERMINATE ALTERNATIVE");
+
+     DECLARE
+
+          PROCEDURE EVENT (VAR : CHARACTER) RENAMES TRACE.UPDATE;
+
+          TASK T1 IS
+               ENTRY E1;
+          END T1;
+
+          TASK BODY T1 IS
+
+               TASK T2 IS
+                    ENTRY E2;
+               END T2;
+
+               TASK BODY T2 IS
+
+                    TASK T3 IS
+                         ENTRY E3;
+                    END T3;
+
+                    TASK BODY T3 IS
+                    BEGIN
+                         SELECT
+                              ACCEPT E3;
+                         OR WHEN ENTER_TERMINATE => TERMINATE;
+                         END SELECT;
+                         EVENT ('D');
+                    END T3;
+
+               BEGIN -- T2
+
+                    SELECT
+                         ACCEPT E2;
+                    OR WHEN ENTER_TERMINATE => TERMINATE;
+                    END SELECT;
+
+                    DELAY 10.0 * Impdef.One_Second;
+
+                    IF TERMINATE_COUNT.GET /= 1 THEN
+                         DELAY 20.0 * Impdef.One_Long_Second;
+                    END IF;
+
+                    IF TERMINATE_COUNT.GET /= 1 THEN
+                         FAILED ("30 SECOND DELAY NOT ENOUGH - 1 ");
+                    END IF;
+
+                    EVENT ('C');
+                    T1.E1;
+                    T3.E3;
+               END T2;
+
+          BEGIN -- T1;
+
+               SELECT
+                    ACCEPT E1;
+               OR WHEN ENTER_TERMINATE => TERMINATE;
+               END SELECT;
+
+               EVENT ('B');
+               TERMINATE_COUNT.SET (0);
+               T2.E2;
+
+               SELECT
+                    ACCEPT E1;
+               OR WHEN ENTER_TERMINATE => TERMINATE;
+               END SELECT;
+
+               SELECT
+                    ACCEPT E1;
+               OR TERMINATE;  -- ONLY THIS ONE EVER CHOSEN.
+               END SELECT;
+
+               FAILED ("TERMINATE NOT SELECTED IN T1");
+          END T1;
+
+     BEGIN
+
+          DELAY 10.0 * Impdef.One_Second; -- WAIT FOR T1, T2, AND T3 TO GET TO SELECT STMTS.
+
+           IF TERMINATE_COUNT.GET /= 3 THEN
+                DELAY 20.0 * Impdef.One_Long_Second;
+           END IF;
+
+           IF TERMINATE_COUNT.GET /= 3 THEN
+                FAILED ("30 SECOND DELAY NOT ENOUGH - 2");
+           END IF;
+
+          EVENT ('A');
+          T1.E1;
+
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION IN MAIN BLOCK");
+     END;
+
+     IF TRACE.GET.TRACE /= "ABCD" THEN
+          FAILED ("INCORRECT ORDER OF EVENTS: " & TRACE.GET.TRACE);
+     END IF;
+
+     RESULT;
+END C94008C;