OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c93004f.ada] - Rev 827

Go to most recent revision | Compare with Previous | Blame | View Log

-- C93004F.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 WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
-- TASK, OTHER TASKS ARE UNAFFECTED.
 
-- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
 
-- THIS TESTS CHECKS THE CASE IN WHICH THE TASKS ARE CREATED BY THE
-- ALLOCATION OF A RECORD OF TASKS OR AN ARRAY OF TASKS.
 
-- R. WILLIAMS 8/7/86
 
WITH REPORT; USE REPORT;
 
PROCEDURE C93004F IS
 
BEGIN
     TEST ( "C93004F", "CHECK THAT WHEN AN EXCEPTION IS RAISED " &
                       "DURING THE ACTIVATION OF A TASK, OTHER " &
                       "TASKS ARE UNAFFECTED. IN THIS TEST, THE " &
                       "TASKS ARE CREATED BY THE ALLOCATION OF A " &
                       "RECORD OR AN ARRAY OF TASKS" );
 
     DECLARE
 
          TASK TYPE T IS 
               ENTRY E;
          END T;
 
          TASK TYPE TT;
 
          TASK TYPE TX IS 
               ENTRY E;
          END TX;
 
          TYPE REC IS
               RECORD
                    TR : T;
               END RECORD;
 
          TYPE ARR IS ARRAY (IDENT_INT (1) .. IDENT_INT (1)) OF T;
 
          TYPE RECX IS
               RECORD 
                    TTX1 : TX;
                    TTT  : TT;
                    TTX2 : TX;
               END RECORD;
 
          TYPE ACCR IS ACCESS REC;
          AR : ACCR;
 
          TYPE ACCA IS ACCESS ARR;
          AA : ACCA;
 
          TYPE ACCX IS ACCESS RECX;
          AX : ACCX;
 
          TASK BODY T IS
          BEGIN
               ACCEPT E;
          END T;
 
          TASK BODY TT IS
          BEGIN
               AR.TR.E;
          EXCEPTION
               WHEN OTHERS =>
                    FAILED ( "TASK AR.TR NOT ACTIVE" );
          END TT;
 
          TASK BODY TX IS
               I : POSITIVE := IDENT_INT (0); -- RAISE 
                                              -- CONSTRAINT_ERROR.
          BEGIN
               IF I /= IDENT_INT (2) OR I = IDENT_INT (1) + 1 THEN
                    FAILED ( "TX ACTIVATED OK" );
               END IF;
          END TX;
 
     BEGIN
          AR := NEW REC;
          AA := NEW ARR;
          AX := NEW RECX;
 
          FAILED ( "TASKING_ERROR NOT RAISED IN MAIN" );
 
          AA.ALL (1).E;        -- CLEAN UP.
 
     EXCEPTION
          WHEN TASKING_ERROR =>
 
               BEGIN
                    AA.ALL (1).E;
               EXCEPTION
                    WHEN TASKING_ERROR =>
                         FAILED ( "AA.ALL (1) NOT ACTIVATED" );
               END;
 
          WHEN CONSTRAINT_ERROR =>
               FAILED ( "CONSTRAINT_ERROR RAISED IN MAIN" );
          WHEN OTHERS =>
               FAILED ( "ABNORMAL EXCEPTION IN MAIN" );
     END;
 
     RESULT;
 
END C93004F;
 

Go to most recent revision | Compare with Previous | Blame | View Log

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.