From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/ada/acats/tests/ce/ce3115a.ada | 232 +++++++++++++++++++++++++++ 1 file changed, 232 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/ce/ce3115a.ada (limited to 'gcc/testsuite/ada/acats/tests/ce/ce3115a.ada') diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3115a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3115a.ada new file mode 100644 index 000000000..66d951e53 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3115a.ada @@ -0,0 +1,232 @@ +-- CE3115A.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. +--* +-- OBJECTIVE: +-- CHECK THAT RESETTING ONE OF A MULTIPLE OF INTERNAL FILES +-- ASSOCIATED WITH THE SAME EXTERNAL FILE HAS NO EFFECT ON ANY +-- OF THE OTHER INTERNAL FILES. + + +-- APPLICABILITY CRITERIA: +-- THIS TEST APPLIES ONLY TO IMPLEMENTATIONS WHICH SUPPORT MULTIPLE +-- INTERNAL FILES ASSOCIATED WITH THE SAME EXTERNAL FILE AND +-- RESETTING OF THESE MULTIPLE INTERNAL FILES FOR TEXT FILES. + +-- HISTORY: +-- DLD 08/16/82 +-- SPS 11/09/82 +-- JBG 06/04/84 +-- EG 11/19/85 MADE TEST INAPPLICABLE IF CREATE USE_ERROR. +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE RESULT WHEN +-- FILES NOT SUPPORTED. +-- GMT 08/25/87 COMPLETELY REVISED. +-- EDS 12/01/97 ADD NAME_ERROR HANDLER TO OUTPUT NOT_APPLICABLE RESULT. +-- RLB 09/29/98 MADE MODIFICATION TO AVOID BUFFERING PROBLEMS. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3115A IS + +BEGIN + + TEST ("CE3115A", "CHECK THAT RESETTING ONE OF A MULTIPLE OF " & + "INTERNAL FILES ASSOCIATED WITH THE SAME " & + "EXTERNAL FILE HAS NO EFFECT ON ANY OF THE " & + "OTHER INTERNAL FILES"); + + DECLARE + TXT_FILE_ONE : TEXT_IO.FILE_TYPE; + TXT_FILE_TWO : TEXT_IO.FILE_TYPE; + + CH : CHARACTER := 'A'; + + INCOMPLETE : EXCEPTION; + + PROCEDURE TXT_CLEANUP IS + FILE1_OPEN : BOOLEAN := IS_OPEN (TXT_FILE_ONE); + FILE2_OPEN : BOOLEAN := IS_OPEN (TXT_FILE_TWO); + BEGIN + IF FILE1_OPEN AND FILE2_OPEN THEN + CLOSE (TXT_FILE_TWO); + DELETE (TXT_FILE_ONE); + ELSIF FILE1_OPEN THEN + DELETE (TXT_FILE_ONE); + ELSIF FILE2_OPEN THEN + DELETE (TXT_FILE_TWO); + END IF; + EXCEPTION + WHEN TEXT_IO.USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED " & + "IN CLEANUP - 1"); + END TXT_CLEANUP; + + BEGIN + + BEGIN -- CREATE FIRST FILE + + CREATE (TXT_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME); + PUT (TXT_FILE_ONE, CH); + + EXCEPTION + WHEN TEXT_IO.USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; CREATE OF " & + "EXTERNAL FILENAME IS NOT " & + "SUPPORTED - 2"); + RAISE INCOMPLETE; + WHEN TEXT_IO.NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; CREATE OF " & + "EXTERNAL FILENAME IS NOT " & + "SUPPORTED - 3"); + RAISE INCOMPLETE; + + END; -- CREATE FIRST FILE + + BEGIN -- OPEN SECOND FILE + + OPEN (TXT_FILE_TWO, IN_FILE, LEGAL_FILE_NAME); + + EXCEPTION + + WHEN TEXT_IO.USE_ERROR => + NOT_APPLICABLE ("MULTIPLE INTERNAL FILES ARE NOT " & + "SUPPORTED WHEN ONE IS MODE " & + "OUT_FILE AND THE OTHER IS MODE " & + "IN_FILE - 4" & + " - USE_ERROR RAISED "); + TXT_CLEANUP; + RAISE INCOMPLETE; + + WHEN TEXT_IO.NAME_ERROR => + NOT_APPLICABLE ("MULTIPLE INTERNAL FILES ARE NOT " & + "SUPPORTED WHEN ONE IS MODE " & + "OUT_FILE AND THE OTHER IS MODE " & + "IN_FILE - 4" & + " - NAME_ERROR RAISED "); + TXT_CLEANUP; + RAISE INCOMPLETE; + + END; -- OPEN SECOND FILE + FLUSH (TXT_FILE_ONE); -- AVOID BUFFERING PROBLEMS. + + CH := 'B'; + GET (TXT_FILE_TWO, CH); + IF CH /= 'A' THEN + FAILED ("INCORRECT VALUE FOR GET - 5"); + END IF; + + BEGIN -- INITIALIZE FIRST FILE TO CHECK POINTER RESETTING + + RESET (TXT_FILE_ONE); + IF MODE (TXT_FILE_ONE) /= OUT_FILE THEN + FAILED ("FILE WAS NOT RESET - 6"); + END IF; + IF MODE (TXT_FILE_TWO) /= IN_FILE THEN + FAILED ("RESETTING OF ONE INTERNAL FILE " & + "AFFECTED THE OTHER INTERNAL FILE - 7"); + END IF; + + EXCEPTION + + WHEN TEXT_IO.USE_ERROR => + NOT_APPLICABLE ("RESETTING OF EXTERNAL FILE FOR " & + "OUT_FILE MODE IS " & + " NOT SUPPORTED - 8"); + TXT_CLEANUP; + RAISE INCOMPLETE; + + END; -- INITIALIZE FIRST FILE TO CHECK POINTER RESETTING + + -- PERFORM SOME I/O ON THE FIRST FILE + + PUT (TXT_FILE_ONE, 'C'); + PUT (TXT_FILE_ONE, 'D'); + PUT (TXT_FILE_ONE, 'E'); + CLOSE (TXT_FILE_ONE); + + BEGIN + OPEN (TXT_FILE_ONE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("MULTIPLE INTERNAL FILES NOT " & + "SUPPORTED WHEN BOTH FILES HAVE " & + "IN_FILE MODE - 9"); + RAISE INCOMPLETE; + END; + + GET (TXT_FILE_ONE, CH); + GET (TXT_FILE_ONE, CH); + + BEGIN -- INITIALIZE SECOND FILE AND PERFORM SOME I/O + + CLOSE (TXT_FILE_TWO); + OPEN (TXT_FILE_TWO, IN_FILE, LEGAL_FILE_NAME); + + EXCEPTION + + WHEN TEXT_IO.USE_ERROR => + FAILED ("MULTIPLE INTERNAL FILES SHOULD STILL " & + "BE ALLOWED - 10"); + TXT_CLEANUP; + RAISE INCOMPLETE; + + END; -- INITIALIZE SECOND FILE AND PERFORM SOME I/O + + BEGIN -- RESET FIRST FILE AND CHECK EFFECTS ON SECOND FILE + + GET (TXT_FILE_TWO, CH); + IF CH /= 'C' THEN + FAILED ("INCORRECT VALUE FOR GET OPERATION - 11"); + END IF; + + RESET (TXT_FILE_ONE); + GET (TXT_FILE_TWO, CH); + IF CH /= 'D' THEN + FAILED ("RESETTING INDEX OF ONE TEXT FILE " & + "RESETS THE OTHER ASSOCIATED FILE - 12"); + END IF; + + EXCEPTION + + WHEN TEXT_IO.USE_ERROR => + FAILED ("RESETTING SHOULD STILL BE SUPPORTED - 13"); + TXT_CLEANUP; + RAISE INCOMPLETE; + + END; -- RESET FIRST FILE AND CHECK EFFECTS ON SECOND FILE + + TXT_CLEANUP; + + EXCEPTION + + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3115A; -- cgit v1.2.3