diff options
| author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
|---|---|---|
| committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
| commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
| tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/ada/acats/tests/ce | |
| download | cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2 cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz | |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
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.
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/ce')
265 files changed, 35878 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102a.ada new file mode 100644 index 000000000..b784b87de --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102a.ada @@ -0,0 +1,133 @@ +-- CE2102A.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 TO SEE THAT STATUS_ERROR IS RAISED WHEN PERFORMING ILLEGAL +-- OPERATIONS ON OPENED OR UNOPENED FILES OF TYPE SEQUENTIAL_IO. + +-- A) OPENED FILES + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH OUT_FILE MODE FOR SEQUENTIAL FILES. + +-- HISTORY: +-- DLD 08/10/82 +-- JBG 02/22/84 +-- SPW 07/29/87 SPLIT CASE FOR UNOPENED FILES INTO CE2102L.ADA. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2102A IS + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER); + USE SEQ_IO; + TEST_FILE_ONE : SEQ_IO.FILE_TYPE; + +BEGIN + + TEST ("CE2102A", "CHECK THAT STATUS_ERROR IS RAISED WHEN " & + "PERFORMING ILLEGAL OPERATIONS ON OPENED FILES " & + "OF TYPE SEQUENTIAL_IO"); + + BEGIN + CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME); + +-- CHECK THAT OPEN STATEMENT RAISES EXCEPTION WHEN FILE IS ALREADY OPEN + + BEGIN + OPEN (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME); + FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " & + "ALREADY OPEN - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON OPEN - 1"); + END; + + BEGIN + OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME); + FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " & + "ALREADY OPEN - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON OPEN - 2"); + END; + +-- CHECK THAT CREATE STATEMENT RAISES EXCEPTION WHEN FILE +-- IS ALREADY OPEN + + BEGIN + CREATE (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " & + "FILE IS USED IN A CREATE - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON CREATE - 1"); + END; + + BEGIN + CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " & + "FILE IS USED IN A CREATE - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2"); + END; + +--DELETE TEST FILE + + BEGIN + DELETE (TEST_FILE_ONE); + EXCEPTION + WHEN USE_ERROR => + COMMENT ("DELETION OF EXTERNAL FILE APPEARS NOT " & + "TO BE SUPPORTED"); + + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED " & + "FOR DELETE"); + END; + + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED FOR CREATE " & + "WITH OUT_FILE MODE"); + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED FOR CREATE " & + "WITH OUT_FILE MODE"); + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR CREATE"); + END; + + RESULT; +END CE2102A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102b.ada new file mode 100644 index 000000000..98494c6cb --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102b.ada @@ -0,0 +1,155 @@ +-- CE2102B.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 TO SEE THAT STATUS_ERROR IS RAISED WHEN PERFORMING ILLEGAL +-- OPERATIONS ON OPENED OR UNOPENED FILES OF TYPE DIRECT_IO. + +-- A) OPENED FILES + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO THOSE IMPLEMENTATIONS WHICH +-- SUPPORT CREATE WITH OUT_FILE MODE FOR DIRECT FILES. + +-- HISTORY: +-- DLD 08/10/82 +-- SPS 11/03/82 +-- JBG 02/22/84 +-- SPW 08/13/87 SPLIT CASE FOR UNOPENED FILES INTO CE2102M.ADA. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2102B IS + + PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER); + USE DIR_IO; + TEST_FILE_ONE : DIR_IO.FILE_TYPE; + +BEGIN + + TEST ("CE2102B", "CHECK THAT STATUS_ERROR IS RAISED WHEN " & + "PERFORMING ILLEGAL OPERATIONS ON FILES " & + "OF TYPE DIRECT_IO"); + + BEGIN + CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME); + +-- CHECK THAT OPEN STATEMENT RAISES EXCEPTION WHEN FILE IS ALREADY OPEN + + BEGIN + OPEN (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME); + FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " & + "ALREADY OPEN - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON OPEN - 1"); + END; + + BEGIN + OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME); + FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " & + "ALREADY OPEN - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON OPEN - 2"); + END; + + BEGIN + OPEN (TEST_FILE_ONE, INOUT_FILE, LEGAL_FILE_NAME); + FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " & + "ALREADY OPEN - 3"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON OPEN - 3"); + END; + +-- CHECK THAT CREATE STATEMENT RAISES EXCEPTION WHEN FILE IS ALREADY +-- OPEN + + BEGIN + CREATE (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " & + "FILE IS USED IN A CREATE - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON CREATE - 1"); + END; + + BEGIN + CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " & + "FILE IS USED IN A CREATE - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2"); + END; + + BEGIN + CREATE (TEST_FILE_ONE, INOUT_FILE, LEGAL_FILE_NAME); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " & + "FILE IS USED IN A CREATE - 3"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON CREATE - 3"); + END; + +--DELETE TEST FILE + + BEGIN + DELETE (TEST_FILE_ONE); + EXCEPTION + WHEN USE_ERROR => + COMMENT ("DELETION OF EXTERNAL FILE APPEARS NOT " & + "TO BE SUPPORTED"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR DELETE"); + END; + + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED FOR CREATE " & + "WITH OUT_FILE MODE"); + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED FOR CREATE " & + "WITH OUT_FILE MODE"); + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR CREATE"); + END; + + RESULT; + +END CE2102B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102c.tst b/gcc/testsuite/ada/acats/tests/ce/ce2102c.tst new file mode 100644 index 000000000..11868bcca --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102c.tst @@ -0,0 +1,140 @@ +-- CE2102C.TST + +-- 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 NAME_ERROR IS RAISED WHEN THE NAME STRING DOES NOT +-- IDENTIFY AN EXTERNAL FILE FOR AN OPEN OR CREATE OPERATION FOR +-- SEQUENTIAL_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH OUT_FILE MODE FOR SEQUENTIAL TEMPORARY FILES. + +-- HISTORY: +-- SPS 08/26/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST. +-- JRK 11/30/84 CHANGED TO .TST TEST. +-- TBN 02/12/86 SPLIT TEST. PUT DIRECT_IO INTO CE2102H-B.TST. +-- SPW 08/25/87 CORRECTED EXCEPTION HANDLING. +-- BCB 09/28/88 ADDED EXCEPTION HANDLERS FOR DELETE STATEMENTS. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2102C IS + + NAME1 : CONSTANT STRING := "$ILLEGAL_EXTERNAL_FILE_NAME1"; + -- AN ILLEGAL EXTERNAL FILE NAME THAT EITHER (PREFERABLY) + -- CONTAINS INVALID CHARACTERS OR IS TOO LONG. + + NAME2 : CONSTANT STRING := "$ILLEGAL_EXTERNAL_FILE_NAME2"; + -- AN ILLEGAL EXTERNAL FILE NAME THAT EITHER (PREFERABLY) + -- CONTAINS A WILD CARD CHARACTER OR IS TOO LONG. + +BEGIN + + TEST ("CE2102C", "CHECK THAT NAME_ERROR IS RAISED BY OPEN AND " & + "CREATE WHEN NAME DOES NOT IDENTIFY AN " & + "EXTERNAL FILE FOR SEQUENTIAL_IO"); + + DECLARE + PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ; + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + BEGIN + +-- CHECK WHETHER CREATE RAISES USE_ERROR + + BEGIN + CREATE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("TEMPORARY SEQUENTIAL FILES WITH " & + "OUT_FILE MODE NOT SUPPORTED"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE"); + RAISE INCOMPLETE; + END; + CLOSE (FILE1); + + BEGIN + CREATE(FILE1, OUT_FILE, NAME1); + FAILED ("NAME_ERROR NOT RAISED - CREATE SEQ 1"); + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + EXCEPTION + WHEN NAME_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED - CREATE SEQ 1"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - CREATE SEQ 1"); + END; + + BEGIN + CREATE (FILE1, OUT_FILE, NAME2); + FAILED("NAME_ERROR NOT RAISED - CREATE SEQ 2"); + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + EXCEPTION + WHEN NAME_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED - CREATE SEQ 2"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - CREATE SEQ 2"); + END; + +-- CHECK WHETHER OPEN RAISES NAME_ERROR IN THE CASE OF A LEGAL FILE +-- NAME BUT A NON-EXISTENT FILE. + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + FAILED("NAME_ERROR NOT RAISED - OPEN SEQ"); + EXCEPTION + WHEN NAME_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED - OPEN SEQ"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - OPEN SEQ"); + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; +END CE2102C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102d.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102d.ada new file mode 100644 index 000000000..728eed108 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102d.ada @@ -0,0 +1,63 @@ +-- CE2102D.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 USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE +-- IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR CREATE BY THE +-- IMPLEMENTATION FOR SEQUENTIAL_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT IN_FILE FOR CREATE FOR SEQUENTIAL_IO. + +-- HISTORY: +-- TBN 07/23/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2102D IS +BEGIN + + TEST ("CE2102D", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " & + "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " & + "OF CREATE FOR SEQUENTIAL_IO"); + DECLARE + PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN); + USE SEQ; + FILE1 : FILE_TYPE; + BEGIN + CREATE (FILE1, IN_FILE); + CLOSE (FILE1); + NOT_APPLICABLE ("CREATE WITH MODE IN_FILE ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + END; + + RESULT; + +END CE2102D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102e.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102e.ada new file mode 100644 index 000000000..caaf3fd61 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102e.ada @@ -0,0 +1,66 @@ +-- CE2102E.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 USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE +-- OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR CREATE BY THE +-- IMPLEMENTATION FOR SEQUENTIAL_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT OUT_FILE FOR CREATE FOR SEQUENTIAL_IO. + +-- HISTORY: +-- SPS 08/26/82 +-- JBG 06/04/84 +-- EG 05/08/85 +-- TBN 07/23/87 COMPLETELY REVISED TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2102E IS +BEGIN + + TEST ("CE2102E", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " & + "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " & + "OF CREATE FOR SEQUENTIAL_IO"); + DECLARE + PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN); + USE SEQ; + FILE1 : FILE_TYPE; + BEGIN + CREATE (FILE1, OUT_FILE); + CLOSE (FILE1); + NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + END; + + RESULT; + +END CE2102E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102f.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102f.ada new file mode 100644 index 000000000..8d8328d42 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102f.ada @@ -0,0 +1,65 @@ +-- CE2102F.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 USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE +-- INOUT_FILE, WHEN INOUT_FILE MODE IS NOT SUPPORTED FOR CREATE BY +-- THE IMPLEMENTATION FOR DIRECT_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT INOUT_FILE FOR CREATE FOR DIRECT FILES. + +-- HISTORY: +-- SPS 08/26/82 +-- JBG 06/04/84 +-- TBN 07/23/87 COMPLETELY REVISED TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2102F IS +BEGIN + + TEST ("CE2102F", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " & + "INOUT_FILE IS NOT SUPPORTED FOR THE OPERATION " & + "OF CREATE FOR DIRECT_IO"); + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN); + USE DIR; + FILE1 : FILE_TYPE; + BEGIN + CREATE (FILE1, INOUT_FILE); + CLOSE (FILE1); + NOT_APPLICABLE ("CREATE WITH MODE INOUT_FILE ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + END; + + RESULT; + +END CE2102F; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102g.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102g.ada new file mode 100644 index 000000000..b5de4e617 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102g.ada @@ -0,0 +1,130 @@ +-- CE2102G.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 USE_ERROR IS RAISED IF AN IMPLEMENTATION DOES NOT +-- SUPPORT RESET FOR SEQUENTIAL_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES. + +-- HISTORY: +-- SPS 08/27/82 +-- JBG 06/04/84 +-- TBN 02/12/86 SPLIT TEST. PUT DIRECT_IO INTO CE2102K.ADA. +-- TBN 09/15/87 COMPLETELY REVISED TEST. + +WITH SEQUENTIAL_IO; +WITH REPORT; USE REPORT; +PROCEDURE CE2102G IS + INCOMPLETE : EXCEPTION; +BEGIN + TEST ("CE2102G", "CHECK THAT USE_ERROR IS RAISED IF AN " & + "IMPLEMENTATION DOES NOT SUPPORT RESET FOR " & + "SEQUENTIAL_IO"); + DECLARE + PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ; + FILE1 : FILE_TYPE; + INT1 : INTEGER := IDENT_INT(1); + INT2 : INTEGER := 2; + BEGIN + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE OF " & + "SEQUENTIAL FILE WITH OUT_FILE " & + "MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE OF " & + "SEQUENTIAL FILE WITH OUT_FILE " & + "MODE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, INT2); + BEGIN + RESET (FILE1, IN_FILE); + COMMENT ("RESET FROM OUT_FILE TO IN_FILE IS ALLOWED"); + BEGIN + READ (FILE1, INT1); + IF INT1 /= IDENT_INT(2) THEN + FAILED ("RESETTING FROM OUT_FILE TO IN_FILE " & + "AFFECTED DATA"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " & + "READING FROM FILE"); + END; + EXCEPTION + WHEN USE_ERROR => + COMMENT ("RESET FROM OUT_FILE TO IN_FILE IS NOT " & + "ALLOWED"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " & + "RESETTING FROM OUT_FILE TO IN_FILE"); + END; + + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPENING OF " & + "SEQUENTIAL FILE WITH IN_FILE " & + "MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (FILE1, OUT_FILE); + COMMENT ("RESET FROM IN_FILE TO OUT_FILE IS ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + COMMENT ("RESET FROM IN_FILE TO OUT_FILE IS NOT " & + "ALLOWED"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " & + "RESETTING FROM IN_FILE TO OUT_FILE"); + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; +END CE2102G; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102h.tst b/gcc/testsuite/ada/acats/tests/ce/ce2102h.tst new file mode 100644 index 000000000..ea265c034 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102h.tst @@ -0,0 +1,136 @@ +-- CE2102H.TST + +-- 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 NAME_ERROR IS RAISED WHEN THE NAME STRING DOES NOT +-- IDENTIFY AN EXTERNAL FILE FOR AN OPEN OR CREATE OPERATION FOR +-- DIRECT_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH INOUT_FILE MODE FOR TEMPORARY DIRECT FILES. + +-- HISTORY: +-- TBN 02/12/86 +-- SPW 08/26/87 CORRECTED EXCEPTION HANDLING. +-- BCB 09/28/88 ADDED EXCEPTION HANDLERS FOR DELETE STATEMENTS. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2102H IS + + NAME1 : CONSTANT STRING := "$ILLEGAL_EXTERNAL_FILE_NAME1"; + -- AN ILLEGAL EXTERNAL FILE NAME THAT EITHER (PREFERABLY) + -- CONTAINS INVALID CHARACTERS OR IS TOO LONG. + + NAME2 : CONSTANT STRING := "$ILLEGAL_EXTERNAL_FILE_NAME2"; + -- AN ILLEGAL EXTERNAL FILE NAME THAT EITHER (PREFERABLY) + -- CONTAINS A WILD CARD CHARACTER OR IS TOO LONG. + +BEGIN + + TEST ("CE2102H", "CHECK THAT NAME_ERROR IS RAISED BY OPEN AND " & + "CREATE WHEN NAME DOES NOT IDENTIFY AN " & + "EXTERNAL FILE FOR DIRECT_IO"); + + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + BEGIN + +-- CHECK WHETHER CREATE RAISES USE_ERROR + + BEGIN + CREATE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("TEMPORARY DIRECT FILES WITH " & + "INOUT_FILE MODE NOT SUPPORTED"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE"); + RAISE INCOMPLETE; + END; + CLOSE (FILE1); + + BEGIN + CREATE(FILE1, OUT_FILE, NAME1); + FAILED ("NAME_ERROR NOT RAISED - CREATE DIR 1"); + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + EXCEPTION + WHEN NAME_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED - CREATE DIR 1"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - CREATE DIR 1"); + END; + + BEGIN + CREATE (FILE1, OUT_FILE, NAME2); + FAILED("NAME_ERROR NOT RAISED - CREATE DIR 2"); + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + EXCEPTION + WHEN NAME_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED - CREATE DIR 2"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - CREATE DIR 2"); + END; + +-- CHECK WHETHER OPEN RAISES NAME_ERROR IN THE CASE OF A LEGAL FILE NAME +-- BUT A NON-EXISTENT FILE. + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + FAILED("NAME_ERROR NOT RAISED - OPEN DIR"); + EXCEPTION + WHEN NAME_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED - OPEN DIR"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - OPEN DIR"); + END; + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; +END CE2102H; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102i.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102i.ada new file mode 100644 index 000000000..43616c217 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102i.ada @@ -0,0 +1,63 @@ +-- CE2102I.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 USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE +-- IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR CREATE BY +-- THE IMPLEMENTATION FOR DIRECT_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT IN_FILE FOR CREATE FOR DIRECT FILES. + +-- HISTORY: +-- TBN 07/23/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2102I IS +BEGIN + + TEST ("CE2102I", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " & + "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " & + "OF CREATE FOR DIRECT_IO"); + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN); + USE DIR; + FILE1 : FILE_TYPE; + BEGIN + CREATE (FILE1, IN_FILE); + CLOSE (FILE1); + NOT_APPLICABLE ("CREATE WITH MODE IN_FILE ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + END; + + RESULT; + +END CE2102I; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102j.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102j.ada new file mode 100644 index 000000000..efe08a689 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102j.ada @@ -0,0 +1,66 @@ +-- CE2102J.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 USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE +-- OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR CREATE BY +-- THE IMPLEMENTATION FOR DIRECT_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT OUT_FILE FOR CREATE FOR DIRECT FILES. + +-- HISTORY: +-- SPS 08/26/82 +-- JBG 06/04/84 +-- EG 05/08/85 +-- TBN 07/23/87 COMPLETELY REVISED TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2102J IS +BEGIN + + TEST ("CE2102J", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " & + "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " & + "OF CREATE FOR DIRECT_IO"); + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN); + USE DIR; + FILE1 : FILE_TYPE; + BEGIN + CREATE (FILE1, OUT_FILE); + CLOSE (FILE1); + NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + END; + + RESULT; + +END CE2102J; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102k.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102k.ada new file mode 100644 index 000000000..fed673f27 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102k.ada @@ -0,0 +1,248 @@ +-- CE2102K.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 USE_ERROR IS RAISED IF AN IMPLEMENTATION DOES NOT +-- SUPPORT RESET FOR DIRECT_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- DIRECT FILES. + +-- HISTORY: +-- TBN 02/12/86 CREATED ORIGINAL TEST. +-- TBN 09/15/87 COMPLETELY REVISED TEST. + +WITH DIRECT_IO; +WITH REPORT; USE REPORT; +PROCEDURE CE2102K IS + INCOMPLETE : EXCEPTION; +BEGIN + TEST ("CE2102K", "CHECK THAT USE_ERROR IS RAISED IF AN " & + "IMPLEMENTATION DOES NOT SUPPORT RESET FOR " & + "DIRECT_IO"); + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + FILE1 : FILE_TYPE; + INT1 : INTEGER := IDENT_INT(1); + INT2 : INTEGER := 2; + BEGIN + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE OF " & + "DIRECT FILE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE OF " & + "DIRECT FILE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, INT2); + + -- RESETTING FROM OUT_FILE TO IN_FILE. + + BEGIN + RESET (FILE1, IN_FILE); + COMMENT ("RESET FROM OUT_FILE TO IN_FILE IS ALLOWED"); + BEGIN + READ (FILE1, INT1); + IF INT1 /= IDENT_INT(2) THEN + FAILED ("RESETTING FROM OUT_FILE TO IN_FILE " & + "AFFECTED DATA"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " & + "READING FROM FILE - 1"); + END; + EXCEPTION + WHEN USE_ERROR => + COMMENT ("RESET FROM OUT_FILE TO IN_FILE IS NOT " & + "ALLOWED"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " & + "RESETTING FROM OUT_FILE TO IN_FILE"); + END; + + CLOSE (FILE1); + + -- RESETTING FROM OUT_FILE TO INOUT_FILE. + + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME(2)); + + WRITE (FILE1, INT2); + BEGIN + RESET (FILE1, INOUT_FILE); + COMMENT ("RESET FROM OUT_FILE TO INOUT_FILE IS ALLOWED"); + BEGIN + READ (FILE1, INT1); + IF INT1 /= IDENT_INT(2) THEN + FAILED ("RESETTING FROM OUT_FILE TO " & + "INOUT_FILE AFFECTED DATA"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " & + "READING FROM FILE - 2"); + END; + EXCEPTION + WHEN USE_ERROR => + COMMENT ("RESET FROM OUT_FILE TO INOUT_FILE IS " & + "NOT ALLOWED"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " & + "RESETTING FROM OUT_FILE TO INOUT_FILE"); + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + -- RESETTING FROM IN_FILE TO OUT_FILE. + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPENING OF " & + "DIRECT FILE WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (FILE1, OUT_FILE); + COMMENT ("RESET FROM IN_FILE TO OUT_FILE IS ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + COMMENT ("RESET FROM IN_FILE TO OUT_FILE IS NOT " & + "ALLOWED"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " & + "RESETTING FROM IN_FILE TO OUT_FILE"); + END; + + CLOSE (FILE1); + + -- RESETTING FROM IN_FILE TO INOUT_FILE. + + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + + BEGIN + RESET (FILE1, INOUT_FILE); + COMMENT ("RESET FROM IN_FILE TO INOUT_FILE IS ALLOWED"); + BEGIN + READ (FILE1, INT1); + IF INT1 /= IDENT_INT(2) THEN + FAILED ("RESETTING FROM IN_FILE TO " & + "INOUT_FILE AFFECTED DATA"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " & + "READING FROM FILE - 3"); + END; + EXCEPTION + WHEN USE_ERROR => + COMMENT ("RESET FROM IN_FILE TO INOUT_FILE IS " & + "NOT ALLOWED"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " & + "RESETTING FROM IN_FILE TO INOUT_FILE"); + END; + + CLOSE (FILE1); + + -- RESETTING FROM INOUT_FILE TO IN_FILE. + + BEGIN + OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPENING OF " & + "DIRECT FILE WITH INOUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (FILE1, IN_FILE); + COMMENT ("RESET FROM INOUT_FILE TO IN_FILE IS ALLOWED"); + BEGIN + READ (FILE1, INT1); + IF INT1 /= IDENT_INT(2) THEN + FAILED ("RESETTING FROM INOUT_FILE TO " & + "IN_FILE AFFECTED DATA"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " & + "READING FROM FILE - 2"); + END; + EXCEPTION + WHEN USE_ERROR => + COMMENT ("RESET FROM INOUT_FILE TO IN_FILE IS " & + "NOT ALLOWED"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " & + "RESETTING FROM INOUT_FILE TO IN_FILE"); + END; + + CLOSE (FILE1); + + -- RESETTING FROM INOUT_FILE TO OUT_FILE. + + OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME); + + BEGIN + RESET (FILE1, OUT_FILE); + COMMENT ("RESET FROM INOUT_FILE TO OUT_FILE IS ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + COMMENT ("RESET FROM INOUT_FILE TO OUT_FILE IS " & + "NOT ALLOWED"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " & + "RESETTING FROM INOUT_FILE TO OUT_FILE"); + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; +END CE2102K; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102l.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102l.ada new file mode 100644 index 000000000..81d86633d --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102l.ada @@ -0,0 +1,147 @@ +-- CE2102L.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 TO SEE THAT STATUS_ERROR IS RAISED WHEN PERFORMING ILLEGAL +-- OPERATIONS ON OPENED OR UNOPENED FILES OF TYPE SEQUENTIAL_IO. + +-- B) UNOPENED FILES + +-- HISTORY: +-- SPW 07/29/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2102L IS + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER); + USE SEQ_IO; + + TEST_FILE_ONE : SEQ_IO.FILE_TYPE; + STR : STRING (1 .. 10); + FL_MODE : SEQ_IO.FILE_MODE ; + +BEGIN + + TEST ("CE2102L", "CHECK THAT STATUS_ERROR IS RAISED WHEN " & + "PERFORMING ILLEGAL OPERATIONS ON UNOPENED " & + "FILES OF TYPE SEQUENTIAL_IO"); + +-- CHECK TO SEE THAT PROPER EXCEPTIONS ARE RAISED WHEN +-- PERFORMING OPERATIONS ON AN UNOPENED FILE + +-- CLOSE AN UNOPENED FILE + + BEGIN + CLOSE (TEST_FILE_ONE); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED " & + "FILE IS USED IN A CLOSE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON CLOSE"); + END; + +-- DELETE AN UNOPENED FILE + + BEGIN + DELETE (TEST_FILE_ONE); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED " & + "FILE IS USED IN A DELETE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON DELETE"); + END; + +-- RESET UNOPENED FILE + + BEGIN + RESET (TEST_FILE_ONE); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED " & + "FILE IS USED IN A RESET"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON RESET"); + END; + + BEGIN + RESET (TEST_FILE_ONE, IN_FILE); + FAILED ("STATUS_ERROR NOT RAISED WHEN A UNOPENED FILE " & + "IS USED IN A RESET WITH MODE PARAMETER"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON RESET " & + "WITH MODE"); + END; + +-- ATTEMPT TO DETERMINE MODE OF UNOPENED FILE + + BEGIN + FL_MODE := MODE (TEST_FILE_ONE); + FAILED ("STATUS_ERROR NOT RAISED WHEN A UNOPENED " & + "FILE IS USED IN A MODE OPERATION"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON MODE"); + END; + +-- ATTEMPT TO DETERMINE NAME OF UNOPENED FILE + + BEGIN + STR := NAME (TEST_FILE_ONE); + FAILED ("STATUS_ERROR NOT RAISED WHEN A UNOPENED " & + "FILE IS USED IN A NAME OPERATION"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON NAME"); + END; + +--ATTEMPT TO DETERMINE FORM OF UNOPENED FILE + + BEGIN + STR := FORM (TEST_FILE_ONE); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED " & + "FILE IS USED IN A FORM OPERATION"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON FORM"); + END; + + RESULT; + +END CE2102L; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102m.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102m.ada new file mode 100644 index 000000000..8ea79cf9b --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102m.ada @@ -0,0 +1,146 @@ +-- CE2102M.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 TO SEE THAT STATUS_ERROR IS RAISED WHEN PERFORMING ILLEGAL +-- OPERATIONS ON OPENED OR UNOPENED FILES OF TYPE DIRECT_IO. + +-- B) UNOPENED FILES + +-- HISTORY: +-- SPW 02/24/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2102M IS + + PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER); + USE DIR_IO; + + TEST_FILE_ONE : DIR_IO.FILE_TYPE; + STR : STRING (1 .. 10); + FL_MODE : DIR_IO.FILE_MODE ; + +BEGIN + + TEST ("CE2102M", "CHECK THAT STATUS_ERROR IS RAISED WHEN " & + "PERFORMING ILLEGAL OPERATIONS ON UNOPENED " & + "FILES OF TYPE DIRECT_IO"); + +-- CHECK TO SEE THAT PROPER EXCEPTIONS ARE RAISED WHEN +-- PERFORMING OPERATIONS ON AN UNOPENED FILE + +-- CLOSE AN UNOPENED FILE + + BEGIN + CLOSE (TEST_FILE_ONE); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " & + "IS USED IN A CLOSE OPERATION"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON CLOSE"); + END; + +-- DELETE AN UNOPENED FILE + + BEGIN + DELETE (TEST_FILE_ONE); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " & + "IS USED IN A DELETE OPERATION"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON DELETE"); + END; + +-- RESET UNOPENED FILE + + BEGIN + RESET (TEST_FILE_ONE); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " & + "IS USED IN A RESET"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON RESET"); + END; + + BEGIN + RESET (TEST_FILE_ONE, IN_FILE); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " & + "IS USED IN A RESET WITH MODE PARAMETER"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON RESET WITH " & + "MODE PARAMETER"); + END; + +-- ATTEMPT TO DETERMINE MODE OF UNOPENED FILE + + BEGIN + FL_MODE := MODE (TEST_FILE_ONE); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " & + "IS USED IN A MODE OPERATION"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON MODE"); + END; + +-- ATTEMPT TO DETERMINE NAME OF UNOPENED FILE + + BEGIN + STR := NAME (TEST_FILE_ONE); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " & + "IS USED IN A NAME OPERATION"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON NAME"); + END; + +--ATTEMPT TO DETERMINE FORM OF UNOPENED FILE + + BEGIN + STR := FORM (TEST_FILE_ONE); + FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " & + "IS USED IN A FORM OPERATION"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON FORM"); + END; + + RESULT; +END CE2102M; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102n.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102n.ada new file mode 100644 index 000000000..c7b6414c7 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102n.ada @@ -0,0 +1,98 @@ +-- CE2102N.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 USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE +-- IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE +-- IMPLEMENTATION FOR SEQUENTIAL_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT OPEN WITH IN_FILE MODE FOR SEQUENTIAL FILES. + +-- HISTORY: +-- TBN 07/23/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2102N IS +BEGIN + + TEST ("CE2102N", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " & + "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " & + "OF OPEN FOR SEQUENTIAL FILES"); + DECLARE + PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN); + USE SEQ; + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + VAR1 : BOOLEAN := FALSE; + BEGIN + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, VAR1); + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + NOT_APPLICABLE ("OPEN FOR IN_FILE MODE ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + END; + + IF IS_OPEN (FILE1) THEN + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END IF; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2102N; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102o.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102o.ada new file mode 100644 index 000000000..699ffa73c --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102o.ada @@ -0,0 +1,117 @@ +-- CE2102O.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 USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE +-- IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR RESET BY THE +-- IMPLEMENTATION FOR SEQUENTIAL FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT RESET WITH IN_FILE MODE FOR SEQUENTIAL FILES. + +-- HISTORY: +-- TBN 07/23/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2102O IS +BEGIN + + TEST ("CE2102O", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " & + "A FILE OF MODE IN_FILE, WHEN IN_FILE MODE IS " & + "NOT SUPPORTED FOR RESET BY THE IMPLEMENTATION " & + "FOR SEQUENTIAL FILES"); + + DECLARE + PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN); + USE SEQ; + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + VAR1 : BOOLEAN := FALSE; + BEGIN + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, VAR1); + CLOSE (FILE1); + + BEGIN + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN WITH IN_FILE MODE NOT " & + "SUPPORTED"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (FILE1); + NOT_APPLICABLE ("RESET FOR IN_FILE MODE IS " & + "SUPPORTED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "RESET"); + END; + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2102O; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102p.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102p.ada new file mode 100644 index 000000000..f5db1c99a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102p.ada @@ -0,0 +1,98 @@ +-- CE2102P.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 USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE +-- OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE +-- IMPLEMENTATION FOR SEQUENTIAL_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT OPEN WITH OUT_FILE MODE FOR SEQUENTIAL FILES. + +-- HISTORY: +-- TBN 07/23/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2102P IS +BEGIN + + TEST ("CE2102P", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " & + "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " & + "OF OPEN FOR SEQUENTIAL FILES"); + DECLARE + PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN); + USE SEQ; + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + VAR1 : BOOLEAN := FALSE; + BEGIN + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, VAR1); + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, OUT_FILE, LEGAL_FILE_NAME); + NOT_APPLICABLE ("OPEN FOR OUT_FILE MODE ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + END; + + IF IS_OPEN (FILE1) THEN + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END IF; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2102P; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102q.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102q.ada new file mode 100644 index 000000000..af7fbe564 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102q.ada @@ -0,0 +1,97 @@ +-- CE2102Q.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 USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE +-- OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR RESET BY THE +-- IMPLEMENTATION FOR SEQUENTIAL FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT RESET WITH OUT_FILE MODE FOR SEQUENTIAL FILES. + +-- HISTORY: +-- TBN 07/23/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2102Q IS +BEGIN + + TEST ("CE2102Q", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " & + "A FILE OF MODE OUT_FILE, WHEN OUT_FILE MODE " & + "IS NOT SUPPORTED FOR RESET BY THE " & + "IMPLEMENTATION FOR SEQUENTIAL FILES"); + + DECLARE + PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN); + USE SEQ; + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + VAR1 : BOOLEAN := FALSE; + BEGIN + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, VAR1); + + BEGIN + RESET (FILE1); + NOT_APPLICABLE ("RESET FOR OUT_FILE MODE IS SUPPORTED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON RESET"); + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2102Q; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102r.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102r.ada new file mode 100644 index 000000000..8ec6c9ec2 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102r.ada @@ -0,0 +1,98 @@ +-- CE2102R.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 USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE +-- INOUT_FILE, WHEN INOUT_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE +-- IMPLEMENTATION FOR DIRECT FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT OPEN WITH INOUT_FILE MODE FOR DIRECT FILES. + +-- HISTORY: +-- TBN 07/23/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2102R IS +BEGIN + + TEST ("CE2102R", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " & + "INOUT_FILE IS NOT SUPPORTED FOR THE OPERATION " & + "OF OPEN FOR DIRECT FILES"); + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN); + USE DIR; + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + VAR1 : BOOLEAN := FALSE; + BEGIN + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, VAR1); + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME); + NOT_APPLICABLE ("OPEN FOR INOUT_FILE MODE ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + END; + + IF IS_OPEN (FILE1) THEN + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END IF; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2102R; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102s.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102s.ada new file mode 100644 index 000000000..030ce4925 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102s.ada @@ -0,0 +1,98 @@ +-- CE2102S.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 USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE +-- INOUT_FILE, WHEN INOUT_FILE MODE IS NOT SUPPORTED FOR RESET BY +-- THE IMPLEMENTATION FOR DIRECT FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT RESET WITH INOUT_FILE MODE FOR DIRECT FILES. + +-- HISTORY: +-- TBN 07/23/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2102S IS +BEGIN + + TEST ("CE2102S", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " & + "A FILE OF MODE INOUT_FILE, WHEN INOUT_FILE " & + "MODE IS NOT SUPPORTED FOR RESET BY THE " & + "IMPLEMENTATION FOR DIRECT FILES"); + + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN); + USE DIR; + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + VAR1 : BOOLEAN := FALSE; + BEGIN + BEGIN + CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " & + "INOUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " & + "INOUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, VAR1); + + BEGIN + RESET (FILE1); + NOT_APPLICABLE ("RESET FOR INOUT_FILE MODE IS " & + "SUPPORTED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON RESET"); + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2102S; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102t.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102t.ada new file mode 100644 index 000000000..b97ad627a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102t.ada @@ -0,0 +1,98 @@ +-- CE2102T.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 USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE +-- IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE +-- IMPLEMENTATION FOR DIRECT FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT OPEN WITH IN_FILE MODE FOR DIRECT FILES. + +-- HISTORY: +-- TBN 07/23/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2102T IS +BEGIN + + TEST ("CE2102T", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " & + "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " & + "OF OPEN FOR DIRECT FILES"); + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN); + USE DIR; + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + VAR1 : BOOLEAN := FALSE; + BEGIN + BEGIN + CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " & + "INOUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " & + "INOUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, VAR1); + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + NOT_APPLICABLE ("OPEN FOR IN_FILE MODE ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + END; + + IF IS_OPEN (FILE1) THEN + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END IF; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2102T; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102u.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102u.ada new file mode 100644 index 000000000..0a9d946f2 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102u.ada @@ -0,0 +1,117 @@ +-- CE2102U.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 USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE +-- IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR RESET BY +-- THE IMPLEMENTATION FOR DIRECT FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT RESET WITH IN_FILE MODE FOR DIRECT FILES. + +-- HISTORY: +-- TBN 07/23/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2102U IS +BEGIN + + TEST ("CE2102U", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " & + "A FILE OF MODE IN_FILE, WHEN IN_FILE " & + "MODE IS NOT SUPPORTED FOR RESET BY THE " & + "IMPLEMENTATION FOR DIRECT FILES"); + + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN); + USE DIR; + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + VAR1 : BOOLEAN := FALSE; + BEGIN + BEGIN + CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " & + "INOUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " & + "INOUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, VAR1); + CLOSE (FILE1); + + BEGIN + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN WITH IN_FILE MODE " & + "NOT SUPPORTED"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (FILE1); + NOT_APPLICABLE ("RESET FOR IN_FILE MODE IS " & + "SUPPORTED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "RESET"); + END; + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2102U; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102v.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102v.ada new file mode 100644 index 000000000..423200263 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102v.ada @@ -0,0 +1,98 @@ +-- CE2102V.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 USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE +-- OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE +-- IMPLEMENTATION FOR DIRECT FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT OPEN WITH OUT_FILE MODE FOR DIRECT FILES. + +-- HISTORY: +-- TBN 07/23/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2102V IS +BEGIN + + TEST ("CE2102V", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " & + "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " & + "OF OPEN FOR DIRECT FILES"); + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN); + USE DIR; + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + VAR1 : BOOLEAN := FALSE; + BEGIN + BEGIN + CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " & + "INOUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " & + "INOUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, VAR1); + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, OUT_FILE, LEGAL_FILE_NAME); + NOT_APPLICABLE ("OPEN FOR OUT_FILE MODE ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + END; + + IF IS_OPEN (FILE1) THEN + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END IF; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2102V; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102w.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102w.ada new file mode 100644 index 000000000..5239f0bc7 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102w.ada @@ -0,0 +1,98 @@ +-- CE2102W.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 USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE +-- OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR RESET BY +-- THE IMPLEMENTATION FOR DIRECT FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT RESET WITH OUT_FILE MODE FOR DIRECT FILES. + +-- HISTORY: +-- TBN 07/23/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2102W IS +BEGIN + + TEST ("CE2102W", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " & + "A FILE OF MODE OUT_FILE, WHEN OUT_FILE " & + "MODE IS NOT SUPPORTED FOR RESET BY THE " & + "IMPLEMENTATION FOR DIRECT FILES"); + + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN); + USE DIR; + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + VAR1 : BOOLEAN := FALSE; + BEGIN + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, VAR1); + + BEGIN + RESET (FILE1); + NOT_APPLICABLE ("RESET FOR OUT_FILE MODE IS " & + "SUPPORTED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON RESET"); + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2102W; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102x.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102x.ada new file mode 100644 index 000000000..8f56ac55a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102x.ada @@ -0,0 +1,85 @@ +-- CE2102X.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 USE_ERROR IS RAISED IF AN IMPLEMENTATION DOES NOT +-- SUPPORT DELETION OF AN EXTERNAL SEQUENTIAL FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF A SEQUENTIAL FILE WITH OUT_FILE MODE. + +-- HISTORY: +-- TBN 09/15/87 CREATED ORIGINAL TEST. + +WITH SEQUENTIAL_IO; +WITH REPORT; USE REPORT; +PROCEDURE CE2102X IS + INCOMPLETE : EXCEPTION; +BEGIN + TEST ("CE2102X", "CHECK THAT USE_ERROR IS RAISED IF AN " & + "IMPLEMENTATION DOES NOT SUPPORT DELETION " & + "OF AN EXTERNAL SEQUENTIAL FILE"); + DECLARE + PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ; + FILE1 : FILE_TYPE; + INT1 : INTEGER := IDENT_INT(1); + BEGIN + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE OF " & + "SEQUENTIAL FILE WITH OUT_FILE " & + "MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE OF " & + "SEQUENTIAL FILE WITH OUT_FILE " & + "MODE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, INT1); + BEGIN + DELETE (FILE1); + COMMENT ("DELETION OF AN EXTERNAL SEQUENTIAL FILE IS " & + "ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + COMMENT ("DELETION OF AN EXTERNAL SEQUENTIAL " & + "FILE IS NOT ALLOWED"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " & + "DELETING AN EXTERNAL FILE"); + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; +END CE2102X; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2102y.ada b/gcc/testsuite/ada/acats/tests/ce/ce2102y.ada new file mode 100644 index 000000000..e6ae6d3d1 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2102y.ada @@ -0,0 +1,83 @@ +-- CE2102Y.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 USE_ERROR IS RAISED IF AN IMPLEMENTATION DOES NOT +-- SUPPORT DELETION OF AN EXTERNAL DIRECT FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF A DIRECT FILE WITH OUT_FILE MODE. + +-- HISTORY: +-- TBN 09/15/87 CREATED ORIGINAL TEST. + +WITH DIRECT_IO; +WITH REPORT; USE REPORT; +PROCEDURE CE2102Y IS + INCOMPLETE : EXCEPTION; +BEGIN + TEST ("CE2102Y", "CHECK THAT USE_ERROR IS RAISED IF AN " & + "IMPLEMENTATION DOES NOT SUPPORT DELETION " & + "OF AN EXTERNAL DIRECT FILE"); + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + FILE1 : FILE_TYPE; + INT1 : INTEGER := IDENT_INT(1); + BEGIN + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE OF " & + "DIRECT FILE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE OF " & + "DIRECT FILE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, INT1); + BEGIN + DELETE (FILE1); + COMMENT ("DELETION OF AN EXTERNAL DIRECT FILE IS " & + "ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + COMMENT ("DELETION OF AN EXTERNAL DIRECT " & + "FILE IS NOT ALLOWED"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " & + "DELETING AN EXTERNAL FILE"); + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; +END CE2102Y; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2103a.tst b/gcc/testsuite/ada/acats/tests/ce/ce2103a.tst new file mode 100644 index 000000000..6a6d21a59 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2103a.tst @@ -0,0 +1,142 @@ +-- CE2103A.TST + +-- 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 IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF +-- TYPE SEQUENTIAL_IO. + +-- A) UNOPENED FILES + +-- HISTORY: +-- DLD 08/10/82 +-- SPS 11/09/82 +-- JBG 03/24/83 +-- EG 06/03/85 +-- SPW 08/10/87 SPLIT CASE FOR OPENED FILES INTO CE2103C.ADA. +-- PWB 03/07/97 ADDED CHECK FOR FILE SUPPORT. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2103A IS + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(CHARACTER); + USE SEQ_IO; + + TEST_FILE_ZERO : SEQ_IO.FILE_TYPE; + TEST_FILE_ONE : SEQ_IO.FILE_TYPE; + TEST_FILE_TWO : SEQ_IO.FILE_TYPE; + TEST_FILE_THREE : SEQ_IO.FILE_TYPE; + TEST_FILE_FOUR : SEQ_IO.FILE_TYPE; + VAL : BOOLEAN; + + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2103A", "CHECK THAT IS_OPEN RETURNS THE PROPER " & + "VALUES FOR UNOPENED FILES OF TYPE " & + "SEQUENTIAL_IO"); + +-- FIRST TEST WHETHER IMPLEMENTATION SUPPORTS SEQUENTIAL FILES AT ALL + + BEGIN + SEQ_IO.CREATE ( TEST_FILE_ZERO, + SEQ_IO.OUT_FILE, + REPORT.LEGAL_FILE_NAME ); + EXCEPTION + WHEN SEQ_IO.USE_ERROR | SEQ_IO.NAME_ERROR => + REPORT.NOT_APPLICABLE + ( "SEQUENTIAL FILES NOT SUPPORTED -- CREATE OUT-FILE" ); + RAISE INCOMPLETE; + END; + SEQ_IO.DELETE ( TEST_FILE_ZERO ); + +-- WHEN FILE IS DECLARED BUT NOT OPEN + + BEGIN + VAL := TRUE; + VAL := IS_OPEN (TEST_FILE_ONE); + IF VAL = TRUE THEN + FAILED ("FILE NOT OPEN BUT IS_OPEN RETURNS TRUE"); + END IF; + END; + +-- FOLLOWING UNSUCCESSFUL CREATE + + BEGIN + VAL := TRUE; + CREATE (TEST_FILE_TWO, OUT_FILE, + "$ILLEGAL_EXTERNAL_FILE_NAME1"); + FAILED ("NAME_ERROR NOT RAISED - UNSUCCESSFUL CREATE"); + EXCEPTION + WHEN NAME_ERROR => + VAL := IS_OPEN (TEST_FILE_TWO); + IF VAL = TRUE THEN + FAILED ("IS_OPEN GIVES TRUE AFTER AN " & + "UNSUCCESSFUL CREATE"); + END IF; + END; + +-- FOLLOWING UNSUCCESSFUL OPEN + + BEGIN + VAL := TRUE; + OPEN (TEST_FILE_THREE, IN_FILE, + "$ILLEGAL_EXTERNAL_FILE_NAME1"); + FAILED ("NAME_ERROR NOT RAISED - UNSUCCESSFUL OPEN"); + EXCEPTION + WHEN NAME_ERROR => + VAL := IS_OPEN (TEST_FILE_THREE); + IF VAL = TRUE THEN + FAILED ("IS_OPEN GIVES TRUE - UNSUCCESSFUL OPEN"); + END IF; + END; + +-- FOLLOWING CLOSING FILE THAT IS NOT OPEN + + BEGIN + VAL := TRUE; + CLOSE (TEST_FILE_FOUR); + FAILED ("STATUS ERROR NOT RAISED WHEN " & + "ATTEMPTING TO CLOSE AN UNOPENED FILE"); + EXCEPTION + WHEN STATUS_ERROR => + VAL := IS_OPEN (TEST_FILE_FOUR); + IF VAL = TRUE THEN + FAILED ("IS_OPEN GIVES TRUE AFTER ATTEMPTING " & + "TO CLOSE AN UNOPENED FILE"); + END IF; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + NULL; + REPORT.RESULT; + WHEN OTHERS => + REPORT.FAILED ( "UNEXPECTED EXCEPTION" ); + REPORT.RESULT; +END CE2103A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2103b.tst b/gcc/testsuite/ada/acats/tests/ce/ce2103b.tst new file mode 100644 index 000000000..2bcd7ad0b --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2103b.tst @@ -0,0 +1,141 @@ +-- CE2103B.TST + +-- 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 IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF +-- TYPE DIRECT_IO. + +-- A) UNOPENED FILES + +-- HISTORY: +-- DLD 08/10/82 +-- SPS 11/09/82 +-- JBG 03/24/83 +-- EG 06/03/85 +-- SPW 08/13/87 SPLIT CASE FOR OPEN FILES INTO CE2103D.ADA. +-- PWB 03/07/97 ADDED CHECK FOR FILE SUPPORT. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2103B IS + + PACKAGE DIR_IO IS NEW DIRECT_IO(CHARACTER); + USE DIR_IO; + + TEST_FILE_ZERO : DIR_IO.FILE_TYPE; + TEST_FILE_ONE : DIR_IO.FILE_TYPE; + TEST_FILE_TWO : DIR_IO.FILE_TYPE; + TEST_FILE_THREE : DIR_IO.FILE_TYPE; + TEST_FILE_FOUR : DIR_IO.FILE_TYPE; + VAL : BOOLEAN; + + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2103B", "CHECK THAT IS_OPEN RETURNS THE PROPER " & + "VALUES FOR UNOPENED FILES OF TYPE DIRECT_IO"); + +-- FIRST TEST WHETHER IMPLEMENTATION SUPPORTS DIRECT FILES AT ALL + + BEGIN + DIR_IO.CREATE ( TEST_FILE_ZERO, + DIR_IO.OUT_FILE, + REPORT.LEGAL_FILE_NAME ); + EXCEPTION + WHEN DIR_IO.USE_ERROR | DIR_IO.NAME_ERROR => + REPORT.NOT_APPLICABLE + ( "DIRECT FILES NOT SUPPORTED -- CREATE OUT-FILE" ); + RAISE INCOMPLETE; + END; + DIR_IO.DELETE ( TEST_FILE_ZERO ); + +-- WHEN FILE IS DECLARED BUT NOT OPEN + + BEGIN + VAL := TRUE; + VAL := IS_OPEN (TEST_FILE_ONE); + IF VAL = TRUE THEN + FAILED ("FILE NOT OPEN BUT IS_OPEN RETURNS TRUE"); + END IF; + END; + +-- FOLLOWING UNSUCCESSFUL CREATE + + BEGIN + VAL := TRUE; + CREATE (TEST_FILE_TWO, OUT_FILE, + "$ILLEGAL_EXTERNAL_FILE_NAME1"); + FAILED ("NAME_ERROR NOT RAISED - UNSUCCESSFUL CREATE"); + EXCEPTION + WHEN NAME_ERROR => + VAL := IS_OPEN (TEST_FILE_TWO); + IF VAL = TRUE THEN + FAILED ("IS_OPEN GIVES TRUE AFTER AN " & + "UNSUCCESSFUL CREATE"); + END IF; + END; + +-- FOLLOWING UNSUCCESSFUL OPEN + + BEGIN + VAL := TRUE; + OPEN (TEST_FILE_THREE, IN_FILE, + "$ILLEGAL_EXTERNAL_FILE_NAME2"); + FAILED ("NAME_ERROR NOT RAISED - UNSUCCESSFUL OPEN"); + EXCEPTION + WHEN NAME_ERROR => + VAL := IS_OPEN (TEST_FILE_THREE); + IF VAL = TRUE THEN + FAILED ("IS_OPEN GIVES TRUE - UNSUCCESSFUL OPEN"); + END IF; + END; + +-- FOLLOWING CLOSING FILE THAT IS NOT OPEN + + BEGIN + VAL := TRUE; + CLOSE (TEST_FILE_FOUR); + FAILED ("STATUS ERROR NOT RAISED WHEN ATTEMPTING " & + "CLOSE AN UNOPENED FILE"); + EXCEPTION + WHEN STATUS_ERROR => + VAL := IS_OPEN (TEST_FILE_FOUR); + IF VAL = TRUE THEN + FAILED ("IS_OPEN GIVES TRUE AFTER ATTEMPTING " & + "TO CLOSE AN UNOPENED FILE"); + END IF; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + NULL; + REPORT.RESULT; + WHEN OTHERS => + REPORT.FAILED ( "UNEXPECTED EXCEPTION" ); + REPORT.RESULT; +END CE2103B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2103c.ada b/gcc/testsuite/ada/acats/tests/ce/ce2103c.ada new file mode 100644 index 000000000..2f70f3cb9 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2103c.ada @@ -0,0 +1,149 @@ +-- CE2103C.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 IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF +-- TYPE SEQUENTIAL_IO. + +-- B) OPENED FILES + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES. + +-- HISTORY: +-- SPW 08/10/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2103C IS + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(CHARACTER); + USE SEQ_IO; + INCOMPLETE : EXCEPTION; + TEST_FILE_ONE : SEQ_IO.FILE_TYPE; + VAL : BOOLEAN; + +BEGIN + + TEST ("CE2103C", "CHECK THAT IS_OPEN RETURNS THE PROPER " & + "VALUES FOR FILES OF TYPE SEQUENTIAL_IO"); + +-- FOLLOWING A CREATE + + VAL := FALSE; + + BEGIN + CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + VAL := IS_OPEN (TEST_FILE_ONE); + + IF VAL = FALSE THEN + FAILED ("IS_OPEN RETURNS FALSE AFTER CREATE"); + END IF; + +-- FOLLOWING CLOSE + + VAL := TRUE; + CLOSE (TEST_FILE_ONE); + VAL := IS_OPEN (TEST_FILE_ONE); + IF VAL = TRUE THEN + FAILED ("IS_OPEN RETURNS TRUE AFTER CLOSE"); + END IF; + +-- FOLLOWING OPEN + + VAL := FALSE; + + BEGIN + OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + IF IS_OPEN (TEST_FILE_ONE) /= FALSE THEN + FAILED ("IS_OPEN GIVES TRUE ON " & + "UNSUCESSFUL OPEN"); + END IF; + RAISE INCOMPLETE; + END; + + VAL := IS_OPEN (TEST_FILE_ONE); + IF VAL = FALSE THEN + FAILED ("IS_OPEN RETURNS FALSE AFTER OPEN"); + END IF; + +-- AFTER RESET + + VAL := FALSE; + + BEGIN + RESET (TEST_FILE_ONE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + VAL := IS_OPEN (TEST_FILE_ONE); + IF VAL = FALSE THEN + FAILED ("IS_OPEN RETURNS FALSE AFTER RESET"); + END IF; + +-- AFTER DELETE + + VAL := TRUE; + + BEGIN + DELETE (TEST_FILE_ONE); + EXCEPTION + WHEN USE_ERROR => + IF IS_OPEN (TEST_FILE_ONE) /= FALSE THEN + FAILED ("IS_OPEN GIVES TRUE ON UNSUCCESSFUL " & + "DELETE"); + END IF; + RAISE INCOMPLETE; + END; + + VAL := IS_OPEN (TEST_FILE_ONE); + IF VAL = TRUE THEN + FAILED ("IS_OPEN RETURNS TRUE AFTER DELETE"); + END IF; + + RESULT; + +EXCEPTION + + WHEN INCOMPLETE => + RESULT; + +END CE2103C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2103d.ada b/gcc/testsuite/ada/acats/tests/ce/ce2103d.ada new file mode 100644 index 000000000..691650ba3 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2103d.ada @@ -0,0 +1,148 @@ +-- CE2103D.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 IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF +-- TYPE DIRECT_IO. + +-- B) OPENED FILES + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTAIONS WHICH SUPPORT +-- CREATION OF EXTERNAL FILES FOR DIRECT FILES. + +-- HISTORY: +-- SPW 08/13/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2103D IS + + PACKAGE DIR_IO IS NEW DIRECT_IO(CHARACTER); + USE DIR_IO; + INCOMPLETE : EXCEPTION; + TEST_FILE_ONE : DIR_IO.FILE_TYPE; + VAL : BOOLEAN; + +BEGIN + + TEST ("CE2103D", "CHECK THAT IS_OPEN RETURNS THE PROPER " & + "VALUES FOR FILES OF TYPE DIRECT_IO"); + +-- FOLLOWING A CREATE + + VAL := FALSE; + + BEGIN + CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + VAL := IS_OPEN (TEST_FILE_ONE); + IF VAL = FALSE THEN + FAILED ("IS_OPEN RETURNS FALSE AFTER CREATE"); + END IF; + +-- FOLLOWING CLOSE + + VAL := TRUE; + CLOSE (TEST_FILE_ONE); + VAL := IS_OPEN (TEST_FILE_ONE); + IF VAL = TRUE THEN + FAILED ("IS_OPEN RETURNS TRUE AFTER CLOSE"); + END IF; + +-- FOLLOWING OPEN + + VAL := FALSE; + + BEGIN + OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + IF IS_OPEN (TEST_FILE_ONE) /= FALSE THEN + FAILED ("IS_OPEN GIVES TRUE ON " & + "UNSUCCESSFUL OPEN"); + END IF; + RAISE INCOMPLETE; + END; + + VAL := IS_OPEN (TEST_FILE_ONE); + IF VAL = FALSE THEN + FAILED ("IS_OPEN RETURNS FALSE AFTER OPEN"); + END IF; + +-- AFTER RESET + + VAL := FALSE; + + BEGIN + RESET (TEST_FILE_ONE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + VAL := IS_OPEN (TEST_FILE_ONE); + IF VAL = FALSE THEN + FAILED ("IS_OPEN RETURNS FALSE AFTER RESET"); + END IF; + +-- AFTER DELETE + + VAL := TRUE; + + BEGIN + DELETE (TEST_FILE_ONE); + EXCEPTION + WHEN USE_ERROR => + IF IS_OPEN (TEST_FILE_ONE) /= FALSE THEN + FAILED ("IS_OPEN GIVES TRUE ON UNSUCCESSFUL " & + "DELETE"); + END IF; + RAISE INCOMPLETE; + END; + + VAL := IS_OPEN (TEST_FILE_ONE); + IF VAL = TRUE THEN + FAILED ("IS_OPEN RETURNS TRUE AFTER DELETE"); + END IF; + + RESULT; + +EXCEPTION + + WHEN INCOMPLETE => + RESULT; + +END CE2103D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2104a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2104a.ada new file mode 100644 index 000000000..55e3fc3fd --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2104a.ada @@ -0,0 +1,118 @@ +-- CE2104A.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 A FILE CAN BE CLOSED AND THEN RE-OPENED. + +-- A) SEQUENTIAL FILES + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHOSE +-- ENVIRONMENT SUPPORTS CREATE/OPEN FOR THE GIVEN MODE. + +-- HISTORY: +-- DLD 08/11/82 +-- SPS 11/09/82 +-- JBG 03/24/83 +-- EG 06/03/85 +-- SPW 08/07/87 REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION +-- HANDLING. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2104A IS + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER); + USE SEQ_IO; + + SEQ_FILE : SEQ_IO.FILE_TYPE; + VAR : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2104A", "CHECK THAT A FILE CAN BE CLOSED " & + "AND THEN RE-OPENED"); + +-- INITIALIZE TEST FILE + + BEGIN + CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + + END; + + WRITE (SEQ_FILE, 17); + CLOSE (SEQ_FILE); + +-- RE-OPEN SEQUENTIAL TEST FILE + + BEGIN + OPEN (SEQ_FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + READ (SEQ_FILE, VAR); + IF VAR /= 17 THEN + FAILED ("WRONG DATA RETURNED FROM READ - " & + "SEQUENTIAL"); + END IF; + +-- DELETE TEST FILE + + BEGIN + + DELETE (SEQ_FILE); + + EXCEPTION + + WHEN USE_ERROR => + NULL; + + END; + + RESULT; + +EXCEPTION + + WHEN INCOMPLETE => + RESULT; + +END CE2104A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2104b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2104b.ada new file mode 100644 index 000000000..000d00bc8 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2104b.ada @@ -0,0 +1,125 @@ +-- CE2104B.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 THE NAME RETURNED BY NAME CAN BE USED IN A +-- SUBSEQUENT OPEN. + +-- A) SEQUENTIAL FILES + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHOSE +-- ENVIRONMENT SUPPORTS CREATE/OPEN FOR THE GIVEN MODE. + +-- HISTORY: +-- DLD 08/11/82 +-- SPS 11/09/82 +-- JBG 03/24/83 +-- EG 05/31/85 +-- TBN 11/04/86 ADDED A RAISE INCOMPLETE STATEMENT WHEN FAILED IS +-- CALLED FOR OPEN OR CREATE. +-- SPW 08/07/87 REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION +-- HANDLING. + +WITH SEQUENTIAL_IO; +WITH REPORT; USE REPORT; + +PROCEDURE CE2104B IS + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER); + USE SEQ_IO; + TYPE ACC_STR IS ACCESS STRING; + + SEQ_FILE_ONE : SEQ_IO.FILE_TYPE; + SEQ_FILE_TWO : SEQ_IO.FILE_TYPE; + SEQ_FILE_NAME : ACC_STR; + VAR : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2104B", "CHECK THAT THE NAME RETURNED BY NAME " & + "CAN BE USED IN A SUBSEQUENT OPEN"); + +-- CREATE TEST FILE + + BEGIN + CREATE(SEQ_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (SEQ_FILE_ONE, 14); + SEQ_FILE_NAME := NEW STRING'(NAME(SEQ_FILE_ONE)); + CLOSE (SEQ_FILE_ONE); + +-- ATTEMPT TO RE-OPEN SEQUENTIAL TEST FILE USING RETURNED NAME VALUE + + BEGIN + OPEN (SEQ_FILE_TWO, IN_FILE, SEQ_FILE_NAME.ALL); + EXCEPTION + WHEN SEQ_IO.USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + WHEN SEQ_IO.NAME_ERROR => + FAILED ("STRING NOT ACCEPTED AS NAME FOR FILE - SEQ"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("FILE NOT RE-OPENED - SEQ"); + RAISE INCOMPLETE; + END; + + READ (SEQ_FILE_TWO, VAR); + IF VAR /= 14 THEN + FAILED ("WRONG DATA RETURNED FROM READ -SEQ"); + END IF; + +-- DELETE TEST FILE + + BEGIN + DELETE (SEQ_FILE_TWO); + EXCEPTION + WHEN USE_ERROR => + COMMENT ("DELETION OF EXTERNAL FILE IS NOT SUPPORTED"); + END; + + RESULT; + +EXCEPTION + + WHEN INCOMPLETE => + RESULT; + +END CE2104B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2104c.ada b/gcc/testsuite/ada/acats/tests/ce/ce2104c.ada new file mode 100644 index 000000000..840eb575f --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2104c.ada @@ -0,0 +1,115 @@ +-- CE2104C.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 A FILE CAN BE CLOSED AND THEN RE-OPENED. + +-- B) DIRECT FILES + +-- APPLICABLILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHOSE +-- ENVIRONMENT SUPPORTS CREATE/OPEN FOR THE GIVEN MODE. + +-- HISTORY: +-- DLD 08/11/82 +-- SPS 11/09/82 +-- JBG 03/24/83 +-- EG 06/03/85 +-- PWB 02/10/86 CORRECTED REPORTED TEST NAME; CHANGED DATA FILE +-- NAME TO "Y2104C" TO MATCH TEST NAME. +-- SPW 08/07/87 REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION +-- HANDLING. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2104C IS + + PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER); + USE DIR_IO; + + DIR_FILE : DIR_IO.FILE_TYPE; + VAR : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2104C", "CHECK THAT A FILE CAN BE CLOSED " & + "AND THEN RE-OPENED"); + +-- INITIALIZE TEST FILE + + BEGIN + CREATE (DIR_FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + + END; + + WRITE (DIR_FILE, 28); + CLOSE (DIR_FILE); + +-- RE-OPEN DIRECT TEST FILE + + BEGIN + OPEN (DIR_FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + READ (DIR_FILE, VAR); + IF VAR /= 28 THEN + FAILED ("WRONG DATA RETURNED FROM READ - DIRECT"); + END IF; + +-- DELETE TEST FILE + + BEGIN + DELETE (DIR_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + + WHEN INCOMPLETE => + RESULT; + +END CE2104C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2104d.ada b/gcc/testsuite/ada/acats/tests/ce/ce2104d.ada new file mode 100644 index 000000000..068826da1 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2104d.ada @@ -0,0 +1,126 @@ +-- CE2104D.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 THE NAME RETURNED BY NAME CAN BE USED IN A +-- SUBSEQUENT OPEN. + +-- B) DIRECT FILES + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHOSE +-- ENVIRONMENT SUPPORTS CREATE/OPEN FOR THE GIVEN MODE. + +-- HISTORY: +-- DLD 08/11/82 +-- SPS 11/09/82 +-- JBG 03/24/83 +-- EG 05/31/85 +-- TBN 11/04/86 ADDED A RAISE INCOMPLETE STATEMENT WHEN FAILED IS +-- CALLED FOR OPEN OR CREATE. +-- SPW 08/07/87 REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION +-- HANDLING. + +WITH DIRECT_IO; +WITH REPORT; USE REPORT; + +PROCEDURE CE2104D IS + + PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER); + USE DIR_IO; + TYPE ACC_STR IS ACCESS STRING; + + DIR_FILE_ONE : DIR_IO.FILE_TYPE; + DIR_FILE_TWO : DIR_IO.FILE_TYPE; + DIR_FILE_NAME : ACC_STR; + VAR : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2104D", "CHECK THAT THE NAME RETURNED BY NAME " & + "CAN BE USED IN A SUBSEQUENT OPEN"); + +-- CREATE TEST FILE + + BEGIN + CREATE (DIR_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (DIR_FILE_ONE, 3); + DIR_FILE_NAME := NEW STRING'(NAME(DIR_FILE_ONE)); + CLOSE (DIR_FILE_ONE); + +-- ATTEMPT TO RE-OPEN DIRECT TEST FILE USING RETURNED NAME VALUE + + BEGIN + OPEN (DIR_FILE_TWO, IN_FILE, DIR_FILE_NAME.ALL); + EXCEPTION + WHEN DIR_IO.USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + WHEN DIR_IO.NAME_ERROR => + FAILED ("STRING NOT ACCEPTED AS NAME FOR FILE - DIR"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("FILE NOT RE-OPENED - DIR"); + RAISE INCOMPLETE; + + END; + + READ (DIR_FILE_TWO, VAR); + IF VAR /= 3 THEN + FAILED ("WRONG DATA RETURNED FROM READ - DIR"); + END IF; + +-- DELETE TEST FILE + + BEGIN + DELETE (DIR_FILE_TWO); + EXCEPTION + WHEN USE_ERROR => + COMMENT ("DELETION OF EXTERNAL FILE IS NOT SUPPORTED"); + END; + + RESULT; + +EXCEPTION + + WHEN INCOMPLETE => + RESULT; + +END CE2104D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2106a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2106a.ada new file mode 100644 index 000000000..0facea571 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2106a.ada @@ -0,0 +1,122 @@ +-- CE2106A.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 AFTER A SUCCESSFUL DELETE OF AN EXTERNAL FILE, THE +-- NAME OF THE FILE CAN BE USED IN A CREATE OPERATION. + +-- A) SEQUENTIAL FILES + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION WITH OUT_FILE MODE FOR SEQUENTIAL FILES AND +-- DELETION OF EXTERNAL FILES. + +-- HISTORY: +-- SPS 08/25/82 +-- SPS 11/09/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST. +-- TBN 02/12/86 SPLIT TEST. PUT DIRECT_IO INTO CE2106B.ADA. +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- SPW 08/07/87 INSERTED ALLOWABLE EXCEPTION USE_ERROR ON +-- DELETE. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2106A IS + +BEGIN + + TEST ("CE2106A", "CHECK THAT AN EXTERNAL FILE CAN BE CREATED " & + "AFTER AN EXTERNAL FILE WITH SAME NAME HAS " & + "BEEN DELETED FOR SEQUENTIAL_IO"); + + DECLARE + PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ; + FL1 : FILE_TYPE; + FL2 : FILE_TYPE; + T_FAILED : BOOLEAN := FALSE; + D_FILE : BOOLEAN := FALSE; + BEGIN + BEGIN + CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; SEQUENTIAL " & + "CREATE WITH OUT_FILE MODE"); + T_FAILED := TRUE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; SEQUENTIAL " & + "CREATE WITH OUT_FILE MODE"); + T_FAILED := TRUE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; SEQUENTIAL " & + "CREATE"); + T_FAILED := TRUE; + END; + + IF NOT T_FAILED THEN + BEGIN + DELETE (FL1); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("DELETION OF EXTERNAL FILE " & + "IS NOT SUPPORTED"); + T_FAILED := TRUE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "DELETE"); + T_FAILED := TRUE; + END; + END IF; + + IF NOT T_FAILED THEN + BEGIN + CREATE (FL2, OUT_FILE, LEGAL_FILE_NAME); + D_FILE := TRUE; + EXCEPTION + WHEN USE_ERROR => + FAILED ("USE_ERROR FOR RECREATE - SEQ"); + WHEN OTHERS => + FAILED ("UNABLE TO RECREATE FILE AFTER " & + "DELETION - SEQ"); + END; + + IF D_FILE THEN + BEGIN + DELETE (FL2); + EXCEPTION + WHEN USE_ERROR => + FAILED ("USE_ERROR FOR DELETE - SEQ"); + END; + END IF; + END IF; + END; + + RESULT; + +END CE2106A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2106b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2106b.ada new file mode 100644 index 000000000..da6bc8cfe --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2106b.ada @@ -0,0 +1,119 @@ +-- CE2106B.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 AFTER A SUCCESSFUL DELETE OF AN EXTERNAL FILE, THE +-- NAME OF THE FILE CAN BE USED IN A CREATE OPERATION. + +-- B) DIRECT FILES + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION WITH OUT_FILE MODE FOR DIRECT FILES AND +-- DELETION OF EXTERNAL FILES. + +-- HISTORY: +-- TBN 02/12/86 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- SPW 08/07/87 INSERTED ALLOWABLE EXCEPTION USE_ERROR ON +-- DELETE. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2106B IS +BEGIN + + TEST ("CE2106B", "CHECK THAT AN EXTERNAL FILE CAN BE CREATED " & + "AFTER AN EXTERNAL FILE WITH SAME NAME HAS " & + "BEEN DELETED FOR DIRECT_IO"); + + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + FL1 : FILE_TYPE; + FL2 : FILE_TYPE; + T_FAILED : BOOLEAN := FALSE; + D_FILE : BOOLEAN := FALSE; + BEGIN + BEGIN + CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; DIRECT CREATE " & + "WITH OUT_FILE MODE"); + T_FAILED := TRUE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; DIRECT " & + "CREATE WITH OUT_FILE MODE"); + T_FAILED := TRUE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; DIRECT " & + "CREATE"); + T_FAILED := TRUE; + END; + + IF NOT T_FAILED THEN + BEGIN + DELETE (FL1); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("DELETION OF EXTERNAL FILE " & + "IS NOT SUPPORTED"); + T_FAILED := TRUE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "DELETE"); + T_FAILED := TRUE; + END; + END IF; + + IF NOT T_FAILED THEN + BEGIN + CREATE (FL2, OUT_FILE, LEGAL_FILE_NAME); + D_FILE := TRUE; + EXCEPTION + WHEN USE_ERROR => + FAILED ("USE_ERROR FOR RECREATE - DIR"); + WHEN OTHERS => + FAILED ("UNABLE TO RECREATE FILE AFTER " & + "DELETION - DIR"); + END; + + IF D_FILE THEN + BEGIN + DELETE (FL2); + EXCEPTION + WHEN USE_ERROR => + FAILED ("USE_ERROR WHILE DELETING DIR " & + "FILE"); + END; + END IF; + END IF; + END; + + RESULT; + +END CE2106B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2108e.ada b/gcc/testsuite/ada/acats/tests/ce/ce2108e.ada new file mode 100644 index 000000000..d03dd2d3f --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2108e.ada @@ -0,0 +1,83 @@ +-- CE2108E.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 AN EXTERNAL SEQUENTIAL FILE SPECIFIED BY A NON-NULL +-- STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN +-- PROGRAM. + +-- THIS TEST CREATES A SEQUENTIAL FILE; CE2108F.ADA READS IT. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF AN EXTERNAL SEQUENTIAL FILE WITH OUT_FILE MODE. + +-- HISTORY: +-- TBN 07/16/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2108E IS + + PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER); + INCOMPLETE : EXCEPTION; + FILE_NAME : SEQ.FILE_TYPE; + PREVENT_EMPTY_FILE : NATURAL := 5; + +BEGIN + + TEST ("CE2108E" , "CHECK THAT AN EXTERNAL SEQUENTIAL FILE " & + "SPECIFIED BY A NON-NULL STRING NAME IS " & + "ACCESSIBLE AFTER THE COMPLETION OF THE MAIN " & + "PROGRAM"); + BEGIN + BEGIN + SEQ.CREATE (FILE_NAME, SEQ.OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN SEQ.USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON SEQUENTIAL " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN SEQ.NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON SEQUENTIAL " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "SEQUENTIAL CREATE"); + RAISE INCOMPLETE; + END; + + SEQ.WRITE (FILE_NAME, PREVENT_EMPTY_FILE); + SEQ.CLOSE (FILE_NAME); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2108E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2108f.ada b/gcc/testsuite/ada/acats/tests/ce/ce2108f.ada new file mode 100644 index 000000000..7f88abd01 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2108f.ada @@ -0,0 +1,112 @@ +-- CE2108F.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 AN EXTERNAL SEQUENTIAL FILE SPECIFIED BY A NON-NULL +-- STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN +-- PROGRAM. + +-- THIS TEST CHECKS THE CREATION OF A SEQUENTIAL FILE WHICH WAS +-- CREATED BY CE2108E.ADA. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES. + +-- HISTORY: +-- TBN 07/16/87 CREATED ORIGINAL TESTED. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2108F IS + + PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ; + INCOMPLETE : EXCEPTION; + CHECK_SUPPORT, FILE_NAME : FILE_TYPE; + PREVENT_EMPTY_FILE : NATURAL := 0; + +BEGIN + TEST ("CE2108F", "CHECK THAT AN EXTERNAL SEQUENTIAL FILE " & + "SPECIFIED BY A NON-NULL STRING NAME IS " & + "ACCESSIBLE AFTER THE COMPLETION OF THE MAIN " & + "PROGRAM"); + + -- TEST FOR SEQUENTIAL FILE SUPPORT. + + BEGIN + CREATE (CHECK_SUPPORT, OUT_FILE, LEGAL_FILE_NAME); + BEGIN + DELETE (CHECK_SUPPORT); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON DELETE"); + END; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON SEQUENTIAL " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON SEQUENTIAL " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "SEQUENTIAL CREATE"); + RAISE INCOMPLETE; + END; + + -- BEGIN TEST OBJECTIVE. + + BEGIN + OPEN (FILE_NAME, IN_FILE, LEGAL_FILE_NAME(1, "CE2108E")); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN FOR " & + "SEQUENTIAL FILE WITH IN_FILE " & + "MODE"); + RAISE INCOMPLETE; + END; + READ (FILE_NAME, PREVENT_EMPTY_FILE); + IF PREVENT_EMPTY_FILE /= 5 THEN + FAILED ("OPENED WRONG FILE OR DATA ERROR"); + END IF; + BEGIN + DELETE (FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + COMMENT ("IMPLEMENTATION WOULD NOT ALLOW DELETION OF " & + "EXTERNAL FILE"); + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; +END CE2108F; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2108g.ada b/gcc/testsuite/ada/acats/tests/ce/ce2108g.ada new file mode 100644 index 000000000..81166569d --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2108g.ada @@ -0,0 +1,82 @@ +-- CE2108G.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 AN EXTERNAL DIRECT FILE SPECIFIED BY A NON-NULL +-- STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN +-- PROGRAM. + +-- THIS TEST CREATES A DIRECT FILE; CE2108H.ADA READS IT. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF AN EXTERNAL DIRECT FILE. + +-- HISTORY: +-- TBN 07/16/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2108G IS + + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + INCOMPLETE : EXCEPTION; + FILE_NAME : DIR.FILE_TYPE; + PREVENT_EMPTY_FILE : NATURAL := 5; + +BEGIN + + TEST ("CE2108G", "CHECK THAT AN EXTERNAL DIRECT FILE SPECIFIED " & + "BY A NON-NULL STRING NAME IS ACCESSIBLE AFTER " & + "THE COMPLETION OF THE MAIN PROGRAM"); + BEGIN + BEGIN + DIR.CREATE (FILE_NAME, DIR.OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN DIR.USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON DIRECT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN DIR.NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON DIRECT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "DIRECT CREATE"); + RAISE INCOMPLETE; + END; + + DIR.WRITE (FILE_NAME, PREVENT_EMPTY_FILE); + DIR.CLOSE (FILE_NAME); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2108G; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2108h.ada b/gcc/testsuite/ada/acats/tests/ce/ce2108h.ada new file mode 100644 index 000000000..483f23e0b --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2108h.ada @@ -0,0 +1,108 @@ +-- CE2108H.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 AN EXTERNAL DIRECT FILE SPECIFIED BY A NON-NULL +-- STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN +-- PROGRAM. + +-- THIS TEST CHECKS THE CREATION OF A DIRECT FILE WHICH WAS +-- CREATED BY CE2108G.ADA. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- DIRECT FILES. + +-- HISTORY: +-- TBN 07/16/87 CREATED ORIGINAL TESTED. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2108H IS + + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + INCOMPLETE : EXCEPTION; + CHECK_SUPPORT, FILE_NAME : FILE_TYPE; + PREVENT_EMPTY_FILE : NATURAL := 0; + +BEGIN + TEST ("CE2108H", "CHECK THAT AN EXTERNAL DIRECT FILE SPECIFIED " & + "BY A NON-NULL STRING NAME IS ACCESSIBLE AFTER " & + "THE COMPLETION OF THE MAIN PROGRAM"); + + -- TEST FOR DIRECT FILE SUPPORT. + + BEGIN + CREATE (CHECK_SUPPORT, OUT_FILE, LEGAL_FILE_NAME); + BEGIN + DELETE (CHECK_SUPPORT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON DIRECT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON DIRECT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON DIRECT CREATE"); + RAISE INCOMPLETE; + END; + + -- BEGIN TEST OBJECTIVE. + + BEGIN + OPEN (FILE_NAME, IN_FILE, LEGAL_FILE_NAME(1, "CE2108G")); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + READ (FILE_NAME, PREVENT_EMPTY_FILE); + IF PREVENT_EMPTY_FILE /= 5 THEN + FAILED ("OPENED WRONG FILE OR DATA ERROR"); + END IF; + BEGIN + DELETE (FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + COMMENT ("IMPLEMENTATION WOULD NOT ALLOW DELETION OF " & + "EXTERNAL FILE"); + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; +END CE2108H; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2109a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2109a.ada new file mode 100644 index 000000000..5d25a59d7 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2109a.ada @@ -0,0 +1,83 @@ +-- CE2109A.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 THE DEFAULT MODES IN CREATE ARE SET CORRECTLY FOR +-- SEQUENTIAL_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH OUT_FILE MODE FOR SEQUENTIAL FILES. + +-- HISTORY: +-- ABW 08/13/82 +-- SPS 11/09/82 +-- JBG 11/11/83 +-- TBN 02/13/86 SPLIT TEST. PUT DIRECT_IO INTO CE2109B.ADA AND +-- TEXT_IO INTO CE2109C.ADA. +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 08/12/87 CHANGED NOT_APPLICABLE MESSAGE, REMOVED +-- NAME_ERROR, AND CLOSED THE FILE. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2109A IS + + INCOMPLETE : EXCEPTION; + PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ; + FILE2 : SEQ.FILE_TYPE; + +BEGIN + + TEST( "CE2109A", "CHECK DEFAULT MODE IN CREATE FOR SEQ_IO"); + + BEGIN + CREATE (FILE2); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " & + "OUT_FILE MODE NOT SUPPORTED"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; SEQUENTIAL " & + "CREATE"); + RAISE INCOMPLETE; + END; + + IF MODE (FILE2) /= OUT_FILE THEN + FAILED( "MODE INCORRECTLY SET FOR SEQUENTIAL_IO" ); + END IF; + + CLOSE (FILE2); + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2109A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2109b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2109b.ada new file mode 100644 index 000000000..5d17489f5 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2109b.ada @@ -0,0 +1,80 @@ +-- CE2109B.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 THE DEFAULT MODES IN CREATE ARE SET CORRECTLY FOR +-- DIRECT_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH INOUT_FILE MODE FOR DIRECT FILES. + +-- HISTORY: +-- TBN 02/13/86 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 08/12/87 CHANGED NOT_APPLICABLE MESSAGE, REMOVED +-- NAME_ERROR, AND CLOSED THE FILE. +-- LDC 05/26/88 CHANGED APPLICABILITY COMMENT FROM OUT_FILE TO +-- INOUT_FILE. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2109B IS + + INCOMPLETE : EXCEPTION; + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + FILE3 : DIR.FILE_TYPE; + +BEGIN + + TEST( "CE2109B", "CHECK DEFAULT MODE IN CREATE FOR DIRECT_IO"); + + BEGIN + CREATE (FILE3); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("CREATE OF DIRECT FILE WITH " & + "INOUT_FILE MODE NOT SUPPORTED"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; DIRECT CREATE"); + RAISE INCOMPLETE; + END; + + IF MODE (FILE3) /= INOUT_FILE THEN + FAILED( "MODE INCORRECTLY SET FOR DIRECT_IO" ); + END IF; + + CLOSE (FILE3); + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2109B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2109c.ada b/gcc/testsuite/ada/acats/tests/ce/ce2109c.ada new file mode 100644 index 000000000..9d4f3bb0a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2109c.ada @@ -0,0 +1,76 @@ +-- CE2109C.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 THE DEFAULT MODES IN CREATE ARE SET CORRECTLY FOR +-- TEXT_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH OUT_FILE MODE FOR TEXT FILES. + +-- HISTORY: +-- TBN 02/13/86 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 08/12/87 CHANGED NOT_APPLICABLE MESSAGE, REMOVED +-- NAME_ERROR, AND CLOSED THE FILE. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE2109C IS + + INCOMPLETE : EXCEPTION; + FILE1 : TEXT_IO.FILE_TYPE; + +BEGIN + + TEST( "CE2109C", "CHECK DEFAULT MODE IN CREATE FOR TEXT_IO"); + + BEGIN + CREATE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("CREATE OF TEXT FILE WITH OUT_FILE" & + "MODE NOT SUPPORTED"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + END; + + IF MODE (FILE1) /= OUT_FILE THEN + FAILED( "MODE INCORRECTLY SET FOR TEXT_IO" ); + END IF; + + CLOSE (FILE1); + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2109C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2110a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2110a.ada new file mode 100644 index 000000000..f71bbfe07 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2110a.ada @@ -0,0 +1,104 @@ +-- CE2110A.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 AN EXTERNAL FILE CEASES TO EXIST AFTER A SUCCESSFUL +-- DELETE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION AND DELETION OF SEQUENTIAL FILES. + +-- HISTORY: +-- SPS 08/25/82 +-- SPS 11/09/82 +-- JBG 04/01/83 +-- EG 05/31/85 +-- JLH 07/21/87 ADDED A CALL TO NOT_APPLICABLE, IF EXCEPTION +-- USE_ERROR IS RAISED BY DELETE. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2110A IS +BEGIN + + TEST ("CE2110A", "CHECK THAT THE EXTERNAL FILE CEASES TO EXIST " & + "AFTER A SUCCESSFUL DELETE"); + + DECLARE + PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ; + FL1, FL2 : FILE_TYPE; + VAR1 : INTEGER := 5; + INCOMPLETE : EXCEPTION; + BEGIN + BEGIN + CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + WRITE (FL1, VAR1); -- THIS WRITES TO THE FILE IF IT + EXCEPTION -- CAN, NOT NECESSARY FOR THE + WHEN OTHERS => -- OBJECTIVE. + NULL; + END; + + BEGIN + DELETE (FL1); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("DELETION OF EXTERNAL FILES NOT " & + "SUPPORTED"); + RAISE INCOMPLETE; + END; + + BEGIN + OPEN (FL2, IN_FILE, LEGAL_FILE_NAME); + FAILED ("EXTERNAL FILE STILL EXISTS AFTER " & + "A SUCCESSFUL DELETION - SEQ"); + EXCEPTION + WHEN NAME_ERROR => + NULL; + END; + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2110A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2110c.ada b/gcc/testsuite/ada/acats/tests/ce/ce2110c.ada new file mode 100644 index 000000000..983657ad5 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2110c.ada @@ -0,0 +1,104 @@ +-- CE2110C.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 AN EXTERNAL FILE CEASES TO EXIST AFTER A SUCCESSFUL +-- DELETE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION AND DELETION OF DIRECT FILES. + +-- HISTORY: +-- SPS 08/25/82 +-- SPS 11/09/82 +-- JBG 04/01/83 +-- EG 05/31/85 +-- JLH 07/21/87 ADDED A CALL TO NOT_APPLICABLE IF EXCEPTION +-- USE_ERROR IS RAISED ON DELETE. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2110C IS +BEGIN + + TEST ("CE2110C", "CHECK THAT THE EXTERNAL FILE CEASES TO EXIST " & + "AFTER A SUCCESSFUL DELETE"); + + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + FL1, FL2 : FILE_TYPE; + VAR1 : INTEGER := 5; + INCOMPLETE : EXCEPTION; + BEGIN + BEGIN + CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXCEPTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + WRITE (FL1, VAR1); -- THIS WRITES TO THE FILE IF IT + EXCEPTION -- CAN, NOT NECESSARY FOR THE + WHEN OTHERS => -- OBJECTIVE. + NULL; + END; + + BEGIN + DELETE (FL1); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("DELETION OF EXTERNAL FILE NOT " & + "SUPPORTED"); + RAISE INCOMPLETE; + END; + + BEGIN + OPEN (FL2, IN_FILE, LEGAL_FILE_NAME); + FAILED ("EXTERNAL FILE STILL EXISTS AFTER " & + "A SUCCESSFUL DELETION - DIR"); + EXCEPTION + WHEN NAME_ERROR => + NULL; + END; + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2110C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2111a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2111a.ada new file mode 100644 index 000000000..c71591a89 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2111a.ada @@ -0,0 +1,131 @@ +-- CE2111A.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 THE FILE REMAINS OPEN AFTER A RESET. + +-- THIS OBJECTIVE IS BEING INTERPRETED AS : CHECK THAT A FILE +-- REMAINS OPEN AFTER AN ATTEMPT TO RESET. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES. + +-- HISTORY: +-- DLD 08/13/82 +-- SPS 11/09/82 +-- JBG 03/24/83 +-- EG 05/28/85 +-- JLH 07/22/87 REWROTE TEST ALGORITHM. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2111A IS + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER); + USE SEQ_IO; + + SEQ_FILE : SEQ_IO.FILE_TYPE; + VAR1 : INTEGER := 5; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2111A", "CHECK THAT THE FILE REMAINS OPEN AFTER A RESET"); + +-- CREATE SEQUENTIAL TEST FILE + + BEGIN + CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME); + WRITE (SEQ_FILE, VAR1); + CLOSE (SEQ_FILE); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("SEQUENTIAL FILES NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + +-- OPEN FILE + + BEGIN + OPEN (SEQ_FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN WITH IN_FILE MODE NOT SUPPORTED " & + "FOR SEQ_IO"); + RAISE INCOMPLETE; + END; + +-- RESET FILE + + BEGIN + RESET(SEQ_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + IF IS_OPEN (SEQ_FILE) THEN + CLOSE (SEQ_FILE); + ELSE + FAILED ("RESET FOR IN_FILE, CLOSED FILE"); + END IF; + +-- RE-OPEN AS OUT_FILE AND REPEAT TEST + + BEGIN + OPEN (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN WITH OUT_FILE MODE NOT " & + "SUPPORTED FOR SEQ_IO"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (SEQ_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + IF IS_OPEN (SEQ_FILE) THEN + BEGIN + DELETE (SEQ_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + ELSE + FAILED ("RESET FOR OUT_FILE, CLOSED FILE"); + END IF; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2111A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2111b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2111b.ada new file mode 100644 index 000000000..58ceb832c --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2111b.ada @@ -0,0 +1,183 @@ +-- CE2111B.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 A SUCCESSFUL RESET POSITIONS THE INDEX CORRECTLY +-- TO THE START OF THE FILE FOR DIRECT IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- RESET FOR DIRECT FILES. + +-- HISTORY: +-- DLD 08/13/82 +-- JBG 03/24/83 +-- EG 05/29/85 +-- JLH 07/23/87 ADDED CHECKS FOR USE_ERROR WHEN FILE IS RESET. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2111B IS + + PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER); + USE DIR_IO; + TEST_FILE_ONE : DIR_IO.FILE_TYPE; + DATUM : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2111B", "CHECK THAT SUCCESSFUL RESETS POSITION THE " & + "INDEX CORRECTLY"); + +-- CREATE AND INITIALIZE TEST FILE + + BEGIN + CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (TEST_FILE_ONE, 5); + WRITE (TEST_FILE_ONE, 6); + WRITE (TEST_FILE_ONE, 7); + WRITE (TEST_FILE_ONE, 8); + +-- CHECK THAT RESET POSITIONS INDEX CORRECTLY FOR OUT_FILE + + BEGIN + RESET (TEST_FILE_ONE); + IF INDEX (TEST_FILE_ONE) /= 1 THEN + FAILED ("RESET INCORRECTLY POSITIONED FILE FOR " & + "OUT_FILE"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET NOT SUPPORTED FOR OUT_FILE"); + RAISE INCOMPLETE; + END; + +-- WRITE MORE DATA + + WRITE (TEST_FILE_ONE, 2); + CLOSE (TEST_FILE_ONE); + +-- NOW CHECK TO SEE THAT RESET WORKED FOR OUT_FILE + + BEGIN + OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("DIR_IO NOT SUPPORTED FOR IN_FILE OPEN"); + RAISE INCOMPLETE; + END; + READ (TEST_FILE_ONE, DATUM); + IF DATUM /= 2 THEN + FAILED ("RESET FAILED FOR OUT_FILE"); + END IF; + +-- POSITION POINTER APPROPRIATELY FOR IN_FILE RESET + + READ (TEST_FILE_ONE, DATUM); + +-- RESET IN_FILE + + BEGIN + RESET (TEST_FILE_ONE); + IF INDEX (TEST_FILE_ONE) /= 1 THEN + FAILED ("RESET INCORRECTLY POSITIONED FILE " & + "FOR IN_FILE"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET NOT SUPPORTED FOR IN_FILE"); + RAISE INCOMPLETE; + END; + +-- VALIDATE IN_FILE RESET + + READ (TEST_FILE_ONE, DATUM); + IF DATUM /= 2 THEN + FAILED ("RESET FAILED FOR IN_FILE"); + END IF; + +-- VALIDATE RESET FOR IN_OUT FILE + + CLOSE (TEST_FILE_ONE); + BEGIN + OPEN (TEST_FILE_ONE, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("DIR_IO NOT SUPPORTED FOR INOUT_FILE " & + "OPEN"); + RAISE INCOMPLETE; + END; + +-- WRITE NEW DATA + + WRITE (TEST_FILE_ONE, 3); + +-- RESET INOUT_FILE + + BEGIN + RESET (TEST_FILE_ONE); + IF INDEX (TEST_FILE_ONE) /= 1 THEN + FAILED ("RESET INCORRECTLY POSITIONED FILE " & + "FOR INOUT_FILE"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET NOT SUPPORTED FOR INOUT_FILE"); + RAISE INCOMPLETE; + END; + +-- VALIDATE RESET + + READ (TEST_FILE_ONE, DATUM); + IF DATUM /= 3 THEN + FAILED ("RESET FAILED FOR INOUT_FILE"); + END IF; + +-- DELETE TEST FILE + + BEGIN + DELETE (TEST_FILE_ONE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2111B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2111c.ada b/gcc/testsuite/ada/acats/tests/ce/ce2111c.ada new file mode 100644 index 000000000..09aff6657 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2111c.ada @@ -0,0 +1,127 @@ +-- CE2111C.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 A SUPPLIED MODE PARAMETER IN A RESET CHANGES +-- THE MODE OF A GIVEN FILE. IF NO PARAMETER IS SUPPLIED +-- THE MODE REMAINS THE SAME. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- RESET FOR SEQUENTIAL FILES. + +-- HISTORY: +-- DLD 08/16/82 +-- SPS 11/09/82 +-- JBG 03/24/83 +-- EG 05/29/85 +-- JLH 07/23/87 ADDED CHECKS FOR USE_ERROR WHEN FILE IS RESET. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2111C IS + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ_IO; + SEQ_FILE : SEQ_IO.FILE_TYPE; + SEQ_MODE : SEQ_IO.FILE_MODE; + INCOMPLETE : EXCEPTION; + VAR1 : INTEGER := 5; + +BEGIN + + TEST ("CE2111C", "CHECK THAT A SUPPLIED MODE PARAMETER SETS " & + "THE MODE OF THE GIVEN FILE APPROPRIATELY"); + +-- CREATE SEQUENTIAL TEST FILE + + BEGIN + CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME); + WRITE (SEQ_FILE, VAR1); + CLOSE (SEQ_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + OPEN (SEQ_FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("SEQUENTIAL FILES WITH IN_FILE MODE " & + "NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + +-- RESET TO DEFAULT + + BEGIN + SEQ_MODE := OUT_FILE; + RESET (SEQ_FILE); + SEQ_MODE := MODE (SEQ_FILE); + IF SEQ_MODE /= IN_FILE THEN + FAILED ("DEFAULT RESET CHANGED MODE - SEQ"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET NOT SUPPORTED FOR SEQ IN_FILE " & + "MODE"); + RAISE INCOMPLETE; + END; + +-- RESET TO OUT_FILE + + BEGIN + SEQ_MODE := IN_FILE; + RESET (SEQ_FILE, OUT_FILE); + SEQ_MODE := MODE (SEQ_FILE); + IF SEQ_MODE /= OUT_FILE THEN + FAILED ("RESET TO OUT_FILE FAILED - SEQ"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET FROM IN_FILE TO OUT_FILE MODE " & + "NOT SUPPORTED FOR SEQ FILES"); + RAISE INCOMPLETE; + END; + + BEGIN + DELETE (SEQ_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2111C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2111e.ada b/gcc/testsuite/ada/acats/tests/ce/ce2111e.ada new file mode 100644 index 000000000..57e4cb89f --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2111e.ada @@ -0,0 +1,156 @@ +-- CE2111E.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 THE FILE REMAINS OPEN AFTER A RESET. + +-- THIS OBJECTIVE IS BEING INTERPRETED AS : CHECK THAT A FILE +-- REMAINS OPEN AFTER AN ATTEMPT TO RESET. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- DIRECT FILES. + +-- HISTORY: +-- DLD 08/13/82 +-- SPS 11/09/82 +-- JBG 03/24/83 +-- EG 05/28/85 +-- JLH 07/23/87 REWROTE TEST ALGORITHM. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2111E IS + + PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER); + USE DIR_IO; + + DIR_FILE : DIR_IO.FILE_TYPE; + VAR1 : INTEGER := 5; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2111E", "CHECK THAT THE FILE REMAINS OPEN AFTER A RESET"); + +-- CREATE DIRECT TEST FILE + + BEGIN + CREATE (DIR_FILE, OUT_FILE, LEGAL_FILE_NAME); + WRITE (DIR_FILE, VAR1); + CLOSE (DIR_FILE); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("DIRECT FILES NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + +-- OPEN FILE + + BEGIN + OPEN (DIR_FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN WITH IN_FILE MODE NOT SUPPORTED " & + "FOR DIR_IO"); + RAISE INCOMPLETE; + END; + +-- RESET FILE + + BEGIN + RESET (DIR_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + IF IS_OPEN (DIR_FILE) THEN + CLOSE (DIR_FILE); + ELSE + FAILED ("RESET FOR IN_FILE, CLOSED FILE"); + END IF; + + +-- RE-OPEN AS OUT_FILE AND REPEAT TEST + + BEGIN + OPEN (DIR_FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN WITH OUT_FILE MODE NOT " & + "SUPPORTED FOR DIR_IO"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (DIR_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + IF IS_OPEN (DIR_FILE) THEN + CLOSE (DIR_FILE); + ELSE + FAILED ("RESET FOR OUT_FILE, CLOSED FILE"); + END IF; + +-- RE-OPEN AS IN_OUT FILE AND REPEAT TEST + + BEGIN + OPEN (DIR_FILE, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN WITH IN_OUT FILE MODE NOT " & + "SUPPORTED FOR DIR_IO"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (DIR_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + IF IS_OPEN (DIR_FILE) THEN + BEGIN + DELETE (DIR_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + ELSE + FAILED ("RESET FOR INOUT_FILE, CLOSED FILE"); + END IF; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2111E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2111f.ada b/gcc/testsuite/ada/acats/tests/ce/ce2111f.ada new file mode 100644 index 000000000..1259cb894 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2111f.ada @@ -0,0 +1,132 @@ +-- CE2111F.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 A SUCCESSFUL RESET POSITIONS THE FILE CORRECTLY +-- TO THE START OF THE FILE FOR SEQUENTIAL IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- RESET FOR SEQUENTIAL FILES. + +-- HISTORY: +-- JLH 08/03/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2111F IS + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ_IO; + TEST_FILE_ONE : SEQ_IO.FILE_TYPE; + DATUM : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + TEST ("CE2111F", "CHECK THAT SUCCESSFUL RESET POSITIONS THE " & + "FILE CORRECTLY"); + +-- CREATE AND INITIALIZE TEST FILE + + BEGIN + CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (TEST_FILE_ONE, 5); + WRITE (TEST_FILE_ONE, 6); + +-- CHECK THAT RESET POSITIONS INDEX CORRECTLY FOR OUT_FILE + + BEGIN + RESET (TEST_FILE_ONE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET NOT SUPPORTED FOR OUT_FILE"); + RAISE INCOMPLETE; + END; + +-- WRITE MORE DATA + + WRITE (TEST_FILE_ONE, 2); + CLOSE (TEST_FILE_ONE); + +-- NOW CHECK TO SEE THAT RESET WORKED FOR OUT_FILE + + BEGIN + OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("SEQ_IO NOT SUPPORTED FOR IN_FILE OPEN"); + RAISE INCOMPLETE; + END; + + READ (TEST_FILE_ONE, DATUM); + + IF DATUM /= 2 THEN + FAILED ("RESET INCORRECTLY POSITIONED FILE FOR OUT_FILE"); + END IF; + + +-- RESET IN_FILE + + BEGIN + RESET (TEST_FILE_ONE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET NOT SUPPORTED FOR IN_FILE"); + RAISE INCOMPLETE; + END; + +-- VALIDATE IN_FILE RESET + + READ (TEST_FILE_ONE, DATUM); + + IF DATUM /= 2 THEN + FAILED ("RESET INCORRECTLY POSITIONED FILE FOR IN_FILE"); + END IF; + +-- DELETE TEST FILE + + BEGIN + DELETE (TEST_FILE_ONE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2111F; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2111g.ada b/gcc/testsuite/ada/acats/tests/ce/ce2111g.ada new file mode 100644 index 000000000..c3375482f --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2111g.ada @@ -0,0 +1,147 @@ +-- CE2111G.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 A SUPPLIED MODE PARAMETER IN A RESET CHANGES +-- THE MODE OF A GIVEN FILE. IF NO PARAMETER IS SUPPLIED +-- THE MODE REMAINS THE SAME. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- RESET FOR DIRECT FILES. + +-- HISTORY: +-- DLD 08/16/82 +-- SPS 11/09/82 +-- JBG 03/24/83 +-- EG 05/29/85 +-- TBN 11/04/86 ADDED A RAISE INCOMPLETE STATEMENT WHEN FAILED +-- IS CALLED FOR OPEN OR CREATE. +-- JLH 07/24/87 ADDED CHECKS FOR USE_ERR0R WHEN FILE IS RESET. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2111G IS + + PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER); + USE DIR_IO; + DIR_FILE : DIR_IO.FILE_TYPE; + DIR_MODE : DIR_IO.FILE_MODE; + INCOMPLETE : EXCEPTION; + VAR1 : INTEGER := 5; + +BEGIN + + TEST ("CE2111G", "CHECK THAT A SUPPLIED MODE PARAMETER SETS " & + "THE MODE OF THE GIVEN FILE APPROPRIATELY"); + +-- CREATE DIRECT TEST FILE + + BEGIN + CREATE (DIR_FILE, INOUT_FILE, LEGAL_FILE_NAME); + WRITE (DIR_FILE, VAR1); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + +-- RESET TO DEFAULT + + BEGIN + DIR_MODE := OUT_FILE; + RESET (DIR_FILE); + DIR_MODE := MODE (DIR_FILE); + IF DIR_MODE /= INOUT_FILE THEN + FAILED ("DEFAULT RESET CHANGED MODE - DIR"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET NOT SUPPORTED FOR DIR " & + "INOUT_FILES"); + END; + +-- RESET TO OUT_FILE + + BEGIN + DIR_MODE := IN_FILE; + RESET (DIR_FILE, OUT_FILE); + DIR_MODE := MODE (DIR_FILE); + IF DIR_MODE /= OUT_FILE THEN + FAILED ("RESET TO OUT_FILE FAILED - DIR"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET FROM INOUT_FILE TO OUT_FILE " & + "NOT SUPPORTED FOR DIR FILES"); + END; + +-- RESET TO IN_FILE + + BEGIN + DIR_MODE := OUT_FILE; + RESET (DIR_FILE, IN_FILE); + DIR_MODE := MODE (DIR_FILE); + IF DIR_MODE /= IN_FILE THEN + FAILED ("RESET TO IN_FILE FAILED - DIR"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET FROM OUT_FILE TO IN_FILE NOT " & + "SUPPORTED FOR DIR IN_FILE"); + END; + +-- RESET TO INOUT_FILE + + BEGIN + DIR_MODE := OUT_FILE; + RESET (DIR_FILE, INOUT_FILE); + DIR_MODE := MODE (DIR_FILE); + IF DIR_MODE /= INOUT_FILE THEN + FAILED ("RESET TO INOUT_FILE FAILED - DIR"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET FROM IN_FILE TO INOUT_FILE NOT " & + "SUPPORTED FOR DIR INOUT_FILES"); + END; + + BEGIN + DELETE (DIR_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2111G; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2111i.ada b/gcc/testsuite/ada/acats/tests/ce/ce2111i.ada new file mode 100644 index 000000000..d9367f5ad --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2111i.ada @@ -0,0 +1,113 @@ +-- CE2111I.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 A SUPPLIED MODE PARAMETER IN A RESET CHANGES +-- THE MODE OF A GIVEN FILE. IF NO PARAMETER IS SUPPLIED +-- THE MODE REMAINS THE SAME. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- RESET FOR SEQUENTIAL FILES. + +-- HISTORY: +-- JLH 07/23/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2111I IS + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ_IO; + SEQ_FILE : SEQ_IO.FILE_TYPE; + SEQ_MODE : SEQ_IO.FILE_MODE; + INCOMPLETE : EXCEPTION; + VAR1 : INTEGER := 5; + +BEGIN + + TEST("CE2111I", "CHECK THAT A SUPPLIED MODE PARAMETER SETS " & + "THE MODE OF THE GIVEN FILE APPROPRIATELY"); + +-- CREATE SEQUENTIAL TEST FILE + + BEGIN + CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME); + WRITE (SEQ_FILE, VAR1); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + +-- RESET TO DEFAULT + + BEGIN + SEQ_MODE := IN_FILE; + RESET (SEQ_FILE); + SEQ_MODE := MODE (SEQ_FILE); + IF SEQ_MODE /= OUT_FILE THEN + FAILED ("DEFAULT RESET CHANGED MODE - SEQ"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET NOT SUPPORTED FOR SEQ OUT_FILE " & + "MODE"); + RAISE INCOMPLETE; + END; + +-- RESET TO IN_FILE + + BEGIN + SEQ_MODE := OUT_FILE; + RESET (SEQ_FILE, IN_FILE); + SEQ_MODE := MODE (SEQ_FILE); + IF SEQ_MODE /= IN_FILE THEN + FAILED ("RESET TO IN_FILE FAILED - SEQ"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET FROM OUT_FILE TO IN_FILE MODE " & + "NOT SUPPORTED FOR SEQ FILES"); + RAISE INCOMPLETE; + END; + + BEGIN + DELETE (SEQ_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2111I; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2201a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2201a.ada new file mode 100644 index 000000000..85c188fac --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2201a.ada @@ -0,0 +1,112 @@ +-- CE2201A.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR +-- SEQUENTIAL FILES WITH ELEMENT_TYPE STRING. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES. + +-- HISTORY: +-- ABW 08/16/82 +-- SPS 11/09/82 +-- JBG 01/05/83 +-- JBG 02/22/84 CHANGED TO .ADA TEST. +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 07/28/87 REMOVED DEPENDENCE ON SUPPORT OF RESET. + +WITH REPORT; +USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2201A IS + +BEGIN + + TEST ("CE2201A", "CHECK THAT READ, WRITE, AND " & + "END_OF_FILE ARE SUPPORTED FOR " & + "SEQUENTIAL FILES - STRING TYPE"); + + DECLARE + SUBTYPE STRNG IS STRING (1..12); + PACKAGE SEQ_STR IS NEW SEQUENTIAL_IO (STRNG); + USE SEQ_STR; + FILE_STR : FILE_TYPE; + INCOMPLETE : EXCEPTION; + STR : STRNG := "TEXT OF FILE"; + ITEM_STR : STRNG; + BEGIN + BEGIN + CREATE (FILE_STR, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " & + "MODE OUT_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + WRITE (FILE_STR, STR); + CLOSE (FILE_STR); + + BEGIN + OPEN (FILE_STR, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " & + "MODE IN_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + IF END_OF_FILE (FILE_STR) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR TYPE STRING"); + END IF; + + READ (FILE => FILE_STR, ITEM => ITEM_STR); + + IF ITEM_STR /= STRNG (IDENT_STR("TEXT OF FILE")) THEN + FAILED ("READ WRONG VALUE - STRING"); + END IF; + + IF NOT END_OF_FILE (FILE_STR) THEN + FAILED ("END OF FILE NOT TRUE - STRING"); + END IF; + + BEGIN + DELETE (FILE_STR); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2201A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2201b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2201b.ada new file mode 100644 index 000000000..151f88663 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2201b.ada @@ -0,0 +1,116 @@ +-- CE2201B.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR +-- SEQUENTIAL FILES WITH ELEMENT_TYPE CONSTRAINED ARRAY. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES WITH ELEMENT_TYPE CONSTRAINED ARRAY. + +-- HISTORY: +-- ABW 08/17/82 +-- SPS 09/15/82 +-- SPS 11/09/82 +-- JBG 05/02/83 +-- EG 05/08/85 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 07/28/87 REMOVED THE DEPENDENCE OF RESET BEING SUPPORTED +-- AND CREATED EXTERNAL FILES RATHER THAN TEMPORARY +-- FILES. + +WITH REPORT; +USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2201B IS + +BEGIN + + TEST ("CE2201B", "CHECK THAT READ, WRITE, AND " & + "END_OF_FILE ARE SUPPORTED FOR " & + "SEQUENTIAL FILES - CONSTRAINED ARRAY"); + + DECLARE + TYPE ARR_CN IS ARRAY (1..5) OF BOOLEAN; + PACKAGE SEQ_ARR_CN IS NEW SEQUENTIAL_IO (ARR_CN); + USE SEQ_ARR_CN; + FILE_ARR_CN : FILE_TYPE; + INCOMPLETE : EXCEPTION; + ARR1 : ARR_CN := (TRUE,TRUE,FALSE,TRUE,TRUE); + ITEM_ARR1 : ARR_CN; + BEGIN + BEGIN + CREATE (FILE_ARR_CN, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " & + "MODE OUT_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + WRITE (FILE_ARR_CN, ARR1); + CLOSE (FILE_ARR_CN); + + BEGIN + OPEN (FILE_ARR_CN, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " & + "MODE IN_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + IF END_OF_FILE (FILE_ARR_CN) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR " & + "CONSTRAINED ARRAY"); + END IF; + + READ (FILE_ARR_CN, ITEM_ARR1); + + IF ITEM_ARR1 /= ARR1 THEN + FAILED ("READ WRONG VALUE - CONSTRAINED ARRAY"); + END IF; + + IF NOT END_OF_FILE (FILE_ARR_CN) THEN + FAILED ("END OF FILE NOT TRUE - CONSTRAINED ARRAY"); + END IF; + + BEGIN + DELETE (FILE_ARR_CN); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2201B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2201c.ada b/gcc/testsuite/ada/acats/tests/ce/ce2201c.ada new file mode 100644 index 000000000..44516b172 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2201c.ada @@ -0,0 +1,111 @@ +-- CE2201C.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR +-- SEQUENTIAL FILES WITH ELEMENT_TYPE FLOAT. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES. + +-- HISTORY: +-- ABW 08/17/82 +-- SPS 11/10/82 +-- JBG 20/22/84 CHANGED TO .ADA TEST. +-- EG 05/16/85 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/03/87 REMOVED DEPENDENCE OF RESET AND CREATED AN EXTERNAL +-- FILE RATHER THAN A TEMPORARY FILE. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2201C IS +BEGIN + + TEST ("CE2201C", "CHECK THAT READ, WRITE, AND " & + "END_OF_FILE ARE SUPPORTED FOR " & + "SEQUENTIAL FILES - FLOAT"); + + DECLARE + PACKAGE SEQ_FLT IS NEW SEQUENTIAL_IO (FLOAT); + USE SEQ_FLT; + FILE_FLT : FILE_TYPE; + INCOMPLETE : EXCEPTION; + FLT : FLOAT := 65.0; + ITEM_FLT : FLOAT; + BEGIN + BEGIN + CREATE (FILE_FLT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " & + "MODE OUT_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + WRITE (FILE_FLT, FLT); + CLOSE (FILE_FLT); + + BEGIN + OPEN (FILE_FLT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " & + "MODE IN_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + IF END_OF_FILE (FILE_FLT) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR FLOATING POINT"); + END IF; + + READ (FILE_FLT, ITEM_FLT); + + IF ITEM_FLT /= 65.0 THEN + FAILED ("READ WRONG VALUE - FLOAT"); + END IF; + + IF NOT END_OF_FILE (FILE_FLT) THEN + FAILED ("END OF FILE NOT TRUE - FLOAT"); + END IF; + + BEGIN + DELETE (FILE_FLT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE2201C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2201d.dep b/gcc/testsuite/ada/acats/tests/ce/ce2201d.dep new file mode 100644 index 000000000..fdbe40e59 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2201d.dep @@ -0,0 +1,145 @@ +-- CE2201D.DEP + +-- 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 WHETHER READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR +-- SEQUENTIAL FILES WITH ELEMENT_TYPE UNCONSTRAINED ARRAY. + +-- IF I/O IS NOT SUPPORTED, THEN CREATE AND OPEN CAN RAISE USE_ERROR +-- OR NAME_ERROR. SEE (AI-00332). + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS NON-APPLICABLE IF THE INSTANTIATION OF SEQUENTIAL_IO +-- WITH UNCONSTRAINED ARRAY TYPE, ARR_UNCN, IS NOT SUPPORTED. + +-- IF THE INSTANTIATION OF SEQUENTIAL_IO IS NOT SUPPORTED THEN +-- THE INSTANTIATION MUST BE REJECTED. + +-- HISTORY: +-- ABW 8/17/82 +-- SPS 9/15/82 +-- SPS 11/9/82 +-- JBG 1/6/83 +-- JBG 6/4/84 +-- TBN 11/01/85 RENAMED FROM CE2201D.DEP AND MODIFIED COMMENTS. +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- THS 03/30/90 RENAMED FROM EE2201D.ADA. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2201D IS + INCOMPLETE : EXCEPTION; +BEGIN + + TEST ("CE2201D" , "CHECK WHETHER READ, WRITE, AND END_OF_FILE " & + "ARE SUPPORTED FOR SEQUENTIAL FILES WITH " & + "UNCONSTRAINED ARRAY TYPES"); + + DECLARE + SUBTYPE ONE_TEN IS INTEGER RANGE 1..10; + TYPE ARR_UNCN IS ARRAY (ONE_TEN RANGE <>) OF INTEGER; + PACKAGE SEQ_ARR_UNCN + IS NEW SEQUENTIAL_IO (ARR_UNCN); -- N/A => ERROR. + USE SEQ_ARR_UNCN; + FILE_ARR_UNCN : FILE_TYPE; + ARR2 : ARR_UNCN (1..6) := (1,3,5,7,9,0); + ITEM_ARR2 : ARR_UNCN (1..6); + BEGIN + BEGIN + CREATE (FILE_ARR_UNCN); + + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; SEQUENTIAL " & + "CREATE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; SEQUENTIAL " & + "CREATE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; SEQUENTIAL " & + "CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + WRITE (FILE_ARR_UNCN,ARR2); + WRITE (FILE_ARR_UNCN, (0, -2)); + + EXCEPTION + WHEN OTHERS => + FAILED ("WRITE FOR UNCONSTRAINED ARRAY"); + END; + + RESET (FILE_ARR_UNCN,IN_FILE); + + IF END_OF_FILE (FILE_ARR_UNCN) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR " & + "UNCONSTRAINED ARRAY"); + END IF; + + BEGIN + READ (FILE_ARR_UNCN,ITEM_ARR2); + + EXCEPTION + WHEN OTHERS => + FAILED ("READ FOR UNCONSTRAINED ARRAY"); + END; + + IF ITEM_ARR2 /= (1,3,5,7,9,0) THEN + FAILED ("READ WRONG VALUE - 1"); + END IF; + + BEGIN + READ (FILE_ARR_UNCN, ITEM_ARR2(3..4)); + + IF ITEM_ARR2 /= (1,3,0,-2,9,0) THEN + FAILED ("READ WRONG VALUE - 2"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION FOR SECOND ARRAY READ"); + END; + + IF NOT END_OF_FILE(FILE_ARR_UNCN) THEN + FAILED ("NOT AT END OF FILE"); + END IF; + + CLOSE (FILE_ARR_UNCN); + + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED BY RESET"); + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2201D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2201e.dep b/gcc/testsuite/ada/acats/tests/ce/ce2201e.dep new file mode 100644 index 000000000..2ee9578dd --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2201e.dep @@ -0,0 +1,155 @@ +-- CE2201E.DEP + +-- 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 WHETHER READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR +-- SEQUENTIAL FILES WITH VARIANT RECORDS WITH NON-DEFAULT +-- DISCRIMINANTS. + +-- IF I/O IS NOT SUPPORTED, THEN CREATE AND OPEN CAN RAISE USE_ERROR +-- OR NAME_ERROR. SEE (AI-00332). + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS NON-APPLICABLE IF THE INSTANTIATION OF +-- SEQUENTIAL_IO WITH VARIANT RECORDS HAVING NO DEFAULT +-- DISCRIMINANT VALUES IS REJECTED. + +-- HISTORY: +-- JBG 1/6/83 +-- JBG 5/2/83 +-- TBN 11/18/85 RENAMED FROM CE2201E.DEP AND MODIFIED COMMENTS. +-- SPLIT DEFAULT DISCRIMINANT CASE INTO +-- CE2201G.ADA. +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- THS 03/30/90 RENAMED FROM EE2201E.ADA. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2201E IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2201E", "CHECK WHETHER READ, WRITE, AND END_OF_FILE " & + "ARE SUPPORTED FOR SEQUENTIAL FILES WITH " & + "UNCONSTRAINED VARIANT RECORD TYPES WITH " & + "NON-DEFAULT DISCRIMINANTS."); + + DECLARE + TYPE VAR_REC (DISCR : BOOLEAN) IS + RECORD + CASE DISCR IS + WHEN TRUE => + A : INTEGER; + WHEN FALSE => + B : STRING (1..20); + END CASE; + END RECORD; + + PACKAGE SEQ_VAR_REC + IS NEW SEQUENTIAL_IO (VAR_REC); -- N/A => ERROR. + USE SEQ_VAR_REC; + + FILE_VAR_REC : FILE_TYPE; + ITEM_TRUE : VAR_REC(TRUE); + ITEM_FALSE : VAR_REC(FALSE); + + BEGIN + + BEGIN + CREATE (FILE_VAR_REC); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; SEQUENTIAL " & + "CREATE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; SEQUENTIAL " & + "CREATE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; SEQUENTIAL " & + "CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + WRITE (FILE_VAR_REC, (TRUE, -6)); + WRITE (FILE_VAR_REC, (FALSE, (1..20 => 'C'))); + EXCEPTION + WHEN OTHERS => + FAILED ("WRITE FOR RECORD WITH DISCRIMINANT"); + END; + + BEGIN + RESET (FILE_VAR_REC,IN_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR FOR RESET"); + RAISE INCOMPLETE; + END; + + IF END_OF_FILE (FILE_VAR_REC) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR RECORD" & + "WITH DISCRIMINANT"); + END IF; + + BEGIN + READ (FILE_VAR_REC,ITEM_TRUE); + + IF ITEM_TRUE /= (TRUE, IDENT_INT(-6)) THEN + FAILED ("READ WRONG VALUE - 1"); + END IF; + + IF END_OF_FILE (FILE_VAR_REC) THEN + FAILED ("PREMATURE END OF FILE"); + END IF; + + READ (FILE_VAR_REC, ITEM_FALSE); + + IF ITEM_FALSE /= (FALSE, (1..IDENT_INT(20) => 'C')) THEN + FAILED ("READ WRONG VALUE - 2"); + END IF; + + IF NOT END_OF_FILE(FILE_VAR_REC) THEN + FAILED ("NOT AT END OF FILE"); + END IF; + + EXCEPTION + WHEN OTHERS => + FAILED ("READ FOR VARIANT RECORD"); + END; + + CLOSE (FILE_VAR_REC); + + END; + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2201E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2201f.ada b/gcc/testsuite/ada/acats/tests/ce/ce2201f.ada new file mode 100644 index 000000000..7baa401e6 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2201f.ada @@ -0,0 +1,129 @@ +-- CE2201F.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR +-- SEQUENTIAL FILES WITH PRIVATE ELEMENT_TYPES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES WITH PRIVATE ELEMENT_TYPES. + +-- HISTORY: +-- ABW 08/17/82 +-- SPS 09/15/82 +-- SPS 11/09/82 +-- JBG 01/06/83 +-- JBG 02/22/84 CHANGED TO .ADA TEST. +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/03/87 REMOVED DEPENDENCE OF RESET AND CREATED EXTERNAL +-- FILES RATHER THAN TEMPORARY FILES. + +WITH REPORT; +USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2201F IS + + PACKAGE PKG IS + TYPE PRIV IS PRIVATE; + FUNCTION MAKE_PRIV (X : INTEGER) RETURN PRIV; + PRIVATE + TYPE PRIV IS NEW INTEGER; + END PKG; + USE PKG; + + PACKAGE BODY PKG IS + FUNCTION MAKE_PRIV (X : INTEGER) RETURN PRIV IS + BEGIN + RETURN PRIV(X); + END; + END PKG; + +BEGIN + + TEST ("CE2201F", "CHECK THAT READ, WRITE, AND " & + "END_OF_FILE ARE SUPPORTED FOR " & + "SEQUENTIAL FILES FOR PRIVATE TYPES"); + + DECLARE + PACKAGE SEQ_PRV IS NEW SEQUENTIAL_IO (PRIV); + USE SEQ_PRV; + PRV, ITEM_PRV : PRIV; + FILE_PRV : FILE_TYPE; + INCOMPLETE : EXCEPTION; + BEGIN + BEGIN + CREATE (FILE_PRV, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " & + "MODE OUT_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + PRV := MAKE_PRIV(IDENT_INT(26)); + + WRITE (FILE_PRV, PRV); + CLOSE (FILE_PRV); + + BEGIN + OPEN (FILE_PRV, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " & + "MODE IN_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + IF END_OF_FILE (FILE_PRV) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR PRIVATE TYPE"); + END IF; + + READ (FILE_PRV, ITEM_PRV); + + IF ITEM_PRV /= MAKE_PRIV (26) THEN + FAILED ("READ WRONG VALUE"); + END IF; + + IF NOT END_OF_FILE (FILE_PRV) THEN + FAILED ("NOT AT END OF FILE"); + END IF; + + BEGIN + DELETE (FILE_PRV); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2201F; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2201g.ada b/gcc/testsuite/ada/acats/tests/ce/ce2201g.ada new file mode 100644 index 000000000..cb8a528d7 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2201g.ada @@ -0,0 +1,138 @@ +-- CE2201G.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED +-- FOR SEQUENTIAL FILES WITH VARIANT RECORDS WITH DEFAULT +-- DISCRIMINANTS. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES. + +-- HISTORY: +-- TBN 05/15/86 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/03/87 REMOVED DEPENDENCE OF RESET AND CREATED EXTERNAL +-- FILES RATHER THAN TEMPORARY FILES. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2201G IS + +BEGIN + + TEST ("CE2201G", "CHECK THAT READ, WRITE, AND END_OF_FILE " & + "ARE SUPPORTED FOR SEQUENTIAL FILES WITH " & + "UNCONSTRAINED VARIANT RECORD TYPES WITH " & + "DEFAULT DISCRIMINANTS."); + + DECLARE + TYPE VAR_REC (DISCR : BOOLEAN := TRUE) IS + RECORD + CASE DISCR IS + WHEN TRUE => + A : INTEGER; + WHEN FALSE => + B : STRING (1..20); + END CASE; + END RECORD; + + PACKAGE SEQ_VAR_REC IS NEW SEQUENTIAL_IO (VAR_REC); + USE SEQ_VAR_REC; + + FILE_VAR_REC : FILE_TYPE; + INCOMPLETE : EXCEPTION; + ITEM_TRUE : VAR_REC(TRUE); -- CONSTRAINED + ITEM : VAR_REC; -- UNCONSTRAINED + + BEGIN + BEGIN + CREATE (FILE_VAR_REC, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " & + "MODE OUT_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + WRITE (FILE_VAR_REC, (TRUE, -5)); + WRITE (FILE_VAR_REC, (FALSE, (1..20 => 'B'))); + CLOSE (FILE_VAR_REC); + + BEGIN + OPEN (FILE_VAR_REC, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " & + "MODE IN_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + IF END_OF_FILE (FILE_VAR_REC) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR RECORD" & + "WITH DISCRIMINANT"); + END IF; + + BEGIN + READ (FILE_VAR_REC, ITEM_TRUE); + + IF ITEM_TRUE /= (TRUE, IDENT_INT(-5)) THEN + FAILED ("READ WRONG VALUE - 1"); + END IF; + + IF END_OF_FILE (FILE_VAR_REC) THEN + FAILED ("PREMATURE END OF FILE"); + END IF; + + READ (FILE_VAR_REC, ITEM); + + IF ITEM /= (FALSE, (1..IDENT_INT(20) => 'B')) THEN + FAILED ("READ WRONG VALUE - 2"); + END IF; + + IF NOT END_OF_FILE(FILE_VAR_REC) THEN + FAILED ("NOT AT END OF FILE"); + END IF; + + END; + + BEGIN + DELETE (FILE_VAR_REC); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE2201G; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2201h.ada b/gcc/testsuite/ada/acats/tests/ce/ce2201h.ada new file mode 100644 index 000000000..03705c8d6 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2201h.ada @@ -0,0 +1,105 @@ +-- CE2201H.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR +-- SEQUENTIAL FILES WITH ELEMENT TYPE INTEGER. + +-- APPLICABILITY: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES WITH ELEMENT TYPE INTEGER. + +-- HISTORY: +-- JLH 07/28/87 CREATED ORIGINAL TEST. + +WITH REPORT; +USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2201H IS + +BEGIN + + TEST ("CE2201H" , "CHECK THAT READ, WRITE, AND " & + "END_OF_FILE ARE SUPPORTED FOR " & + "SEQUENTIAL FILES - INTEGER TYPE"); + + DECLARE + PACKAGE SEQ_INT IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ_INT; + FILE_INT : FILE_TYPE; + INCOMPLETE : EXCEPTION; + INT : INTEGER := IDENT_INT (33); + ITEM_INT : INTEGER; + BEGIN + BEGIN + CREATE (FILE_INT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " & + "MODE OUT_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + WRITE (FILE_INT, INT); + CLOSE (FILE_INT); + + BEGIN + OPEN (FILE_INT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " & + "MODE IN_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + IF END_OF_FILE (FILE_INT) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR TYPE INTEGER"); + END IF; + + READ (FILE_INT, ITEM_INT); + + IF ITEM_INT /= IDENT_INT(33) THEN + FAILED ("READ WRONG VALUE - INTEGER"); + END IF; + + IF NOT END_OF_FILE (FILE_INT) THEN + FAILED ("END OF FILE NOT TRUE - INTEGER"); + END IF; + + BEGIN + DELETE (FILE_INT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2201H; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2201i.ada b/gcc/testsuite/ada/acats/tests/ce/ce2201i.ada new file mode 100644 index 000000000..e3e6e6037 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2201i.ada @@ -0,0 +1,105 @@ +-- CE2201I.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR +-- SEQUENTIAL FILES WITH ELEMENT TYPE BOOLEAN. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES. + +-- HISTORY: +-- JLH 07/28/87 CREATED ORIGINAL TEST. + +WITH REPORT; +USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2201I IS + +BEGIN + + TEST ("CE2201I", "CHECK THAT READ, WRITE, AND " & + "END_OF_FILE ARE SUPPORTED FOR " & + "SEQUENTIAL FILES - BOOLEAN TYPE"); + + DECLARE + PACKAGE SEQ_BOOL IS NEW SEQUENTIAL_IO (BOOLEAN); + USE SEQ_BOOL; + FILE_BOOL : FILE_TYPE; + INCOMPLETE : EXCEPTION; + BOOL : BOOLEAN := IDENT_BOOL (TRUE); + ITEM_BOOL : BOOLEAN; + BEGIN + BEGIN + CREATE (FILE_BOOL, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " & + "MODE OUT_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + WRITE (FILE_BOOL, BOOL); + CLOSE (FILE_BOOL); + + BEGIN + OPEN (FILE_BOOL, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " & + "MODE IN_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + IF END_OF_FILE (FILE_BOOL) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR TYPE BOOLEAN"); + END IF; + + READ (FILE_BOOL, BOOL); + + IF BOOL /= IDENT_BOOL (TRUE) THEN + FAILED ("READ WRONG VALUE - BOOLEAN"); + END IF; + + IF NOT END_OF_FILE (FILE_BOOL) THEN + FAILED ("END OF FILE NOT TRUE - BOOLEAN"); + END IF; + + BEGIN + DELETE (FILE_BOOL); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2201I; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2201j.ada b/gcc/testsuite/ada/acats/tests/ce/ce2201j.ada new file mode 100644 index 000000000..060909c4a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2201j.ada @@ -0,0 +1,106 @@ +-- CE2201J.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR +-- SEQUENTIAL FILES WITH ELEMENT TYPE ENUMERATION. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES. + +-- HISTORY: +-- JLH 07/28/87 CREATED ORIGINAL TEST. + +WITH REPORT; +USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2201J IS + +BEGIN + + TEST ("CE2201J", "CHECK THAT READ, WRITE, AND " & + "END_OF_FILE ARE SUPPORTED FOR " & + "SEQUENTIAL FILES - ENUMERATION TYPE"); + + DECLARE + TYPE ENUMERATION IS (ONE, TWO, '4'); + PACKAGE SEQ_ENUM IS NEW SEQUENTIAL_IO (ENUMERATION); + USE SEQ_ENUM; + FILE_ENUM : FILE_TYPE; + INCOMPLETE : EXCEPTION; + ENUM : ENUMERATION := ('4'); + ITEM_ENUM : ENUMERATION; + BEGIN + BEGIN + CREATE (FILE_ENUM, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " & + "MODE OUT_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + WRITE (FILE_ENUM, ENUM); + CLOSE (FILE_ENUM); + + BEGIN + OPEN (FILE_ENUM, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " & + "MODE IN_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + IF END_OF_FILE (FILE_ENUM) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR TYPE ENUMERATION"); + END IF; + + READ (FILE_ENUM, ITEM_ENUM); + + IF ITEM_ENUM /= '4' THEN + FAILED ("READ WRONG VALUE - ENUMERATION"); + END IF; + + IF NOT END_OF_FILE (FILE_ENUM) THEN + FAILED ("END OF FILE NOT TRUE - ENUMERATION"); + END IF; + + BEGIN + DELETE (FILE_ENUM); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2201J; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2201k.ada b/gcc/testsuite/ada/acats/tests/ce/ce2201k.ada new file mode 100644 index 000000000..a372ad602 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2201k.ada @@ -0,0 +1,102 @@ +-- CE2201K.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR +-- SEQUENTIAL FILES WITH ELEMENT TYPE ACCESS. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES. + +-- HISTORY: +-- JLH 07/28/87 CREATED ORIGINAL TEST. + +WITH REPORT; +USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2201K IS + +BEGIN + + TEST ("CE2201K", "CHECK THAT READ, WRITE, AND " & + "END_OF_FILE ARE SUPPORTED FOR " & + "SEQUENTIAL FILES - ACCESS TYPE"); + + DECLARE + TYPE ACC_INT IS ACCESS INTEGER; + PACKAGE SEQ_ACC IS NEW SEQUENTIAL_IO (ACC_INT); + USE SEQ_ACC; + FILE_ACC : FILE_TYPE; + INCOMPLETE : EXCEPTION; + ACC : ACC_INT := NEW INTEGER'(33); + ITEM_ACC : ACC_INT; + BEGIN + BEGIN + CREATE (FILE_ACC, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " & + "MODE OUT_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + WRITE (FILE_ACC, ACC); + CLOSE (FILE_ACC); + + BEGIN + OPEN (FILE_ACC, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " & + "MODE IN_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + IF END_OF_FILE (FILE_ACC) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR TYPE ACCESS"); + END IF; + + READ (FILE_ACC, ITEM_ACC); + + IF NOT END_OF_FILE (FILE_ACC) THEN + FAILED ("END OF FILE NOT TRUE - ACCESS"); + END IF; + + BEGIN + DELETE (FILE_ACC); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2201K; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2201l.ada b/gcc/testsuite/ada/acats/tests/ce/ce2201l.ada new file mode 100644 index 000000000..15af84035 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2201l.ada @@ -0,0 +1,103 @@ +-- CE2201L.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR +-- SEQUENTIAL FILES WITH ELEMENT TYPE FIXED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES. + +-- HISTORY: +-- JLH 08/03/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2201L IS +BEGIN + + TEST ("CE2201L", "CHECK THAT READ, WRITE, AND END_OF_FILE " & + "ARE SUPPORTED FOR SEQUENTIAL FILES - FIXED"); + + DECLARE + TYPE FIX IS DELTA 0.5 RANGE -10.0 .. 255.0; + PACKAGE SEQ_FIX IS NEW SEQUENTIAL_IO (FIX); + USE SEQ_FIX; + FILE_FIX : FILE_TYPE; + INCOMPLETE : EXCEPTION; + FX : FIX := -8.5; + ITEM_FIX : FIX; + BEGIN + BEGIN + CREATE (FILE_FIX, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " & + "MODE OUT_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + WRITE (FILE_FIX, FX); + CLOSE (FILE_FIX); + + BEGIN + OPEN (FILE_FIX, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " & + "MODE IN_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + IF END_OF_FILE (FILE_FIX) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR FIXED POINT"); + END IF; + + READ (FILE_FIX, ITEM_FIX); + + IF NOT END_OF_FILE (FILE_FIX) THEN + FAILED ("END OF FILE NOT TRUE - FIXED"); + END IF; + + IF ITEM_FIX /= -8.5 THEN + FAILED ("READ WRONG VALUE - STRING"); + END IF; + + BEGIN + DELETE (FILE_FIX); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2201L; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2201m.ada b/gcc/testsuite/ada/acats/tests/ce/ce2201m.ada new file mode 100644 index 000000000..cf32381bf --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2201m.ada @@ -0,0 +1,123 @@ +-- CE2201M.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED +-- FOR SEQUENTIAL FILES WITH ELEMENT_TYPE RECORD WITHOUT +-- DISCRIMINANTS. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT SEQUENTIAL FILES WITH ELEMENT_TYPE RECORD WITHOUT +-- DISCRIMINANTS. + +-- HISTORY: +-- ABW 08/17/82 +-- SPS 09/15/82 +-- SPS 11/09/82 +-- JBG 05/02/83 +-- EG 05/08/85 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 07/28/87 REMOVED THE DEPENDENCE OF RESET BEING SUPPORTED +-- AND CREATED EXTERNAL FILES RATHER THAN TEMPORARY +-- FILES. + +WITH REPORT; +USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2201M IS + +BEGIN + + TEST ("CE2201M", "CHECK THAT READ, WRITE, AND " & + "END_OF_FILE ARE SUPPORTED FOR " & + "SEQUENTIAL FILES - RECORD WITHOUT " & + "DISCRIMINANTS"); + + DECLARE + TYPE REC IS + RECORD + ONE : INTEGER; + TWO : INTEGER; + END RECORD; + PACKAGE SEQ_REC IS NEW SEQUENTIAL_IO (REC); + USE SEQ_REC; + FILE_REC : FILE_TYPE; + INCOMPLETE : EXCEPTION; + REC1 : REC := (ONE=>18, TWO=>36); + ITEM_REC1 : REC; + BEGIN + + BEGIN + CREATE (FILE_REC, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " & + "MODE OUT_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + WRITE (FILE_REC, REC1); + CLOSE (FILE_REC); + + BEGIN + OPEN (FILE_REC, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " & + "MODE IN_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + IF END_OF_FILE (FILE_REC) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR TYPE RECORD"); + END IF; + + READ (FILE_REC, ITEM_REC1); + + IF ITEM_REC1 /= (18, IDENT_INT(36)) THEN + FAILED ("READ WRONG VALUE - RECORD"); + END IF; + + IF NOT END_OF_FILE (FILE_REC) THEN + FAILED ("END OF FILE NOT TRUE - RECORD"); + END IF; + + BEGIN + DELETE (FILE_REC); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2201M; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2201n.ada b/gcc/testsuite/ada/acats/tests/ce/ce2201n.ada new file mode 100644 index 000000000..2eaa296e2 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2201n.ada @@ -0,0 +1,123 @@ +-- CE2201N.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR +-- SEQUENTIAL FILES WITH ELEMENT_TYPE CONSTRAINED RECORD TYPES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES WITH ELEMENT_TYPE CONSTRAINED RECORD TYPES. + +-- HISTORY: +-- ABW 08/17/82 +-- SPS 09/15/82 +-- SPS 11/09/82 +-- JBG 05/02/83 +-- EG 05/08/85 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 07/28/87 REMOVED THE DEPENDENCE OF RESET BEING SUPPORTED +-- AND CREATED EXTERNAL FILES RATHER THAN TEMPORARY +-- FILES. + +WITH REPORT; +USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2201N IS + +BEGIN + + TEST ("CE2201N", "CHECK THAT READ, WRITE, AND " & + "END_OF_FILE ARE SUPPORTED FOR " & + "SEQUENTIAL FILES - CONSTRAINED RECORDS"); + + DECLARE + TYPE REC_DEF (DISCR : INTEGER := 18) IS + RECORD + ONE : INTEGER := 1; + TWO : INTEGER := 2; + THREE : INTEGER := 17; + FOUR : INTEGER := 2; + END RECORD; + SUBTYPE REC_DEF_2 IS REC_DEF(2); + PACKAGE SEQ_REC_DEF IS NEW SEQUENTIAL_IO (REC_DEF_2); + USE SEQ_REC_DEF; + FILE_REC_DEF : FILE_TYPE; + INCOMPLETE : EXCEPTION; + REC3 : REC_DEF(2); + ITEM_REC3 : REC_DEF(2); + BEGIN + BEGIN + CREATE (FILE_REC_DEF, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " & + "MODE OUT_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + WRITE (FILE_REC_DEF, REC3); + CLOSE (FILE_REC_DEF); + + BEGIN + OPEN (FILE_REC_DEF, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " & + "MODE IN_FILE NOT SUPPORTED"); + RAISE INCOMPLETE; + END; + + IF END_OF_FILE (FILE_REC_DEF) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR RECORD" & + "WITH DEFAULT"); + END IF; + + READ (FILE_REC_DEF, ITEM_REC3); + + IF ITEM_REC3 /= (2, IDENT_INT(1),2,17,2) THEN + FAILED ("READ WRONG VALUE - RECORD WITH DEFAULT"); + END IF; + + IF NOT END_OF_FILE (FILE_REC_DEF) THEN + FAILED ("END OF FILE NOT TRUE - RECORD WITH DEFAULT"); + END IF; + + BEGIN + DELETE (FILE_REC_DEF); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2201N; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2202a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2202a.ada new file mode 100644 index 000000000..a4073579b --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2202a.ada @@ -0,0 +1,143 @@ +-- CE2202A.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 READ, WRITE, AND END_OF_FILE RAISE STATUS_ERROR +-- WHEN APPLIED TO A NON-OPEN SEQUENTIAL FILE. USE_ERROR IS +-- NOT PERMITTED. + +-- HISTORY: +-- ABW 08/17/82 +-- SPS 09/13/82 +-- SPS 11/09/82 +-- EG 11/26/84 +-- EG 05/16/85 +-- GMT 07/24/87 REPLACED CALL TO REPORT.COMMENT WITH "NULL;". + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2202A IS + + PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ; + FILE1, FILE2 : FILE_TYPE; + CNST : CONSTANT INTEGER := 101; + IVAL : INTEGER; + BOOL : BOOLEAN; + +BEGIN + TEST ("CE2202A","CHECK THAT READ, WRITE, AND " & + "END_OF_FILE RAISE STATUS_ERROR " & + "WHEN APPLIED TO A NON-OPEN " & + "SEQUENTIAL FILE"); + BEGIN + BEGIN + WRITE (FILE1,CNST); + FAILED ("STATUS_ERROR NOT RAISED WHEN WRITE APPLIED " & + "TO NON-EXISTENT FILE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED WHEN WRITE " & + "APPLIED TO NON-EXISTENT FILE"); + END; + + BEGIN + READ (FILE1,IVAL); + FAILED ("STATUS_ERROR NOT RAISED WHEN READ APPLIED " & + "TO NON-EXISTENT FILE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED WHEN READ " & + "APPLIED TO NON-EXISTENT FILE"); + END; + + BEGIN + BOOL := END_OF_FILE (FILE1); + FAILED ("STATUS_ERROR NOT RAISED WHEN END_OF_FILE " & + "APPLIED TO NON-EXISTENT FILE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED WHEN END_OF_FILE " & + "APPLIED TO NON-EXISTENT FILE"); + END; + END; + + BEGIN + BEGIN + CREATE (FILE2); + CLOSE (FILE2); + EXCEPTION + WHEN USE_ERROR => + NULL; -- IF FILE2 CANNOT BE CREATED THEN WE WILL + -- BE REPEATING EARLIER TESTS, BUT THAT'S OK. + END; + + BEGIN + WRITE (FILE2,CNST); + FAILED ("STATUS_ERROR NOT RAISED WHEN WRITE APPLIED " & + "TO FILE2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED WHEN WRITE " & + "APPLIED TO FILE2"); + END; + + BEGIN + READ (FILE2,IVAL); + FAILED ("STATUS_ERROR NOT RAISED WHEN READ APPLIED " & + "TO FILE2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED WHEN READ " & + "APPLIED TO FILE2"); + END; + + BEGIN + BOOL := END_OF_FILE (FILE2); + FAILED ("STATUS_ERROR NOT RAISED WHEN END_OF_FILE " & + "APPLIED TO FILE2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED WHEN END_OF_FILE " & + "APPLIED TO FILE2"); + END; + + END; + + RESULT; + +END CE2202A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2203a.tst b/gcc/testsuite/ada/acats/tests/ce/ce2203a.tst new file mode 100644 index 000000000..f9a3f658d --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2203a.tst @@ -0,0 +1,121 @@ +-- CE2203A.TST + +-- 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, FOR SEQUENTIAL_IO, WRITE RAISES THE EXCEPTION +-- USE_ERROR IF THE CAPACITY OF THE EXTERNAL FILE IS EXCEEDED. +-- THIS TEST ONLY CHECKS THAT THE IMPLEMENTATION SUPPORTS AN +-- EXTERNAL FILE CAPACITY OF 4096 CHARACTERS OR LESS. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES. ALSO, THE IMPLEMENTATION MUST BE ABLE TO +-- RESTRICT THE CAPACITY OF AN EXTERNAL FILE. + +-- $FORM_STRING2 IS DEFINED SUCH THAT THE CAPACITY OF THE FILE IS +-- RESTRICTED TO 4096 CHARACTERS OR LESS. IF THE IMPLEMENTATION +-- CANNOT RESTRICT FILE CAPACITY, $FORM_STRING2 SHOULD EQUAL +-- "CANNOT_RESTRICT_FILE_CAPACITY". + +-- HISTORY: +-- JLH 07/12/88 CREATED ORIGINAL TEST. +-- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2203A IS + + SUBTYPE STR512 IS STRING (1 .. 512); + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (STR512); + USE SEQ_IO; + + FILE : FILE_TYPE; + ITEM : STR512 := (1 .. 512 => 'A'); + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2203A", "CHECK FOR SEQUENTIAL_IO THAT WRITE RAISES " & + "USE_ERROR IF THE CAPACITY OF THE EXTERNAL " & + "FILE IS EXCEEDED"); + + BEGIN + + IF +$FORM_STRING2 + = STRING'("CANNOT_RESTRICT_FILE_CAPACITY") THEN + NOT_APPLICABLE ("IMPLEMENTATION CANNOT RESTRICT FILE " & + "CAPACITY"); + RAISE INCOMPLETE; + ELSE + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME, + +$FORM_STRING2 +); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON " & + "CREATE WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "CREATE"); + RAISE INCOMPLETE; + END; + END IF; + + BEGIN + FOR I IN 1 .. 9 LOOP + WRITE (FILE, ITEM); + END LOOP; + FAILED ("USE_ERROR NOT RAISED WHEN THE CAPACITY " & + "OF THE EXTERNAL FILE IS EXCEEDED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE2203A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2204a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2204a.ada new file mode 100644 index 000000000..ee6089878 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2204a.ada @@ -0,0 +1,117 @@ +-- CE2204A.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 WRITE IS FORBIDDEN FOR SEQUENTIAL FILES OF +-- MODE IN_FILE. + +-- A) CHECK NON-TEMPORARY FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES. + +-- HISTORY: +-- DLD 08/17/82 +-- SPS 08/24/82 +-- SPS 11/09/82 +-- JBG 02/22/84 CHANGE TO .ADA TEST. +-- JBG 03/30/84 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- GMT 07/27/87 SPLIT THIS TEST BY MOVING THE CODE FOR CHECKING +-- TEMPORARY FILES INTO CE2204C.ADA. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2204A IS + INCOMPLETE : EXCEPTION; +BEGIN + TEST ("CE2204A", "CHECK THAT MODE_ERROR IS RAISED BY WRITE " & + "WHEN THE MODE IS IN_FILE AND THE FILE " & + "IS A NON-TEMPORARY FILE"); + DECLARE + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ_IO; + SEQ_FILE : FILE_TYPE; + VAR1 : INTEGER := 5; + BEGIN + BEGIN + CREATE (SEQ_FILE, OUT_FILE, + LEGAL_FILE_NAME (1, "CE2204A")); + WRITE (SEQ_FILE, VAR1); + CLOSE (SEQ_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; " & + "SEQUENTIAL CREATE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; " & + "SEQUENTIAL CREATE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; " & + "SEQUENTIAL CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + OPEN (SEQ_FILE, IN_FILE, + LEGAL_FILE_NAME (1, "CE2204A")); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON THE " & + "OPENING OF A SEQUENTIAL " & + "NON-TEMPORARY FILE"); + RAISE INCOMPLETE; + END; + + BEGIN + WRITE (SEQ_FILE, 3); + FAILED ("MODE_ERROR NOT RAISED - NAMED FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - NAMED FILE"); + END; + + BEGIN + DELETE (SEQ_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2204A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2204b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2204b.ada new file mode 100644 index 000000000..61ef0abe6 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2204b.ada @@ -0,0 +1,118 @@ +-- CE2204B.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 READ AND END_OF_FILE ARE FORBIDDEN FOR SEQUENTIAL +-- FILES OF MODE OUT_FILE. + +-- A) CHECK NON-TEMPORARY FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- THE CREATION OF SEQUENTIAL FILES. + +-- HISTORY: +-- DLD 08/17/82 +-- SPS 08/24/82 +-- SPS 110/9/82 +-- JBG 02/22/84 CHANGE TO .ADA TEST. +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- GMT 07/24/87 SPLIT THIS TEST BY MOVING THE CODE FOR CHECKING +-- TEMPORARY FILES INTO CE2204D.ADA. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2204B IS +BEGIN + TEST ("CE2204B", "FOR A NON-TEMPORARY SEQUENTIAL FILE, CHECK " & + "THAT MODE_ERROR IS RAISED BY READ AND " & + "END_OF_FILE WHEN THE MODE IS OUT_FILE"); + DECLARE + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ_IO; + SEQ_FILE : FILE_TYPE; + X : INTEGER; + B : BOOLEAN; + INCOMPLETE : EXCEPTION; + BEGIN + BEGIN + CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE - 2"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON CREATE - 3"); + RAISE INCOMPLETE; + END; + + WRITE (SEQ_FILE, 5); + + BEGIN -- THIS IS ONLY + RESET (SEQ_FILE); -- AN ATTEMPT + EXCEPTION -- TO RESET, + WHEN USE_ERROR => -- IF RESET + NULL; -- N/A THEN + END; -- TEST IS + -- NOT AFFECTED. + BEGIN + READ (SEQ_FILE, X); + FAILED ("MODE_ERROR NOT RAISED ON READ - 4"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON READ - 5"); + END; + + BEGIN + B := END_OF_FILE (SEQ_FILE); + FAILED ("MODE_ERROR NOT RAISED ON END_OF_FILE - 6"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - END_OF_FILE - 7"); + END; + + BEGIN + DELETE (SEQ_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2204B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2204c.ada b/gcc/testsuite/ada/acats/tests/ce/ce2204c.ada new file mode 100644 index 000000000..5981d38df --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2204c.ada @@ -0,0 +1,91 @@ +-- CE2204C.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 WRITE IS FORBIDDEN FOR SEQUENTIAL FILES OF +-- MODE IN_FILE. + +-- B) CHECK TEMPORARY FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEMPORARY SEQUENTIAL FILES AND THE RESETTING FROM OUT_FILE +-- TO IN_FILE. + +-- HISTORY: +-- GMT 07/27/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2204C IS + INCOMPLETE : EXCEPTION; +BEGIN + TEST ("CE2204C", "CHECK THAT MODE_ERROR IS RAISED BY WRITE " & + "WHEN THE MODE IS INFILE AND THE FILE IS " & + "A TEMPORARY FILE"); + DECLARE + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ_IO; + FT : FILE_TYPE; + VAR1 : INTEGER := 5; + BEGIN + BEGIN + CREATE (FT, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1"); + RAISE INCOMPLETE; + END; + + WRITE (FT, VAR1); + + BEGIN + RESET (FT, IN_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON RESET - 2"); + RAISE INCOMPLETE; + END; + + BEGIN + WRITE(FT, 3); + FAILED ("MODE_ERROR NOT RAISED ON WRITE - 3"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON WRITE - 4"); + END; + + CLOSE (FT); + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2204C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2204d.ada b/gcc/testsuite/ada/acats/tests/ce/ce2204d.ada new file mode 100644 index 000000000..38427f5bc --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2204d.ada @@ -0,0 +1,104 @@ +-- CE2204D.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 READ AND END_OF_FILE ARE FORBIDDEN FOR SEQUENTIAL +-- FILES OF MODE OUT_FILE. + +-- B) CHECK TEMPORARY FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- THE CREATION OF TEMPORARY SEQUENTIAL FILES. + +-- HISTORY: +-- GMT 07/24/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2204D IS +BEGIN + TEST ("CE2204D", "FOR A TEMPORARY SEQUENTIAL FILE, CHECK THAT " & + "MODE_ERROR IS RAISED BY READ AND END_OF_FILE " & + "WHEN THE MODE IS OUT_FILE"); + DECLARE + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ_IO; + FT : FILE_TYPE; + X : INTEGER; + B : BOOLEAN; + INCOMPLETE : EXCEPTION; + BEGIN + BEGIN + CREATE (FT); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2"); + RAISE INCOMPLETE; + END; + + WRITE (FT, 5); + + BEGIN -- THIS IS ONLY + RESET (FT); -- AN ATTEMPT + EXCEPTION -- TO RESET, + WHEN USE_ERROR => -- IF RESET + NULL; -- N/A THEN + END; -- TEST IS + -- NOT AFFECTED. + + BEGIN + READ (FT, X); + FAILED ("MODE_ERROR NOT RAISED ON READ - 3"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON READ - 4"); + END; + + BEGIN + B := END_OF_FILE (FT); + FAILED ("MODE_ERROR NOT RAISED ON END_OF_FILE - 5"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - END_OF_FILE - 6"); + END; + + CLOSE (FT); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2204D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2205a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2205a.ada new file mode 100644 index 000000000..33edc2d68 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2205a.ada @@ -0,0 +1,151 @@ +-- CE2205A.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 WHETHER READ FOR A SEQUENTIAL FILE RAISES DATA_ERROR OR +-- CONSTRAINT_ERROR WHEN AN ELEMENT IS READ THAT IS OUTSIDE THE +-- RANGE OF THE ITEM TYPE BUT WITHIN THE RANGE OF THE INSTANTIATED +-- TYPE, AND CHECK THAT READING CAN CONTINUE AFTER THE EXCEPTION +-- HAS BEEN HANDLED. + +-- A) CHECK ENUMERATION TYPE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT SEQUENTIAL FILES. + +-- HISTORY: +-- SPS 09/28/82 +-- JBG 06/04/84 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- GMT 07/24/87 RENAMED FROM CE2210A.ADA AND REMOVED THE USE OF +-- RESET. +-- PWB 05/18/89 DELETED CALL TO FAILED WHEN NO EXCEPTION RAISED. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2205A IS +BEGIN + + TEST ("CE2205A", "CHECK WHETHER READ FOR A SEQUENTIAL FILE " & + "RAISES DATA_ERROR OR CONSTRAINT_ERROR WHEN " & + "AN ELEMENT IS READ THAT IS OUTSIDE THE RANGE " & + "OF THE ITEM TYPE BUT WITHIN THE RANGE OF THE " & + "INSTANTIATED TYPE, AND CHECK THAT READING CAN " & + "CONTINUE AFTER THE EXCEPTION HAS BEEN HANDLED"); + DECLARE + PACKAGE SEQ IS NEW SEQUENTIAL_IO (CHARACTER); + USE SEQ; + FT : FILE_TYPE; + SUBTYPE CH IS CHARACTER RANGE 'A' .. 'D'; + X : CH; + INCOMPLETE : EXCEPTION; + BEGIN + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON SEQUENTIAL " & + "CREATE WITH OUT_FILE MODE - 1"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON SEQUENTIAL " & + "CREATE WITH OUT_FILE MODE - 2"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "SEQUENTIAL CREATE - 3"); + RAISE INCOMPLETE; + END; + + WRITE (FT, 'A'); + WRITE (FT, 'M'); + WRITE (FT, 'B'); + WRITE (FT, 'C'); + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN WITH IN_FILE MODE IS NOT " & + "SUPPORTED - 4"); + RAISE INCOMPLETE; + END; + + -- BEGIN TEST + + READ (FT, X); + IF X /= 'A' THEN + FAILED ("INCORRECT VALUE FOR READ - 5"); + END IF; + + BEGIN + READ (FT, X); + COMMENT ("NO EXCEPTION RAISED FOR READ WITH ELEMENT " & + "OUT OF RANGE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + COMMENT ("CONSTRAINT_ERROR RAISED FOR SCALAR " & + "TYPES - 7"); + WHEN DATA_ERROR => + COMMENT ("DATA_ERROR RAISED FOR SCALAR TYPES - 8"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 9"); + END; + + BEGIN + READ (FT, X); + IF X /= 'B' THEN + FAILED ("INCORRECT VALUE FOR READ - 10"); + END IF; + + READ (FT, X); + IF X /= 'C' THEN + FAILED ("INCORRECT VALUE FOR READ - 11"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("UNABLE TO CONTINUE READING - 12"); + RAISE INCOMPLETE; + END; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2205A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2206a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2206a.ada new file mode 100644 index 000000000..841b680dd --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2206a.ada @@ -0,0 +1,133 @@ +-- CE2206A.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 READ FOR A SEQUENTIAL FILE RAISES END_ERROR WHEN +-- THERE ARE NO MORE ELEMENTS THAT CAN BE READ FROM THE GIVEN +-- FILE. ALSO CHECK THAT END_OF_FILE CORRECTLY DETECTS THE END +-- OF A SEQUENTIAL FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- SEQUENTIAL FILES. + +-- HISTORY: +-- JLH 08/22/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH SEQUENTIAL_IO; + +PROCEDURE CE2206A IS + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (CHARACTER); + USE SEQ_IO; + + FILE : FILE_TYPE; + ITEM : CHARACTER; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2206A", "CHECK THAT READ FOR A SEQUENTIAL FILE RAISES " & + "END_ERROR WHEN THERE ARE NO MORE ELEMENTS " & + "THAT CAN BE READ FROM THE GIVEN FILE. ALSO " & + "CHECK THAT END_OF_FILE CORRECTLY DETECTS THE " & + "END OF A SEQUENTIAL FILE"); + + BEGIN + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + WRITE (FILE, 'A'); + WRITE (FILE, 'B'); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " & + "MODE IN_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + RAISE INCOMPLETE; + END; + + READ (FILE, ITEM); + IF ITEM /= 'A' THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + + IF END_OF_FILE (FILE) THEN + FAILED ("END_OF_FILE NOT DETECTED CORRECTLY - 1"); + END IF; + + READ (FILE, ITEM); + + IF NOT END_OF_FILE (FILE) THEN + FAILED ("END_OF_FILE NOT DETECTED CORRECTLY - 2"); + END IF; + + BEGIN + READ (FILE, ITEM); + FAILED ("END_ERROR NOT RAISED FOR READ"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON READ"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE2206A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2208b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2208b.ada new file mode 100644 index 000000000..418199a86 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2208b.ada @@ -0,0 +1,185 @@ +-- CE2208B.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 DATA CAN BE OVERWRITTEN IN THE SEQUENTIAL FILE AND THE +-- CORRECT VALUES CAN LATER BE READ. ALSO CHECK THAT OVERWRITING +-- TRUNCATES THE FILE TO THE LAST ELEMENT WRITTEN. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- THE CREATING AND OPENING OF SEQUENTIAL FILES. + +-- HISTORY: +-- TBN 09/30/86 CREATED ORIGINAL TEST. +-- GMT 07/24/87 ADDED CHECKS FOR USE_ERROR AND REMOVED SOME CODE. +-- BCB 10/03/90 CHANGED CODE TO CHECK THAT OVERWRITING TRUNCATES +-- INSTEAD OF WHETHER IT TRUNCATES. + +WITH SEQUENTIAL_IO; +WITH REPORT; USE REPORT; +PROCEDURE CE2208B IS + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ_IO; + + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + +BEGIN + TEST ("CE2208B", + "CHECK THAT DATA CAN BE OVERWRITTEN IN THE SEQUENTIAL " & + "FILE AND THE CORRECT VALUES CAN LATER BE READ. ALSO " & + "CHECK THAT OVERWRITING TRUNCATES THE FILE." ); + + -- INITIALIZE TEST FILE + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED DURING CREATE"); + RAISE INCOMPLETE; + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED DURING CREATE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNKNOWN EXCEPTION RAISED DURING CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + FOR I IN 1 .. 25 LOOP + WRITE (FILE1, I); + END LOOP; + EXCEPTION + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED DURING WRITE"); + RAISE INCOMPLETE; + END; + + BEGIN + CLOSE (FILE1); + EXCEPTION + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED DURING CLOSE"); + RAISE INCOMPLETE; + END; + + BEGIN + OPEN (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ( "OPEN WITH OUT_FILE MODE NOT " & + "SUPPORTED FOR SEQUENTIAL FILES" ); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("EXCEPTION RAISED DURING OPEN"); + RAISE INCOMPLETE; + END; + + BEGIN + FOR I IN 26 .. 36 LOOP + WRITE (FILE1, I); + END LOOP; + EXCEPTION + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED DURING OVERWRITE"); + RAISE INCOMPLETE; + END; + + BEGIN + CLOSE (FILE1); + EXCEPTION + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED DURING 2ND CLOSE"); + RAISE INCOMPLETE; + END; + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ( "OPEN WITH IN_FILE MODE NOT " & + "SUPPORTED FOR SEQUENTIAL FILES" ); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("EXCEPTION RAISED DURING SECOND OPEN"); + RAISE INCOMPLETE; + END; + + DECLARE + END_REACHED : BOOLEAN := FALSE; + COUNT : INTEGER := 26; + NUM : INTEGER; + BEGIN + WHILE COUNT <= 36 AND NOT END_REACHED LOOP + BEGIN + READ (FILE1, NUM); + IF NUM /= COUNT THEN + FAILED ("INCORRECT RESULTS READ FROM FILE " & + INTEGER'IMAGE (NUM)); + END IF; + COUNT := COUNT + 1; + EXCEPTION + WHEN END_ERROR => + END_REACHED := TRUE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED DURING " & + "READING - 1"); + RAISE INCOMPLETE; + END; + END LOOP; + IF COUNT <= 36 THEN + FAILED ("FILE WAS INCOMPLETE"); + RAISE INCOMPLETE; + ELSE + BEGIN + READ (FILE1, NUM); + FAILED ("END_ERROR NOT RAISED BY ATTEMPT TO READ"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED " & + "DURING READING - 2"); + RAISE INCOMPLETE; + END; + END IF; + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2208B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2401a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2401a.ada new file mode 100644 index 000000000..4ec422769 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2401a.ada @@ -0,0 +1,357 @@ +-- CE2401A.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH +-- AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE AND +-- END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPES +-- STRING, CHARACTER, AND INTEGER. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH +-- SUPPORT DIRECT FILES. + +-- HISTORY: +-- ABW 08/16/82 +-- SPS 09/15/82 +-- SPS 11/09/82 +-- JBG 02/22/84 CHANGE TO .ADA TEST. +-- EG 05/16/85 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 07/31/87 ISOLATED EXCEPTIONS. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2401A IS + END_SUBTEST : EXCEPTION; +BEGIN + + TEST ("CE2401A" , "CHECK THAT READ, WRITE, SET_INDEX " & + "INDEX, SIZE AND END_OF_FILE ARE " & + "SUPPORTED FOR DIRECT FILES"); + + DECLARE + SUBTYPE STR_TYPE IS STRING (1..12); + PACKAGE DIR_STR IS NEW DIRECT_IO (STR_TYPE); + USE DIR_STR; + FILE_STR : FILE_TYPE; + BEGIN + BEGIN + CREATE (FILE_STR, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " & + "ON CREATE - STRING"); + RAISE END_SUBTEST; + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED ON " & + "CREATE - STRING"); + RAISE END_SUBTEST; + END; + + DECLARE + STR : STR_TYPE := "TEXT OF FILE"; + ITEM_STR : STR_TYPE; + ONE_STR : POSITIVE_COUNT := 1; + TWO_STR : POSITIVE_COUNT := 2; + BEGIN + BEGIN + WRITE (FILE_STR,STR); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "STRING - 1"); + END; + + BEGIN + WRITE (FILE_STR,STR,TWO_STR); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "STRING - 2"); + END; + + BEGIN + IF SIZE (FILE_STR) /= TWO_STR THEN + FAILED ("SIZE FOR TYPE STRING"); + END IF; + IF NOT END_OF_FILE (FILE_STR) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR STRING"); + END IF; + SET_INDEX (FILE_STR,ONE_STR); + IF INDEX (FILE_STR) /= ONE_STR THEN + FAILED ("WRONG INDEX VALUE FOR STRING"); + END IF; + END; + + CLOSE (FILE_STR); + + BEGIN + OPEN (FILE_STR, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " & + "NOT SUPPORTED - 1"); + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE_STR,ITEM_STR); + IF ITEM_STR /= STR THEN + FAILED ("INCORRECT STRING VALUE READ - 1"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITHOUT FROM FOR STRING"); + END; + + BEGIN + READ (FILE_STR,ITEM_STR,ONE_STR); + IF ITEM_STR /= STR THEN + FAILED ("INCORRECT STRING VALUE READ - 2"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITH FROM FOR STRING"); + END; + END; + + BEGIN + DELETE (FILE_STR); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + DECLARE + PACKAGE DIR_CHR IS NEW DIRECT_IO (CHARACTER); + USE DIR_CHR; + FILE_CHR : FILE_TYPE; + BEGIN + BEGIN + CREATE (FILE_CHR, INOUT_FILE, LEGAL_FILE_NAME(2)); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " & + "ON CREATE - CHARACTER"); + RAISE END_SUBTEST; + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED ON " & + "CREATE - CHARACTER"); + RAISE END_SUBTEST; + END; + + DECLARE + CHR : CHARACTER := 'C'; + ITEM_CHR : CHARACTER; + ONE_CHR : POSITIVE_COUNT := 1; + TWO_CHR : POSITIVE_COUNT := 2; + BEGIN + BEGIN + WRITE (FILE_CHR,CHR); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "CHARACTER - 1"); + END; + + BEGIN + WRITE (FILE_CHR,CHR,TWO_CHR); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "CHARACTER - 2"); + END; + + BEGIN + IF SIZE (FILE_CHR) /= TWO_CHR THEN + FAILED ("SIZE FOR TYPE CHARACTER"); + END IF; + IF NOT END_OF_FILE (FILE_CHR) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " & + "CHARACTER"); + END IF; + SET_INDEX (FILE_CHR,ONE_CHR); + IF INDEX (FILE_CHR) /= ONE_CHR THEN + FAILED ("WRONG INDEX VALUE FOR TYPE " & + "CHARACTER"); + END IF; + END; + + CLOSE (FILE_CHR); + + BEGIN + OPEN (FILE_CHR, IN_FILE, LEGAL_FILE_NAME(2)); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " & + "NOT SUPPORTED - 2"); + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE_CHR,ITEM_CHR); + IF ITEM_CHR /= CHR THEN + FAILED ("INCORRECT CHR VALUE READ - 1"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITHOUT FROM FOR " & + "TYPE CHARACTER"); + END; + + BEGIN + READ (FILE_CHR,ITEM_CHR,ONE_CHR); + IF ITEM_CHR /= CHR THEN + FAILED ("INCORRECT CHR VALUE READ - 2"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITH FROM FOR " & + "TYPE CHARACTER"); + END; + END; + + BEGIN + DELETE (FILE_CHR); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + DECLARE + PACKAGE DIR_INT IS NEW DIRECT_IO (INTEGER); + USE DIR_INT; + FILE_INT : FILE_TYPE; + BEGIN + BEGIN + CREATE (FILE_INT, INOUT_FILE, LEGAL_FILE_NAME(3)); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " & + "ON CREATE - INTEGER"); + RAISE END_SUBTEST; + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED ON " & + "CREATE - INTEGER"); + RAISE END_SUBTEST; + END; + + DECLARE + INT : INTEGER := IDENT_INT (33); + ITEM_INT : INTEGER; + ONE_INT : POSITIVE_COUNT := 1; + TWO_INT : POSITIVE_COUNT := 2; + BEGIN + BEGIN + WRITE (FILE_INT,INT); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "INTEGER - 1"); + END; + + BEGIN + WRITE (FILE_INT,INT,TWO_INT); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "INTEGER - 2"); + END; + + BEGIN + IF SIZE (FILE_INT) /= TWO_INT THEN + FAILED ("SIZE FOR TYPE INTEGER"); + END IF; + IF NOT END_OF_FILE (FILE_INT) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " & + "INTEGER"); + END IF; + SET_INDEX (FILE_INT, ONE_INT); + IF INDEX (FILE_INT) /= ONE_INT THEN + FAILED ("WRONG INDEX VALUE FOR TYPE INTEGER"); + END IF; + END; + + CLOSE (FILE_INT); + + BEGIN + OPEN (FILE_INT, IN_FILE, LEGAL_FILE_NAME(3)); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " & + "NOT SUPPORTED - 3"); + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE_INT,ITEM_INT); + IF ITEM_INT /= INT THEN + FAILED ("INCORRECT INT VALUE READ - 1"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITHOUT FROM FOR " & + "TYPE INTEGER"); + END; + + BEGIN + READ (FILE_INT,ITEM_INT,ONE_INT); + IF ITEM_INT /= INT THEN + FAILED ("INCORRECT INT VALUE READ - 2"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITH FROM FOR " & + "TYPE INTEGER"); + END; + END; + + BEGIN + DELETE (FILE_INT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + RESULT; + +END CE2401A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2401b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2401b.ada new file mode 100644 index 000000000..e527fbb56 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2401b.ada @@ -0,0 +1,347 @@ +-- CE2401B.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH +-- AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND +-- END_OF_FILE FOR DIRECT FILES WITH ELEMENT_TYPES BOOLEAN, +-- ACCESS, AND ENUMERATED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- DIRECT FILES. + +-- HISTORY: +-- ABW 08/18/82 +-- SPS 09/15/82 +-- SPS 11/09/82 +-- JBG 02/22/84 CHANGE TO .ADA TEST. +-- EG 05/16/85 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 08/07/87 ISOLATED EXCEPTIONS. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2401B IS + END_SUBTEST : EXCEPTION; +BEGIN + + TEST ("CE2401B", "CHECK READ, WRITE, SET_INDEX " & + "INDEX, SIZE, AND END_OF_FILE FOR " & + "DIRECT FILES FOR BOOLEAN, ACCESS " & + "AND ENUMERATION TYPES"); + DECLARE + PACKAGE DIR_BOOL IS NEW DIRECT_IO (BOOLEAN); + USE DIR_BOOL; + FILE_BOOL : FILE_TYPE; + BEGIN + BEGIN + CREATE (FILE_BOOL, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " & + "ON CREATE - BOOLEAN"); + RAISE END_SUBTEST; + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED ON " & + "CREATE - BOOLEAN"); + RAISE END_SUBTEST; + END; + + DECLARE + BOOL : BOOLEAN := IDENT_BOOL (TRUE); + ITEM_BOOL : BOOLEAN; + ONE_BOOL : POSITIVE_COUNT := 1; + TWO_BOOL : POSITIVE_COUNT := 2; + BEGIN + BEGIN + WRITE (FILE_BOOL,BOOL); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "BOOLEAN - 1"); + END; + + BEGIN + WRITE (FILE_BOOL,BOOL,TWO_BOOL); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "BOOLEAN - 2"); + END; + + BEGIN + IF SIZE (FILE_BOOL) /= TWO_BOOL THEN + FAILED ("SIZE FOR TYPE BOOLEAN"); + END IF; + IF NOT END_OF_FILE (FILE_BOOL) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR " & + "BOOLEAN"); + END IF; + SET_INDEX (FILE_BOOL,ONE_BOOL); + IF INDEX (FILE_BOOL) /= ONE_BOOL THEN + FAILED ("WRONG INDEX VALUE FOR TYPE BOOLEAN"); + END IF; + END; + + CLOSE (FILE_BOOL); + + BEGIN + OPEN (FILE_BOOL, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " & + "NOT SUPPORTED - 1"); + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE_BOOL,ITEM_BOOL); + IF ITEM_BOOL /= BOOL THEN + FAILED ("INCORRECT BOOLEAN VALUE READ - 1"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITHOUT FROM FOR " & + "TYPE BOOLEAN"); + END; + + BEGIN + READ (FILE_BOOL,ITEM_BOOL,ONE_BOOL); + IF ITEM_BOOL /= BOOL THEN + FAILED ("INCORRECT BOOLEAN VALUE READ - 2"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITH FROM FOR BOOLEAN"); + END; + END; + + BEGIN + DELETE (FILE_BOOL); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + DECLARE + TYPE ENUMERATED IS (ONE,TWO,THREE); + PACKAGE DIR_ENUM IS NEW DIRECT_IO (ENUMERATED); + USE DIR_ENUM; + FILE_ENUM : FILE_TYPE; + BEGIN + BEGIN + CREATE (FILE_ENUM, INOUT_FILE, LEGAL_FILE_NAME(2)); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " & + "ON CREATE - ENUMERATED"); + RAISE END_SUBTEST; + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED ON " & + "CREATE - ENUMERATED"); + RAISE END_SUBTEST; + END; + + DECLARE + ENUM : ENUMERATED := (THREE); + ITEM_ENUM : ENUMERATED; + ONE_ENUM : POSITIVE_COUNT := 1; + TWO_ENUM : POSITIVE_COUNT := 2; + BEGIN + BEGIN + WRITE (FILE_ENUM,ENUM); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "ENUMERATED - 1"); + END; + + BEGIN + WRITE (FILE_ENUM,ENUM,TWO_ENUM); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "ENUMERATED - 2"); + END; + + BEGIN + IF SIZE (FILE_ENUM) /= TWO_ENUM THEN + FAILED ("SIZE FOR TYPE ENUMERATED"); + END IF; + IF NOT END_OF_FILE (FILE_ENUM) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " & + "ENUMERATED"); + END IF; + SET_INDEX (FILE_ENUM,ONE_ENUM); + IF INDEX (FILE_ENUM) /= ONE_ENUM THEN + FAILED ("WRONG INDEX VALUE FOR TYPE " & + "ENUMERATED"); + END IF; + END; + + CLOSE (FILE_ENUM); + + BEGIN + OPEN (FILE_ENUM, IN_FILE, LEGAL_FILE_NAME(2)); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " & + "NOT SUPPORTED - 2"); + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE_ENUM,ITEM_ENUM); + IF ITEM_ENUM /= ENUM THEN + FAILED ("INCORRECT ENUM VALUE READ - 1"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITHOUT FROM FOR ENUMERATED"); + END; + + BEGIN + READ (FILE_ENUM,ITEM_ENUM,ONE_ENUM); + IF ITEM_ENUM /= ENUM THEN + FAILED ("INCORRECT ENUM VALUE READ - 2"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITH FROM FOR " & + "TYPE ENUMERATED"); + END; + END; + + BEGIN + DELETE (FILE_ENUM); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + DECLARE + TYPE ACC_INT IS ACCESS INTEGER; + PACKAGE DIR_ACC IS NEW DIRECT_IO (ACC_INT); + USE DIR_ACC; + FILE_ACC : FILE_TYPE; + BEGIN + BEGIN + CREATE (FILE_ACC, INOUT_FILE, LEGAL_FILE_NAME(3)); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " & + "ON CREATE - ACCESS"); + RAISE END_SUBTEST; + END; + + DECLARE + ACC : ACC_INT := NEW INTEGER'(33); + ITEM_ACC : ACC_INT; + ONE_ACC : POSITIVE_COUNT := 1; + TWO_ACC : POSITIVE_COUNT := 2; + BEGIN + BEGIN + WRITE (FILE_ACC,ACC); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "ACCESS - 1"); + END; + + BEGIN + WRITE (FILE_ACC,ACC,TWO_ACC); + + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "ACCESS - 2"); + END; + + BEGIN + IF SIZE (FILE_ACC) /= TWO_ACC THEN + FAILED ("SIZE FOR TYPE ACCESS"); + END IF; + IF NOT END_OF_FILE (FILE_ACC) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR ACCESS"); + END IF; + SET_INDEX (FILE_ACC,ONE_ACC); + IF INDEX (FILE_ACC) /= ONE_ACC THEN + FAILED ("WRONG INDEX VALUE FOR TYPE ACCESS"); + END IF; + END; + + CLOSE (FILE_ACC); + + BEGIN + OPEN (FILE_ACC, IN_FILE, LEGAL_FILE_NAME(3)); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN FOR IN_FILE NOT " & + "SUPPORTED - 3"); + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE_ACC,ITEM_ACC); + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITHOUT FROM FOR ACCESS"); + END; + + BEGIN + READ (FILE_ACC,ITEM_ACC,ONE_ACC); + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITH FROM FOR ACCESS"); + END; + END; + + BEGIN + DELETE (FILE_ACC); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + RESULT; + +END CE2401B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2401c.ada b/gcc/testsuite/ada/acats/tests/ce/ce2401c.ada new file mode 100644 index 000000000..d793104a7 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2401c.ada @@ -0,0 +1,268 @@ +-- CE2401C.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH +-- AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND +-- END_OF_FILE ARE IMPLEMENTED FOR DIRECT FILES WITH +-- ELEMENT_TYPE CONSTRAINED ARRAY, AND RECORD WITHOUT DISCRIMINANTS. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- DIRECT FILES. + +-- HISTORY: +-- ABW 08/18/82 +-- SPS 09/20/82 +-- SPS 11/09/82 +-- JBG 05/02/83 +-- JRK 03/26/84 +-- EG 05/16/85 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 08/10/87 ISOLATED EXCEPTIONS. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2401C IS + END_SUBTEST: EXCEPTION; +BEGIN + + TEST ("CE2401C" , "CHECK READ, WRITE, SET_INDEX " & + "INDEX, SIZE, AND END_OF_FILE FOR " & + "DIRECT FILES FOR CONSTRAINED ARRAY TYPES, " & + "AND RECORD TYPES WITHOUT DISCRIMINANTS"); + + DECLARE + TYPE ARR_CN IS ARRAY (1..5) OF BOOLEAN; + PACKAGE DIR_ARR_CN IS NEW DIRECT_IO (ARR_CN); + USE DIR_ARR_CN; + FILE : FILE_TYPE; + BEGIN + BEGIN + CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " & + "ON CREATE - CONSTRAINED ARRAY"); + RAISE END_SUBTEST; + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED ON " & + "CREATE - CONSTRAINED ARRAY"); + RAISE END_SUBTEST; + END; + + DECLARE + ARR : ARR_CN := (TRUE,TRUE,FALSE,TRUE,TRUE); + ITEM : ARR_CN; + ONE : POSITIVE_COUNT := 1; + TWO : POSITIVE_COUNT := 2; + BEGIN + BEGIN + WRITE (FILE,ARR); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "CONTRAINED ARRAY - 1"); + END; + + BEGIN + WRITE (FILE,ARR,TWO); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "CONSTRAINED ARRAY - 2"); + END; + + BEGIN + IF SIZE (FILE) /= TWO THEN + FAILED ("SIZE FOR TYPE CONSTRAINED ARRAY"); + END IF; + IF NOT END_OF_FILE (FILE) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " & + "CONSTRAINED ARRAY"); + END IF; + SET_INDEX (FILE,ONE); + IF INDEX (FILE) /= ONE THEN + FAILED ("WRONG INDEX VALUE FOR TYPE " & + "CONSTRAINED ARRAY"); + END IF; + END; + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " & + "NOT SUPPORTED - 1"); + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE,ITEM); + IF ITEM /= ARR THEN + FAILED ("INCORRECT ARRAY VALUES READ " & + "- 1"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITHOUT FROM FOR " & + "TYPE CONSTRAINED ARRAY"); + END; + + BEGIN + READ (FILE,ITEM,ONE); + IF ITEM /= ARR THEN + FAILED ("INCORRECT ARRAY VALUES READ " & + "- 2"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITH FROM FOR " & + "TYPE CONSTRAINED ARRAY"); + END; + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + DECLARE + TYPE REC IS + RECORD + ONE : INTEGER; + TWO : INTEGER; + END RECORD; + PACKAGE DIR_REC IS NEW DIRECT_IO (REC); + USE DIR_REC; + FILE : FILE_TYPE; + BEGIN + BEGIN + CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME(2)); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " & + "ON CREATE - RECORD"); + RAISE END_SUBTEST; + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED ON CREATE - " & + "RECORD"); + END; + + DECLARE + REC1 : REC := REC'(ONE=>18,TWO=>36); + ITEM : REC; + ONE : POSITIVE_COUNT := 1; + TWO : POSITIVE_COUNT := 2; + BEGIN + BEGIN + WRITE (FILE,REC1); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR - " & + "RECORD - 1"); + END; + + BEGIN + WRITE (FILE,REC1,TWO); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR - " & + "RECORD - 2"); + END; + + BEGIN + IF SIZE (FILE) /= TWO THEN + FAILED ("SIZE FOR TYPE RECORD"); + END IF; + IF NOT END_OF_FILE (FILE) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR RECORD"); + END IF; + SET_INDEX (FILE,ONE); + IF INDEX (FILE) /= ONE THEN + FAILED ("WRONG INDEX VALUE FOR TYPE RECORD"); + END IF; + END; + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME(2)); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " & + "NOT SUPPORTED - 2"); + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE,ITEM); + IF ITEM /= REC1 THEN + FAILED ("INCORRECT RECORD VALUES READ " & + "- 1"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITHOUT FROM FOR RECORD"); + END; + + BEGIN + READ (FILE,ITEM,ONE); + IF ITEM /= REC1 THEN + FAILED ("INCORRECT RECORD VALUES READ " & + "- 2"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITH FROM FOR " & + "TYPE RECORD"); + END; + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + RESULT; + +END CE2401C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2401e.ada b/gcc/testsuite/ada/acats/tests/ce/ce2401e.ada new file mode 100644 index 000000000..a9b050d7c --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2401e.ada @@ -0,0 +1,172 @@ +-- CE2401E.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH +-- AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND +-- END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPE +-- FLOATING POINT. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY FOR IMPLEMENTATIONS WHICH SUPPORT CREATION OF +-- DIRECT FILES WITH INOUT_FILE MODE AND OPENING OF DIRECT FILES +-- WITH IN_FILE MODE. + +-- HISTORY: +-- ABW 08/18/82 +-- SPS 09/15/82 +-- SPS 11/11/82 +-- JBG 05/02/83 +-- EG 11/19/85 HANDLE IMPLEMENTATIONS WITH +-- POSITIVE_COUNT'LAST=1. +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 08/10/87 ISOLATED EXCEPTIONS. SPLIT FIXED POINT TESTS +-- INTO CE2401I. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2401E IS + + END_SUBTEST : EXCEPTION; + +BEGIN + + TEST ("CE2401E", "CHECK THAT READ, WRITE, SET_INDEX, " & + "INDEX, SIZE, AND END_OF_FILE ARE " & + "SUPPORTED FOR DIRECT FILES WITH " & + "ELEMENT_TYPE FLOAT"); + + DECLARE + + PACKAGE DIR_FLT IS NEW DIRECT_IO (FLOAT); + USE DIR_FLT; + FILE_FLT : FILE_TYPE; + + BEGIN + BEGIN + CREATE (FILE_FLT, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " & + "ON CREATE - FLOAT"); + RAISE END_SUBTEST; + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED ON " & + "CREATE - FLOAT"); + RAISE END_SUBTEST; + END; + + DECLARE + FLT : FLOAT := 65.0; + ITEM_FLT : FLOAT; + ONE_FLT : POSITIVE_COUNT := 1; + TWO_FLT : POSITIVE_COUNT := 2; + BEGIN + BEGIN + WRITE (FILE_FLT, FLT); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "FLOATING POINT - 1"); + END; + + BEGIN + WRITE (FILE_FLT, FLT, TWO_FLT); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "FLOATING POINT - 2"); + END; + + BEGIN + IF SIZE (FILE_FLT) /= TWO_FLT THEN + FAILED ("SIZE FOR FLOATING POINT"); + END IF; + + IF NOT END_OF_FILE (FILE_FLT) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR " & + "FLOATING POINT"); + END IF; + + SET_INDEX (FILE_FLT, ONE_FLT); + IF INDEX (FILE_FLT) /= ONE_FLT THEN + FAILED ("WRONG INDEX VALUE FOR " & + "FLOATING POINT"); + END IF; + END; + + CLOSE (FILE_FLT); + + BEGIN + OPEN (FILE_FLT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN FOR IN_FILE " & + "MODE NOT SUPPORTED"); + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE_FLT, ITEM_FLT); + IF ITEM_FLT /= FLT THEN + FAILED ("WRONG VALUE READ FOR " & + "FLOATING POINT"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITHOUT FROM FOR " & + "TYPE FLOATING POINT"); + END; + + BEGIN + READ (FILE_FLT, ITEM_FLT, ONE_FLT); + IF ITEM_FLT /= FLT THEN + FAILED ("WRONG VALUE READ WITH INDEX FOR " & + "FLOATING POINT"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITH FROM FOR " & + "TYPE FLOATING POINT"); + END; + + BEGIN + DELETE (FILE_FLT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + + RESULT; + +END CE2401E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2401f.ada b/gcc/testsuite/ada/acats/tests/ce/ce2401f.ada new file mode 100644 index 000000000..30b69c991 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2401f.ada @@ -0,0 +1,200 @@ +-- CE2401F.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH +-- AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND +-- END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPE +-- PRIVATE. + +-- APPLICABILITY CRITERIA: +-- +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION WITH INOUT_FILE MODE AND OPENING WITH IN_FILE MODE FOR +-- DIRECT FILES. + +-- HISTORY: +-- ABW 08/18/82 +-- SPS 09/15/82 +-- SPS 11/09/82 +-- JBG 02/22/84 CHANGE TO .ADA TEST +-- EG 11/19/85 CORRECT SO TEST CAN HANDLE IMPLEMENTATION WITH +-- POSITIVE_COUNT'LAST=1; COVER POSSIBILITY OF CREATE +-- RAISING USE_ERROR; ENSURE RESET DOESN'T RAISE +-- EXCEPTION IF CREATE FAILS; CHECK THAT WE CAN READ +-- DATA THAT HAS BEEN WRITTEN. +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 08/11/87 ISOLATED EXCEPTIONS. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2401F IS + + END_SUBTEST : EXCEPTION; + +BEGIN + + TEST ("CE2401F", "CHECK THAT READ, WRITE, SET_INDEX, " & + "INDEX, SIZE, AND END_OF_FILE ARE " & + "SUPPORTED FOR DIRECT FILES WITH " & + "ELEMENT_TYPE PRIVATE"); + + DECLARE + + PACKAGE PKG IS + TYPE PRIV IS PRIVATE; + FUNCTION ASSIGN RETURN PRIV; + PRIVATE + TYPE PRIV IS NEW INTEGER; + END PKG; + + USE PKG; + + PACKAGE DIR_PRV IS NEW DIRECT_IO (PRIV); + USE DIR_PRV; + FILE_PRV : FILE_TYPE; + + PACKAGE BODY PKG IS + FUNCTION ASSIGN RETURN PRIV IS + BEGIN + RETURN (16); + END; + BEGIN + NULL; + END PKG; + + BEGIN + BEGIN + CREATE (FILE_PRV, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " & + "ON CREATE - PRIVATE"); + RAISE END_SUBTEST; + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED ON " & + "CREATE - PRIVATE"); + RAISE END_SUBTEST; + END; + + BEGIN + + DECLARE + + PRV, ITEM_PRV : PRIV; + ONE_PRV : POSITIVE_COUNT := 1; + TWO_PRV : POSITIVE_COUNT := 2; + + BEGIN + + PRV := ASSIGN; + + BEGIN + WRITE (FILE_PRV, PRV); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "PRIVATE - 1"); + END; + + BEGIN + WRITE (FILE_PRV, PRV, TWO_PRV); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "PRIVATE - 2"); + END; + + BEGIN + IF SIZE (FILE_PRV) /= TWO_PRV THEN + FAILED ("SIZE FOR TYPE PRIVATE"); + END IF; + IF NOT END_OF_FILE (FILE_PRV) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR " & + "PRIVATE TYPE"); + END IF; + + SET_INDEX (FILE_PRV, ONE_PRV); + + IF INDEX (FILE_PRV) /= ONE_PRV THEN + FAILED ("WRONG INDEX VALUE FOR PRIVATE " & + "TYPE"); + END IF; + END; + + CLOSE (FILE_PRV); + + BEGIN + OPEN (FILE_PRV, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN FOR IN_FILE NOT " & + "SUPPORTED"); + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE_PRV, ITEM_PRV); + IF ITEM_PRV /= PRV THEN + FAILED ("INCORRECT PRIVATE TYPE VALUE " & + "READ - 1"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITHOUT FROM FOR " & + "PRIVATE TYPE"); + END; + + BEGIN + READ (FILE_PRV, ITEM_PRV, ONE_PRV); + IF ITEM_PRV /= PRV THEN + FAILED ("INCORRECT PRIVATE TYPE VALUE " & + "READ - 2"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITH FROM FOR " & + "PRIVATE TYPE"); + END; + END; + + BEGIN + DELETE (FILE_PRV); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + RESULT; + +END CE2401F; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2401h.ada b/gcc/testsuite/ada/acats/tests/ce/ce2401h.ada new file mode 100644 index 000000000..70ce088d5 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2401h.ada @@ -0,0 +1,168 @@ +-- CE2401H.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 READ, WRITE, SET_INDEX, INDEX, SIZE, AND +-- END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH +-- ELEMENT_TYPE UNCONSTRAINED RECORDS WITH DEFAULT DISCRIMINANTS. + +-- THIS INSTANTIATION IS ALWAYS LEGAL BY AI-00037. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH INOUT_FILE MODE AND OPENING WITH IN_FILE MODE FOR +-- DIRECT FILES. + +-- HISTORY: +-- TBN 05/15/86 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 08/10/87 ISOLATED EXCEPTIONS. + +WITH REPORT; +USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2401H IS + + END_SUBTEST : EXCEPTION; + +BEGIN + + TEST ("CE2401H", "CHECK THAT READ, WRITE, SET_INDEX, INDEX, " & + "SIZE, AND END_OF_FILE ARE SUPPORTED FOR " & + "DIRECT FILES WITH ELEMENT_TYPE UNCONSTRAINED " & + "RECORDS WITH DEFAULT DISCRIMINANTS"); + + DECLARE + TYPE REC_DEF (DISCR : INTEGER := 1) IS + RECORD + ONE : INTEGER := DISCR; + TWO : INTEGER := 3; + THREE : INTEGER := 5; + FOUR : INTEGER := 7; + END RECORD; + PACKAGE DIR_REC_DEF IS NEW DIRECT_IO (REC_DEF); + USE DIR_REC_DEF; + FILE1 : FILE_TYPE; + REC : REC_DEF; + ITEM : REC_DEF; + ONE : POSITIVE_COUNT := 1; + TWO : POSITIVE_COUNT := 2; + + BEGIN + BEGIN + CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE WITH INOUT_FILE MODE " & + "NOT SUPPORTED FOR " & + "UNCONSTRAINED RECORDS WITH " & + "DEFAULT DISCRIMINATES"); + RAISE END_SUBTEST; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON DIRECT " & + "CREATE"); + RAISE END_SUBTEST; + END; + + BEGIN + WRITE (FILE1, REC); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "RECORD WITH DEFAULT - 1"); + END; + + BEGIN + WRITE (FILE1, REC, TWO); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "RECORD WITH DEFAULT - 2"); + END; + + BEGIN + IF SIZE (FILE1) /= TWO THEN + FAILED ("SIZE FOR RECORD WITH DEFAULT"); + END IF; + IF NOT END_OF_FILE (FILE1) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " & + "RECORD WITH DEFAULT"); + END IF; + SET_INDEX (FILE1, ONE); + IF INDEX (FILE1) /= ONE THEN + FAILED ("WRONG INDEX VALUE FOR RECORD" & + "WITH DEFAULT"); + END IF; + END; + + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN FOR IN_FILE NOT SUPPORTED"); + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE1, ITEM); + IF ITEM /= (1,1,3,5,7) THEN + FAILED ("WRONG VALUE READ"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITHOUT FROM FOR " & + "TYPE RECORD WITH DEFAULT"); + END; + + BEGIN + ITEM := (OTHERS => 0); + READ (FILE1, ITEM, ONE); + IF ITEM /= (1,1,3,5,7) THEN + FAILED ("WRONG VALUE READ"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITH FROM FOR " & + "TYPE RECORD WITH DEFAULT"); + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + RESULT; + +END CE2401H; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2401i.ada b/gcc/testsuite/ada/acats/tests/ce/ce2401i.ada new file mode 100644 index 000000000..68f2ba439 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2401i.ada @@ -0,0 +1,163 @@ +-- CE2401I.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH +-- AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND +-- END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPE +-- FIXED POINT. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY FOR IMPLEMENTATIONS WHICH SUPPORT CREATION OF +-- DIRECT FILES WITH INOUT_FILE MODE AND OPENING OF DIRECT FILES +-- WITH IN_FILE MODE. + +-- HISTORY: +-- DWC 08/10/87 CREATED ORIGINAL VERSION. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2401I IS + + END_SUBTEST : EXCEPTION; + +BEGIN + + TEST ("CE2401I", "CHECK THAT READ, WRITE, SET_INDEX, " & + "INDEX, SIZE, AND END_OF_FILE ARE " & + "SUPPORTED FOR DIRECT FILES WITH " & + "ELEMENT_TYPE FIXED"); + + DECLARE + + TYPE FIX_TYPE IS DELTA 0.5 RANGE 0.0 .. 255.0; + PACKAGE DIR_FIX IS NEW DIRECT_IO (FIX_TYPE); + USE DIR_FIX; + FILE_FIX : FILE_TYPE; + + BEGIN + BEGIN + CREATE (FILE_FIX, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " & + "ON CREATE - FIXED POINT"); + RAISE END_SUBTEST; + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED ON " & + "CREATE - FIXED POINT"); + RAISE END_SUBTEST; + END; + + DECLARE + FIX : FIX_TYPE := 16.0; + ITEM_FIX : FIX_TYPE; + ONE_FIX : POSITIVE_COUNT := 1; + TWO_FIX : POSITIVE_COUNT := 2; + + BEGIN + BEGIN + WRITE (FILE_FIX, FIX); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "FIXED POINT - 1"); + END; + + BEGIN + WRITE (FILE_FIX, FIX, TWO_FIX); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE FOR " & + "FIXED POINT - 2"); + END; + + BEGIN + IF SIZE (FILE_FIX) /= TWO_FIX THEN + FAILED ("SIZE FOR TYPE FIXED POINT"); + END IF; + + IF NOT END_OF_FILE (FILE_FIX) THEN + FAILED ("WRONG END_OF_FILE VALUE FOR " & + "FIXED POINT"); + END IF; + + SET_INDEX (FILE_FIX, ONE_FIX); + + IF INDEX (FILE_FIX) /= ONE_FIX THEN + FAILED ("WRONG INDEX VALUE FOR FIXED " & + "POINT"); + END IF; + END; + + CLOSE (FILE_FIX); + + BEGIN + OPEN (FILE_FIX, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " & + "NOT SUPPORTED"); + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE_FIX, ITEM_FIX); + IF ITEM_FIX /= FIX THEN + FAILED ("WRONG VALUE READ FOR FIXED POINT"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITHOUT FROM FOR FIXED " & + "POINT"); + END; + + BEGIN + READ (FILE_FIX, ITEM_FIX, ONE_FIX); + IF ITEM_FIX /= FIX THEN + FAILED ("WRONG VALUE READ WITH INDEX " & + "FOR FIXED POINT"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ WITH FROM FOR FIXED POINT"); + END; + + BEGIN + DELETE (FILE_FIX); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + RESULT; + +END CE2401I; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2401j.ada b/gcc/testsuite/ada/acats/tests/ce/ce2401j.ada new file mode 100644 index 000000000..85e43cc66 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2401j.ada @@ -0,0 +1,176 @@ +-- CE2401J.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 DATA WRITTEN INTO A DIRECT FILE CAN BE READ +-- CORRECTLY. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION WITH INOUT_FILE MODE AND OPENING WITH IN_FILE MODE FOR +-- DIRECT FILES. + +-- HISTORY: +-- DWC 08/12/87 CREATE ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2401J IS + END_SUBTEST: EXCEPTION; +BEGIN + + TEST ("CE2401J" , "CHECK THAT DATA WRITTEN INTO A DIRECT FILE " & + "CAN BE READ CORRECTLY"); + + DECLARE + PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER); + USE DIR_IO; + FILE : FILE_TYPE; + BEGIN + BEGIN + CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE WITH INOUT FILE NOT " & + "SUPPORTED"); + RAISE END_SUBTEST; + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED ON " & + "CREATE"); + RAISE END_SUBTEST; + END; + + DECLARE + OUT_ITEM1 : INTEGER := 10; + OUT_ITEM2 : INTEGER := 21; + OUT_ITEM3 : INTEGER := 32; + IN_ITEM : INTEGER; + ONE : POSITIVE_COUNT := 1; + THREE : POSITIVE_COUNT := 3; + FIVE : POSITIVE_COUNT := 5; + BEGIN + BEGIN + WRITE (FILE, OUT_ITEM1, ONE); + WRITE (FILE, OUT_ITEM2, THREE); + BEGIN + READ (FILE, IN_ITEM, ONE); + IF OUT_ITEM1 /= IN_ITEM THEN + FAILED ("INCORRECT INTEGER VALUE " & + "READ - 1"); + END IF; + END; + WRITE (FILE, OUT_ITEM3, FIVE); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE"); + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE, IN_ITEM, THREE); + IF OUT_ITEM2 /= IN_ITEM THEN + FAILED ("INCORRECT INTEGER VALUE READ - 2"); + END IF; + END; + + BEGIN + RESET (FILE); + READ (FILE, IN_ITEM); + IF OUT_ITEM1 /= IN_ITEM THEN + FAILED ("INCORRECT INTEGER VALUE READ - 3"); + END IF; + EXCEPTION + WHEN USE_ERROR => NULL; + END; + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE, IN_ITEM); + IF OUT_ITEM1 /= IN_ITEM THEN + FAILED ("INCORRECT INTEGER VALUE READ - 4"); + RAISE END_SUBTEST; + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ IN IN_FILE MODE - 1"); + END; + + BEGIN + READ (FILE, IN_ITEM, ONE); + IF OUT_ITEM1 /= IN_ITEM THEN + FAILED ("INCORRECT INTEGER VALUE READ - 5"); + RAISE END_SUBTEST; + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ IN IN_FILE MODE - 2"); + END; + + BEGIN + READ (FILE, IN_ITEM, FIVE); + IF OUT_ITEM3 /= IN_ITEM THEN + FAILED ("INCORRECT INTEGER VALUE READ - 6"); + RAISE END_SUBTEST; + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ IN IN_FILE MODE - 3"); + END; + + BEGIN + READ (FILE, IN_ITEM, THREE); + IF OUT_ITEM2 /= IN_ITEM THEN + FAILED ("INCORRECT INTEGER VALUE READ - 7"); + RAISE END_SUBTEST; + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("READ IN IN_FILE MODE - 4"); + END; + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + RESULT; + +END CE2401J; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2401k.ada b/gcc/testsuite/ada/acats/tests/ce/ce2401k.ada new file mode 100644 index 000000000..2e00f66ef --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2401k.ada @@ -0,0 +1,164 @@ +-- CE2401K.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 DATA CAN BE OVERWRITTEN IN THE DIRECT FILE AND +-- THE CORRECT VALUES CAN LATER BE READ. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF INOUT_FILE MODE AND OPENING OF OUT_FILE MODE FOR +-- DIRECT FILES. + +-- HISTORY: +-- DWC 08/12/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2401K IS + END_SUBTEST: EXCEPTION; +BEGIN + + TEST ("CE2401K" , "CHECK THAT DATA CAN BE OVERWRITTEN IN " & + "THE DIRECT FILE AND THE CORRECT VALUES " & + "CAN LATER BE READ."); + + DECLARE + PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER); + USE DIR_IO; + FILE : FILE_TYPE; + BEGIN + BEGIN + CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE WITH INOUT_FILE MODE " & + "NOT SUPPORTED"); + RAISE END_SUBTEST; + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED ON " & + "CREATE"); + RAISE END_SUBTEST; + END; + + DECLARE + OUT_ITEM1 : INTEGER := 10; + OUT_ITEM2 : INTEGER := 21; + IN_ITEM : INTEGER; + ONE : POSITIVE_COUNT := 1; + TWO : POSITIVE_COUNT := 2; + BEGIN + BEGIN + WRITE (FILE, OUT_ITEM1, ONE); + WRITE (FILE, OUT_ITEM2, TWO); + WRITE (FILE, OUT_ITEM2, ONE); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE " & + "IN INOUT_FILE MODE"); + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE, IN_ITEM, ONE); + IF OUT_ITEM2 /= IN_ITEM THEN + FAILED ("INCORRECT INTEGER VALUE READ - 1"); + RAISE END_SUBTEST; + END IF; + END; + + BEGIN + READ (FILE, IN_ITEM, TWO); + IF OUT_ITEM2 /= IN_ITEM THEN + FAILED ("INCORRECT INTEGER VALUE READ - 2"); + RAISE END_SUBTEST; + END IF; + END; + + CLOSE (FILE); + + BEGIN + OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + RAISE END_SUBTEST; + END; + + BEGIN + WRITE (FILE, OUT_ITEM1, ONE); + WRITE (FILE, OUT_ITEM2, TWO); + WRITE (FILE, OUT_ITEM1, TWO); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE " & + "IN OUT_FILE MODE"); + RAISE END_SUBTEST; + END; + + BEGIN + RESET (FILE, IN_FILE); + EXCEPTION + WHEN USE_ERROR => + RAISE END_SUBTEST; + END; + + BEGIN + READ (FILE, IN_ITEM, ONE); + IF OUT_ITEM1 /= IN_ITEM THEN + FAILED ("INCORRECT INTEGER VALUE READ - 3"); + RAISE END_SUBTEST; + END IF; + EXCEPTION + WHEN USE_ERROR => + FAILED ("READ IN IN_FILE MODE - 1"); + END; + + BEGIN + READ (FILE, IN_ITEM, TWO); + IF OUT_ITEM1 /= IN_ITEM THEN + FAILED ("INCORRECT INTEGER VALUE READ - 4"); + RAISE END_SUBTEST; + END IF; + EXCEPTION + WHEN USE_ERROR => + FAILED ("READ IN IN_FILE MODE - 2"); + END; + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + RESULT; + +END CE2401K; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2401l.ada b/gcc/testsuite/ada/acats/tests/ce/ce2401l.ada new file mode 100644 index 000000000..3ecba26fc --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2401l.ada @@ -0,0 +1,125 @@ +-- CE2401L.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 REWRITING AN ELEMENT DOES NOT CHANGE THE SIZE OF +-- THE FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH INOUT_FILE MODE FOR DIRECT FILES. + +-- HISTORY: +-- DWC 08/12/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2401L IS + END_SUBTEST: EXCEPTION; +BEGIN + + TEST ("CE2401L" , "CHECK THAT REWRITING AN ELEMENT DOES NOT " & + "CHANGE THE SIZE OF THE FILE"); + + DECLARE + PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER); + USE DIR_IO; + FILE : FILE_TYPE; + BEGIN + BEGIN + CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE WITH INOUT_FILE MODE " & + "NOT SUPPORTED"); + RAISE END_SUBTEST; + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED ON " & + "CREATE"); + RAISE END_SUBTEST; + END; + + DECLARE + OUT_ITEM1 : INTEGER := 10; + OUT_ITEM2 : INTEGER := 21; + OUT_ITEM4 : INTEGER := 43; + IN_ITEM : INTEGER; + ONE : POSITIVE_COUNT := 1; + TWO : POSITIVE_COUNT := 2; + FOUR : POSITIVE_COUNT := 4; + OLD_FILE_SIZE : POSITIVE_COUNT; + BEGIN + BEGIN + WRITE (FILE, OUT_ITEM1, ONE); + WRITE (FILE, OUT_ITEM4, FOUR); + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED ON WRITE " & + "IN INOUT_FILE MODE"); + RAISE END_SUBTEST; + END; + + OLD_FILE_SIZE := SIZE (FILE); + + WRITE (FILE, OUT_ITEM1, ONE); + WRITE (FILE, OUT_ITEM4, FOUR); + + IF OLD_FILE_SIZE /= SIZE (FILE) THEN + FAILED ("FILE SIZE CHANGED DURING REWRITE - 1"); + RAISE END_SUBTEST; + END IF; + + WRITE (FILE, OUT_ITEM1, ONE); + WRITE (FILE, OUT_ITEM2, TWO); + WRITE (FILE, OUT_ITEM4, FOUR); + + OLD_FILE_SIZE := SIZE (FILE); + + WRITE (FILE, OUT_ITEM1, FOUR); + + IF OLD_FILE_SIZE /= SIZE (FILE) THEN + FAILED ("FILE SIZE CHANGED DURING REWRITE - 2"); + RAISE END_SUBTEST; + END IF; + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN END_SUBTEST => + NULL; + END; + + RESULT; + +END CE2401L; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2402a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2402a.ada new file mode 100644 index 000000000..f05330a34 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2402a.ada @@ -0,0 +1,161 @@ +-- CE2402A.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 READ, WRITE, INDEX, SET_INDEX, SIZE, AND +-- END_OF_FILE RAISE STATUS_ERROR WHEN APPLIED TO A NON-OPEN +-- DIRECT FILE. USE_ERROR IS NOT PERMITTED. + +-- HISTORY: +-- ABW 08/17/82 +-- SPS 09/16/82 +-- SPS 11/09/82 +-- JBG 08/30/83 +-- EG 11/26/84 +-- EG 06/04/85 +-- GMT 08/03/87 CLARIFIED SOME OF THE FAILED MESSAGES, AND +-- REMOVED THE EXCEPTION FOR CONSTRAINT_ERROR. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2402A IS + + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + FILE1 : FILE_TYPE; + CNST : CONSTANT INTEGER := 101; + IVAL : INTEGER; + BOOL : BOOLEAN; + X_COUNT : COUNT; + P_COUNT : POSITIVE_COUNT; + +BEGIN + TEST ("CE2402A","CHECK THAT READ, WRITE, INDEX, " & + "SET_INDEX, SIZE, AND END_OF_FILE " & + "RAISE STATUS_ERROR WHEN APPLIED " & + "A NON-OPEN DIRECT FILE"); + BEGIN + WRITE (FILE1, CNST); + FAILED ("STATUS_ERROR WAS NOT RAISED ON WRITE - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED ON WRITE - 2"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON WRITE - 3"); + END; + + BEGIN + X_COUNT := SIZE (FILE1); + FAILED ("STATUS_ERROR NOT RAISED ON SIZE - 4"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED ON SIZE - 5"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON SIZE - 6"); + END; + + BEGIN + BOOL := END_OF_FILE (FILE1); + FAILED ("STATUS_ERROR WAS NOT RAISED ON END_OF_FILE - 7"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED ON END_OF_FILE - 8"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON END_OF_FILE - 9"); + END; + + BEGIN + P_COUNT := INDEX (FILE1); + FAILED ("STATUS_ERROR WAS NOT RAISED ON INDEX - 10"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED ON INDEX - 11"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON INDEX - 12"); + END; + + BEGIN + READ (FILE1, IVAL); + FAILED ("STATUS_ERROR WAS NOT RAISED ON READ - 13"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED ON READ - 14"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON READ - 15"); + END; + + DECLARE + ONE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1)); + BEGIN + BEGIN + WRITE (FILE1, CNST, ONE); + FAILED ("STATUS_ERROR NOT RAISED ON WRITE - 16"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED ON WRITE - 17"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON WRITE - 18"); + END; + + BEGIN + SET_INDEX (FILE1,ONE); + FAILED ("STATUS_ERROR NOT RAISED ON SET_INDEX - 19"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED ON SET_INDEX - 20"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON SET_INDEX - 21"); + END; + + BEGIN + READ (FILE1, IVAL, ONE); + FAILED ("STATUS_ERROR WAS NOT RAISED ON READ - 22"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED ON READ - 23"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON READ - 24"); + END; + END; + + RESULT; + +END CE2402A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2403a.tst b/gcc/testsuite/ada/acats/tests/ce/ce2403a.tst new file mode 100644 index 000000000..0988eb256 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2403a.tst @@ -0,0 +1,121 @@ +-- CE2403A.TST + +-- 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, FOR DIRECT_IO, WRITE RAISES THE EXCEPTION +-- USE_ERROR IF THE CAPACITY OF THE EXTERNAL FILE IS EXCEEDED. +-- THIS TEST ONLY CHECKS THAT THE IMPLEMENTATION SUPPORTS AN +-- EXTERNAL FILE CAPACITY OF 4096 CHARACTERS OR LESS. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- DIRECT FILES. ALSO, THE IMPLEMENTATION MUST BE ABLE TO +-- RESTRICT THE CAPACITY OF AN EXTERNAL FILE. + +-- $FORM_STRING2 IS DEFINED SUCH THAT THE CAPACITY OF THE FILE IS +-- RESTRICTED TO 4096 CHARACTERS OR LESS. IF THE IMPLEMENTATION +-- CANNOT RESTRICT FILE CAPACITY, $FORM_STRING2 SHOULD EQUAL +-- "CANNOT_RESTRICT_FILE_CAPACITY". + +-- HISTORY: +-- JLH 07/12/88 CREATED ORIGINAL TEST. +-- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2403A IS + + SUBTYPE STR512 IS STRING (1 .. 512); + + PACKAGE DIR_IO IS NEW DIRECT_IO (STR512); + USE DIR_IO; + + FILE : FILE_TYPE; + ITEM : STR512 := (1 .. 512 => 'A'); + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2403A", "CHECK FOR DIRECT_IO THAT WRITE RAISES " & + "USE_ERROR IF THE CAPACITY OF THE EXTERNAL " & + "FILE IS EXCEEDED"); + + BEGIN + + IF +$FORM_STRING2 + = STRING'("CANNOT_RESTRICT_FILE_CAPACITY") THEN + NOT_APPLICABLE ("IMPLEMENTATION CANNOT RESTRICT FILE " & + "CAPACITY"); + RAISE INCOMPLETE; + ELSE + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME, + +$FORM_STRING2 +); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON " & + "CREATE WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "CREATE"); + RAISE INCOMPLETE; + END; + END IF; + + BEGIN + FOR I IN 1 .. 9 LOOP + WRITE (FILE, ITEM); + END LOOP; + FAILED ("USE_ERROR NOT RAISED WHEN THE CAPACITY " & + "OF THE EXTERNAL FILE IS EXCEEDED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE2403A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2404a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2404a.ada new file mode 100644 index 000000000..11bec0f33 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2404a.ada @@ -0,0 +1,99 @@ +-- CE2404A.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 READ RAISES MODE_ERROR WHEN THE CURRENT MODE IS +-- OUT_FILE. + +-- A) CHECK NON-TEMPORARY FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF DIRECT FILES WITH MODE OUT_FILE. + +-- HISTORY: +-- DLD 08/17/82 +-- SPS 11/09/82 +-- SPS 11/22/82 +-- JBG 02/22/84 CHANGE TO .ADA TEST. +-- EG 05/16/85 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- GMT 08/03/87 MOVED THE TEMP-FILE CASE TO CE2404B.ADA. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2404A IS + + PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER); + USE DIR_IO; + DIR_FILE_1 : FILE_TYPE; + I : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + TEST ("CE2404A", "CHECK THAT READ RAISES MODE_ERROR WHEN THE " & + "CURRENT MODE IS OUT_FILE AND THE FILE IS " & + "A NON-TEMPORARY FILE"); + BEGIN + + CREATE (DIR_FILE_1, OUT_FILE, LEGAL_FILE_NAME); + + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE - 2"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE - 3"); + RAISE INCOMPLETE; + END; + + BEGIN + READ (DIR_FILE_1, I); + FAILED ("MODE_ERROR NOT RAISED ON READ - 4"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON READ - 5"); + END; + + BEGIN + DELETE (DIR_FILE_1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2404A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2404b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2404b.ada new file mode 100644 index 000000000..8e3d56077 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2404b.ada @@ -0,0 +1,82 @@ +-- CE2404B.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 READ RAISES MODE_ERROR WHEN THE CURRENT MODE IS +-- OUT_FILE. + +-- B) CHECK TEMPORARY FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF DIRECT FILES WITH MODE OUT_FILE. + +-- HISTORY: +-- GMT 08/03/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2404B IS + + PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER); + USE DIR_IO; + DIR_FILE_2 : FILE_TYPE; + I : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + TEST ("CE2404B", "CHECK THAT READ RAISES MODE_ERROR WHEN THE " & + "CURRENT MODE IS OUT_FILE AND THE FILE IS " & + "A TEMPORARY FILE"); + BEGIN + CREATE (DIR_FILE_2, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE - 2"); + RAISE INCOMPLETE; + END; + + BEGIN + READ(DIR_FILE_2, I); + FAILED("MODE_ERROR NOT RAISED ON READ - 3"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED("WRONG EXCEPTION RAISED ON READ - 4"); + END; + + CLOSE (DIR_FILE_2); + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2404B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2405b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2405b.ada new file mode 100644 index 000000000..fb8224282 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2405b.ada @@ -0,0 +1,157 @@ +-- CE2405B.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 READ RAISES END_ERROR WHEN THE CURRENT READ POSITION +-- IS GREATER THAN THE END POSITION. ALSO CHECK THAT END_OF_FILE +-- CORRECTLY DETECTS THE END OF A DIRECT FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION WITH INOUT_FILE MODE AND OPENING OF IN_FILE MODE. + +-- HISTORY: +-- SPS 09/28/82 +-- JBG 02/22/84 CHANGE TO .ADA TEST +-- EG 05/16/85 +-- GMT 08/03/87 ADDED CODE TO CHECK THAT END_OF_FILE WORKS, AND +-- ADDED CODE TO PREVENT SOME EXCEPTION PROPAGATION. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2405B IS +BEGIN + TEST ("CE2405B", "CHECK THAT END_ERROR IS RAISED BY READ AT THE " & + "END OF A FILE AND THAT END_OF_FILE CORRECTLY " & + "DETECTS THE END OF A DIRECT_IO FILE"); + DECLARE + PACKAGE DIR IS NEW DIRECT_IO (CHARACTER); + USE DIR; + FT : FILE_TYPE; + CH : CHARACTER; + INCOMPLETE : EXCEPTION; + BEGIN + + -- CREATE AND INITIALIZE FILE + + BEGIN + CREATE (FT, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("USE_ERROR | NAME_ERROR WAS " & + "RAISED ON CREATE - 1"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2"); + RAISE INCOMPLETE; + END; + + BEGIN + + WRITE (FT, 'C'); + WRITE (FT, 'X'); + + -- BEGIN TEST + + IF NOT END_OF_FILE (FT) THEN + FAILED ("END_OF_FILE RETURNED INCORRECT " & + "BOOLEAN VALUE - 3"); + END IF; + + BEGIN + READ (FT, CH); + FAILED ("END_ERROR NOT RAISED ON READ - 4"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON READ - 5"); + END; + + WRITE (FT,'E'); + + BEGIN + READ (FT, CH); + FAILED ("END_ERROR NOT RAISED ON READ - 6"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON READ - 7"); + END; + + END; + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN - 8"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON OPEN - 9"); + RAISE INCOMPLETE; + END; + + DECLARE + COUNT_NBR_OF_READS : NATURAL := 0; + EXPECTED_COUNT : CONSTANT := 3; + BEGIN + LOOP + IF END_OF_FILE (FT) THEN + EXIT; + ELSE + READ (FT, CH); + COUNT_NBR_OF_READS := COUNT_NBR_OF_READS + 1; + END IF; + END LOOP; + + IF COUNT_NBR_OF_READS /= EXPECTED_COUNT THEN + FAILED ("THE BAD VALUE FOR COUNT_NBR_OF_READS " & + "IS " & + NATURAL'IMAGE (COUNT_NBR_OF_READS) ); + END IF; + + END; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE2405B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2406a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2406a.ada new file mode 100644 index 000000000..3fbf03781 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2406a.ada @@ -0,0 +1,199 @@ +-- CE2406A.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: +-- FOR A DIRECT ACCESS FILE, CHECK THAT AFTER A READ, THE CURRENT +-- READ POSITION IS INCREMENTED BY ONE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- DIRECT_IO FILES. + +-- HISTORY: +-- ABW 08/20/82 +-- SPS 09/16/82 +-- SPS 11/09/82 +-- JBG 02/22/84 CHANGE TO .ADA TEST. +-- EG 05/16/85 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- GMT 08/05/87 REMOVED DEPENDENCE ON RESET AND ADDED CHECK FOR +-- USE_ERROR ON DELETE. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2406A IS + + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + FILE1 : FILE_TYPE; + INT : INTEGER := IDENT_INT (18); + BOOL : BOOLEAN := IDENT_BOOL (TRUE); + INT_ITEM1, INT_ITEM2 : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2406A", "CHECK THAT READ POSITION IS INCREMENTED " & + "BY ONE AFTER A READ"); + + -- CREATE AND INITIALIZE FILE1 + + BEGIN + + BEGIN + CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN NAME_ERROR | USE_ERROR => + NOT_APPLICABLE ("NAME_ERROR | USE_ERROR RAISED " & + "ON CREATE - 1"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2"); + RAISE INCOMPLETE; + END; + + BEGIN + WRITE (FILE1, INT); + WRITE (FILE1, 26); + WRITE (FILE1, 12); + WRITE (FILE1, 19); + WRITE (FILE1, INT); + WRITE (FILE1, 3); + + -- BEGIN TEST + + CLOSE (FILE1); + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON" & + "OPEN - 3"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON " & + "OPEN - 4"); + RAISE INCOMPLETE; + END; + + + IF INDEX(FILE1) /= POSITIVE_COUNT (IDENT_INT(1)) THEN + FAILED ("INITIAL INDEX VALUE INCORRECT - 5"); + ELSE + READ (FILE1, INT_ITEM1); + IF INDEX(FILE1) /= POSITIVE_COUNT(IDENT_INT(2)) THEN + FAILED ("INDEX VALUE NOT INCREMENTED - 6"); + ELSE + IF INT_ITEM1 /= IDENT_INT(18) THEN + FAILED ("READ INCORRECT VALUE - 7"); + END IF; + READ (FILE1, INT_ITEM1, 4); + IF INDEX(FILE1) /= + POSITIVE_COUNT (IDENT_INT(5)) THEN + FAILED ("INDEX VALUE NOT INCREMENTED " & + "WHEN TO IS SPECIFIED - 8"); + ELSE + IF INT_ITEM1 /= IDENT_INT(19) THEN + FAILED ("READ INCORRECT VALUE - 9"); + END IF; + READ (FILE1, INT_ITEM1); + IF INDEX(FILE1) /= + POSITIVE_COUNT(IDENT_INT(6)) THEN + FAILED ("INDEX VALUE NOT " & + "INCREMENTED WHEN " & + "LAST - 10"); + ELSIF INT_ITEM1 /= IDENT_INT(18) THEN + FAILED ("READ INCORRECT " & + "IN_FILE VALUE - 11"); + END IF; + END IF; + END IF; + END IF; + + CLOSE (FILE1); + BEGIN + OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON " & + "OPEN - 12"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON " & + "OPEN - 13"); + RAISE INCOMPLETE; + END; + + IF INDEX(FILE1) /= POSITIVE_COUNT(IDENT_INT(1)) THEN + FAILED ("INITIAL INDEX VALUE INCORRECT - 14"); + ELSE + READ (FILE1, INT_ITEM2); + IF INDEX(FILE1) /= POSITIVE_COUNT(IDENT_INT(2)) THEN + FAILED ("INDEX VALUE NOT INCREMENTED - 15"); + ELSE + IF INT_ITEM2 /= IDENT_INT(18) THEN + FAILED ("READ INCORRECT VALUE - 16"); + END IF; + READ (FILE1, INT_ITEM2, 4); + IF INDEX (FILE1) /= + POSITIVE_COUNT(IDENT_INT(5)) THEN + FAILED ("INDEX VALUE NOT INCREMENTED " & + "WHEN TO IS SPECIFIED - 17"); + ELSE + IF INT_ITEM2 /= IDENT_INT(19) THEN + FAILED ("INCORRECT VALUE - 18"); + END IF; + READ (FILE1, INT_ITEM2); + IF INDEX(FILE1) /= + POSITIVE_COUNT(IDENT_INT(6)) THEN + FAILED ("INDEX VALUE NOT " & + "INCREMENTED WHEN " & + "LAST - INOUT_FILE - 19"); + ELSIF INT_ITEM2 /= IDENT_INT(18) THEN + FAILED ("READ INCORRECT " & + "INOUT_FILE VALUE - 20"); + END IF; + END IF; + END IF; + END IF; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE2406A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2407a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2407a.ada new file mode 100644 index 000000000..ce55310db --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2407a.ada @@ -0,0 +1,110 @@ +-- CE2407A.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 WRITE RAISES MODE_ERROR WHEN THE CURRENT MODE +-- IS IN_FILE. + +-- 1) CHECK NON-TEMPORARY FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH OUT_FILE MODE AND OPEN WITH IN_FILE MODE FOR DIRECT +-- FILES. + +-- HISTORY: +-- ABW 08/20/82 +-- SPS 09/16/82 +-- SPS 11/09/82 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- GMT 08/06/86 REMOVED THE DEPENDENCE ON RESET AND MOVED THE CHECK +-- FOR TEMPORARY FILES INTO CE2407B.ADA. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2407A IS + + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + INCOMPLETE : EXCEPTION; + FILE1 : FILE_TYPE; + INT : INTEGER := IDENT_INT (18); + +BEGIN + TEST ("CE2407A", "CHECK THAT WRITE RAISES MODE_ERROR WHEN THE " & + "CURRENT MODE IS IN_FILE AND THE FILE IS " & + "A NON-TEMPORARY FILE"); + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE - 2"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE - 3"); + RAISE INCOMPLETE; + END; + + WRITE (FILE1, INT); + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE("USE_ERROR RAISED ON OPEN - 4"); + RAISE INCOMPLETE; + END; + + + + BEGIN + WRITE (FILE1,INT); + FAILED ("MODE_ERROR NOT RAISED ON WRITE - 5"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED ON WRITE - 6"); + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2407A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2407b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2407b.ada new file mode 100644 index 000000000..b97b76160 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2407b.ada @@ -0,0 +1,93 @@ +-- CE2407B.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 WRITE RAISES MODE_ERROR WHEN THE CURRENT MODE +-- IS IN_FILE. + +-- 2) CHECK TEMPORARY FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH OUT_FILE MODE AND RESET FROM OUT_FILE MODE TO +-- IN_FILE MODE. + +-- HISTORY: +-- GMT 08/06/86 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2407B IS + + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + INCOMPLETE : EXCEPTION; + FILE2 : FILE_TYPE; + INT : INTEGER := IDENT_INT (18); + +BEGIN + TEST ("CE2407B", "CHECK THAT WRITE RAISES MODE_ERROR WHEN THE " & + "CURRENT MODE IS IN_FILE AND THE FILE IS " & + "A TEMPORARY FILE"); + BEGIN + CREATE (FILE2, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE - 2"); + RAISE INCOMPLETE; + END; + + WRITE (FILE2, INT); + + BEGIN + RESET (FILE2, IN_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE("USE_ERROR RAISED ON RESET - 3"); + RAISE INCOMPLETE; + END; + + BEGIN + WRITE (FILE2, INT); + FAILED ("MODE_ERROR NOT RAISED ON WRITE - 4"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED ON WRITE - 5"); + END; + + CLOSE (FILE2); + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2407B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2408a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2408a.ada new file mode 100644 index 000000000..a6cf7d3b4 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2408a.ada @@ -0,0 +1,120 @@ +-- CE2408A.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 WRITE DOES NOT CAUSE AN EXCEPTION WHEN THE TO +-- PARAMETER IS GREATER THAN THE END POSITION. + +-- 1) FILE MODE IS OUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF DIRECT FILES WITH MODE OUT_FILE. + +-- HISTORY: +-- DLD 08/19/82 +-- SPS 11/09/82 +-- EG 05/16/85 +-- GMT 08/05/87 ADDED A CHECK FOR USE_ERROR ON DELETE AND REMOVED +-- THE OTHERS EXCEPTION AT THE BOTTOM OF THE FILE. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2408A IS + + PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER); + USE DIR_IO; + + DIR_FILE : FILE_TYPE; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2408A", "FOR FILES OF MODE OUT_FILE, CHECK THAT " & + "WRITE DOES NOT CAUSE AN EXCEPTION WHEN THE " & + """TO"" PARAMETER IS GREATER THAN THE END " & + "POSITION"); + + -- CREATE TEST FILE + + BEGIN + CREATE (DIR_FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH MODE " & + "OUT_FILE FOR DIR_IO - 1"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " & + "MODE OUT_FILE FOR DIR_IO - 2"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE WITH " & + "MODE OUT_FILE FOR DIR_IO - 3"); + RAISE INCOMPLETE; + END; + + -- FILL UP FILE + + WRITE (DIR_FILE, 3); + WRITE (DIR_FILE, 4); + WRITE (DIR_FILE, 5); + WRITE (DIR_FILE, 6); + + -- WRITE WHERE TO IS LARGER THAN END OF FILE + + BEGIN + WRITE (DIR_FILE, 9, 7); + EXCEPTION + WHEN OTHERS => + FAILED ("WRITE RAISED EXCEPTION WHEN TO " & + "PARAMETER WAS BEYOND END - 4"); + END; + + BEGIN + SET_INDEX (DIR_FILE, 11); + WRITE (DIR_FILE, 10); + EXCEPTION + WHEN OTHERS => + FAILED ("SET_INDEX/WRITE RAISED EXCEPTION WHEN TO " & + "PARAMETER EXCEEDS THE END POSITION - 5"); + END; + + -- DELETE TEST FILE + + BEGIN + DELETE (DIR_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2408A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2408b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2408b.ada new file mode 100644 index 000000000..7c2da6bb8 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2408b.ada @@ -0,0 +1,112 @@ +-- CE2408B.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 WRITE DOES NOT CAUSE AN EXCEPTION WHEN THE TO +-- PARAMETER IS GREATER THAN THE END POSITION. + +-- 2) FILE MODE IS INOUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF DIRECT FILES WITH MODE INOUT_FILE. + +-- HISTORY: +-- GMT 08/05/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2408B IS + + PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER); + USE DIR_IO; + + DIR_FILE : FILE_TYPE; + INCOMPLETE : EXCEPTION; + +BEGIN + TEST ("CE2408B", "FOR FILES OF MODE INOUT_FILE, CHECK THAT " & + "WRITE DOES NOT CAUSE AN EXCEPTION WHEN THE " & + """TO"" PARAMETER IS GREATER THAN THE END " & + "POSITION"); + BEGIN + CREATE (DIR_FILE, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " & + "MODE INOUT_FILE FOR DIR_IO - 1"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " & + "MODE INOUT_FILE FOR DIR_IO - 2"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE WITH " & + "MODE INOUT_FILE FOR DIR_IO - 3"); + RAISE INCOMPLETE; + END; + + -- FILL UP FILE + + WRITE (DIR_FILE, 3); + WRITE (DIR_FILE, 4); + WRITE (DIR_FILE, 5); + WRITE (DIR_FILE, 6); + + -- WRITE WHERE TO IS LARGER THAN END OF FILE + + BEGIN + WRITE (DIR_FILE, 9, 7); + EXCEPTION + WHEN OTHERS => + FAILED ("WRITE RAISED EXCEPTION WHEN TO " & + "PARAMETER WAS BEYOND END - 4"); + END; + + BEGIN + SET_INDEX (DIR_FILE, 11); + WRITE (DIR_FILE, 10); + EXCEPTION + WHEN OTHERS => + FAILED ("SET_INDEX/WRITE RAISED EXCEPTION WHEN TO " & + "PARAMETER EXCEEDS THE END POSITION - 5"); + END; + + -- DELETE TEST FILE + + BEGIN + DELETE (DIR_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2408B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2409a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2409a.ada new file mode 100644 index 000000000..e6e591f0e --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2409a.ada @@ -0,0 +1,113 @@ +-- CE2409A.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: +-- FOR DIRECT ACCESS FILES, CHECK THAT A WRITE TO A POSITION +-- GREATER THAN THE CURRENT END POSITION CAUSES THE WRITE +-- POSITION AND THE FILE SIZE TO BE INCREMENTED. + +-- 1) CHECK FILES OF MODE INOUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH INOUT_FILE MODE FOR DIRECT FILES. + +-- HISTORY: +-- ABW 08/27/82 +-- SPS 11/09/82 +-- SPS 03/18/83 +-- EG 05/16/85 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- GMT 08/05/87 REVISED EXCEPTION HANDLING, ADDED CHECK FOR WRITE +-- USING TO, AND MOVED OUT_FILE CASE TO CE2409B.ADA. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2409A IS + + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2409A", "CHECK THAT WRITE POSITION AND " & + "SIZE ARE INCREMENTED CORRECTLY FOR " & + "DIR FILES OF MODE INOUT_FILE"); + + BEGIN + CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE WITH INOUT_FILE MODE NOT " & + "SUPPORTED FOR DIR FILES - 1"); + RAISE INCOMPLETE; + END; + + DECLARE + INT : INTEGER := IDENT_INT (18); + TWO_C : COUNT := COUNT (IDENT_INT(2)); + THREE_PC : POSITIVE_COUNT + := POSITIVE_COUNT (IDENT_INT(3)); + FIVE_C : COUNT := COUNT (IDENT_INT(5)); + FIVE_PC : POSITIVE_COUNT + := POSITIVE_COUNT (IDENT_INT(5)); + SIX_PC : POSITIVE_COUNT + := POSITIVE_COUNT (IDENT_INT(6)); + BEGIN + WRITE (FILE1, INT); + WRITE (FILE1, INT); + IF INDEX (FILE1) /= THREE_PC THEN + FAILED ("INCORRECT INDEX VALUE - 1"); + END IF; + IF SIZE (FILE1) /= TWO_C THEN + FAILED ("INCORRECT SIZE VALUE - 2"); + END IF; + + WRITE (FILE1, INT, FIVE_PC); + IF INDEX (FILE1) /= SIX_PC THEN + FAILED ("INCORRECT INDEX VALUE - 3"); + END IF; + IF SIZE (FILE1) /= FIVE_C THEN + FAILED ("INCORRECT SIZE VALUE - 4"); + END IF; + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT ; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2409A ; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2409b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2409b.ada new file mode 100644 index 000000000..544819864 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2409b.ada @@ -0,0 +1,98 @@ +-- CE2409B.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: +-- FOR DIRECT ACCESS FILES, CHECK THAT A WRITE TO A POSITION +-- GREATER THAN THE CURRENT END POSITION CAUSES THE WRITE +-- POSITION AND THE FILE SIZE TO BE INCREMENTED. + +-- 2) CHECK FILES OF MODE OUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH MODE OUT_FILE FOR DIRECT FILES. + +-- HISTORY: +-- GMT 08/05/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2409B IS + + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2409B", "CHECK THAT WRITE POSITION AND " & + "SIZE ARE INCREMENTED APPROPRIATELY"); + BEGIN + CREATE (FILE1, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE NOT " & + "SUPPORTED FOR DIR FILES - 1"); + RAISE INCOMPLETE; + END; + + DECLARE + INT : INTEGER := IDENT_INT (18); + TWO_C : COUNT := COUNT (IDENT_INT(2)); + THREE_C : COUNT := COUNT (IDENT_INT(3)); + THREE_PC : POSITIVE_COUNT + := POSITIVE_COUNT (IDENT_INT(3)); + FOUR_PC : POSITIVE_COUNT + := POSITIVE_COUNT (IDENT_INT(4)); + BEGIN + WRITE (FILE1, INT); + WRITE (FILE1, INT); + IF INDEX (FILE1) /= THREE_PC THEN + FAILED ("INCORRECT VALUE FOR INDEX - 2"); + END IF; + IF SIZE (FILE1) /= TWO_C THEN + FAILED ("INCORRECT VALUE FOR SIZE - 3"); + END IF; + + WRITE (FILE1, INT); + IF INDEX (FILE1) /= FOUR_PC THEN + FAILED ("INCORRECT VALUE FOR INDEX - 4"); + END IF; + IF SIZE (FILE1) /= THREE_C THEN + FAILED ("INCORRECT VALUE FOR SIZE - 5"); + END IF; + + END; + + CLOSE (FILE1); + + RESULT ; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2409B ; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2410a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2410a.ada new file mode 100644 index 000000000..5029d1ec6 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2410a.ada @@ -0,0 +1,96 @@ +-- CE2410A.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 END_OF_FILE RAISES MODE_ERROR WHEN THE CURRENT +-- MODE IS OUT_FILE. + +-- 1) CHECK NON-TEMPORARY FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH OUT_FILE MODE FOR DIRECT FILES. + +-- HISTORY: +-- ABW 08/20/82 +-- SPS 09/16/82 +-- SPS 11/09/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- EG 11/02/84 +-- EG 05/16/85 +-- GMT 08/05/87 REVISED EXCEPTION HANDLING AND MOVED THE CASE FOR +-- TEMPORARY FILES INTO CE2410B.ADA. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2410A IS + + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + FILE1 : FILE_TYPE; + INT : INTEGER := IDENT_INT (18); + BOOL : BOOLEAN; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2410A", "CHECK THAT END_OF_FILE RAISES MODE_ERROR WHEN " & + "THE CURRENT MODE IS OUT_FILE AND THE FILE IS " & + "A NON-TEMPORARY FILE."); + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE NOT " & + "SUPPORTED FOR DIRECT FILES - 1"); + RAISE INCOMPLETE; + END; + + BEGIN + BOOL := END_OF_FILE (FILE1); + FAILED ("MODE_ERROR NOT RAISED ON END_OF_FILE - 2"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON " & + "END_OF_FILE - 3"); + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT ; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2410A ; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2410b.ada b/gcc/testsuite/ada/acats/tests/ce/ce2410b.ada new file mode 100644 index 000000000..665bc8efc --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2410b.ada @@ -0,0 +1,84 @@ +-- CE2410B.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 END_OF_FILE RAISES MODE_ERROR WHEN THE CURRENT +-- MODE IS OUT_FILE. + +-- 2) CHECK TEMPORARY FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH OUT_FILE MODE FOR DIRECT FILES. + +-- HISTORY: +-- GMT 08/05/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH DIRECT_IO; + +PROCEDURE CE2410B IS + + PACKAGE DIR IS NEW DIRECT_IO (INTEGER); + USE DIR; + FILE1 : FILE_TYPE; + INT : INTEGER := IDENT_INT (18); + BOOL : BOOLEAN; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE2410B", "CHECK THAT END_OF_FILE RAISES MODE_ERROR WHEN " & + "THE CURRENT MODE IS OUT_FILE AND THE FILE IS " & + "A TEMPORARY FILE."); + + BEGIN + CREATE (FILE1, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("CREATE WITH OUT_FILE MODE NOT " & + "SUPPORTED FOR DIRECT FILES - 1"); + RAISE INCOMPLETE; + END; + + BEGIN + BOOL := END_OF_FILE (FILE1); + FAILED ("MODE_ERROR NOT RAISED ON END_OF_FILE - 2"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED ON " & + "END_OF_FILE - 3"); + END; + + CLOSE (FILE1); + + RESULT ; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE2410B ; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce2411a.ada b/gcc/testsuite/ada/acats/tests/ce/ce2411a.ada new file mode 100644 index 000000000..9f735df68 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce2411a.ada @@ -0,0 +1,207 @@ +-- CE2411A.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 INDEX RETURNS THE CORRECT INDEX POSITION AND THAT +-- SET_INDEX CORRECTLY SETS THE INDEX POSITION IN A DIRECT FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- DIRECT FILES. + +-- HISTORY: +-- TBN 10/01/86 +-- JLH 08/07/87 REVISED EXTERNAL FILE NAME, REMOVED CHECK FOR +-- NAME_ERROR ON OPEN CALLS, AND REMOVED +-- UNNECESSARY CODE. + +WITH DIRECT_IO; +WITH REPORT; USE REPORT; +PROCEDURE CE2411A IS + + PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER); + USE DIR_IO; + + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + +BEGIN + TEST ("CE2411A", "CHECK THAT INDEX RETURNS THE CORRECT INDEX " & + "POSITION AND THAT SET_INDEX CORRECTLY SETS " & + "THE INDEX POSITION IN A DIRECT FILE"); + + + -- INITIALIZE TEST FILE + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED DURING CREATE " & + "WITH OUT_FILE MODE FOR DIR_IO"); + RAISE INCOMPLETE; + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED DURING CREATE " & + "WITH OUT_FILE MODE FOR DIR_IO"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNKNOWN EXCEPTION RAISED DURING CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + IF INDEX (FILE1) /= 1 THEN + FAILED ("STARTING INDEX POSITION IS INCORRECT - 1"); + RAISE INCOMPLETE; + END IF; + FOR I IN 1 .. 10 LOOP + WRITE (FILE1, I); + END LOOP; + IF INDEX (FILE1) /= 11 THEN + FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 2"); + END IF; + WRITE (FILE1, 20, 20); + IF INDEX (FILE1) /= 21 THEN + FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 3"); + END IF; + SET_INDEX (FILE1, 11); + IF INDEX (FILE1) /= 11 THEN + FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - 4"); + END IF; + WRITE (FILE1, 11); + IF INDEX (FILE1) /= 12 THEN + FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 5"); + END IF; + END; + + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED DURING OPEN INFILE " & + "FOR DIR_IO"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNKNOWN EXCEPTION RAISED DURING OPEN INFILE"); + RAISE INCOMPLETE; + END; + + DECLARE + NUM : INTEGER; + BEGIN + IF INDEX (FILE1) /= 1 THEN + FAILED ("STARTING INDEX POSITION IS INCORRECT - 7"); + RAISE INCOMPLETE; + END IF; + FOR I IN 1 .. 10 LOOP + READ (FILE1, NUM); + IF NUM /= I THEN + FAILED ("FILE CONTAINS INCORRECT DATA - 8"); + END IF; + IF INDEX (FILE1) /= POSITIVE_COUNT(I + 1) THEN + FAILED ("INDEX DOES NOT RETURN THE CORRECT " & + "POSITION - 9"); + END IF; + END LOOP; + SET_INDEX (FILE1, 20); + IF INDEX (FILE1) /= 20 THEN + FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - " & + "10"); + END IF; + READ (FILE1, NUM, 20); + IF NUM /= 20 THEN + FAILED ("FILE CONTAINS INCORRECT DATA - 11"); + END IF; + IF INDEX (FILE1) /= 21 THEN + FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 12"); + END IF; + SET_INDEX (FILE1, 1); + IF INDEX (FILE1) /= 1 THEN + FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - " & + "13"); + END IF; + END; + + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED DURING OPEN " & + "INOUT_FILE FOR DIR_IO"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNKNOWN EXCEPTION RAISED DURING OPEN INOUT"); + RAISE INCOMPLETE; + END; + + DECLARE + NUM : INTEGER; + BEGIN + IF INDEX (FILE1) /= 1 THEN + FAILED ("STARTING INDEX POSITION IS INCORRECT - 15"); + RAISE INCOMPLETE; + END IF; + FOR I IN 1 .. 10 LOOP + READ (FILE1, NUM); + IF NUM /= I THEN + FAILED ("FILE CONTAINS INCORRECT DATA - 16"); + END IF; + IF INDEX (FILE1) /= POSITIVE_COUNT(I + 1) THEN + FAILED ("INDEX DOES NOT RETURN THE CORRECT " & + "POSITION - 17"); + END IF; + END LOOP; + SET_INDEX (FILE1, 20); + IF INDEX (FILE1) /= 20 THEN + FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - " & + "18"); + END IF; + WRITE (FILE1, 12, 12); + IF INDEX (FILE1) /= 13 THEN + FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 19"); + END IF; + SET_INDEX (FILE1, 1); + IF INDEX (FILE1) /= 1 THEN + FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - " & + "20"); + END IF; + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; +END CE2411A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3002b.tst b/gcc/testsuite/ada/acats/tests/ce/ce3002b.tst new file mode 100644 index 000000000..7dcc28fe0 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3002b.tst @@ -0,0 +1,84 @@ +-- CE3002B.TST + +-- 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 COUNT IS A VISIBLE TYPE, THAT COUNT'FIRST IS 0, +-- THAT POSITIVE_COUNT IS A SUBTYPE OF COUNT, THAT +-- POSITIVE_COUNT'FIRST IS 1, THAT POSITIVE_COUNT'LAST +-- EQUALS COUNT'LAST, AND COUNT'LAST HAS A SPECIFIED +-- IMPLEMENTATION-DEPENDENT VALUE. + +-- HISTORY: +-- SPS 09/30/82 +-- SPS 11/09/82 +-- JBG 03/16/83 +-- JLH 08/07/87 REVISED VALUES USED IN COUNT AND POSITIVE_COUNT +-- TO THE INTEGER VALUE 1. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3002B IS +BEGIN + + TEST ("CE3002B", "CHECK THAT COUNT IS VISIBLE, COUNT'FIRST IS " & + "0, POSITIVE_COUNT IS A SUBTYPE OF COUNT, " & + "POSITIVE_COUNT'FIRST IS 1, POSITIVE_COUNT'" & + "LAST EQUALS COUNT'LAST, AND COUNT'LAST " & + "HAS A SPECIFIED VALUE"); + + DECLARE + X : COUNT; + A : POSITIVE_COUNT; + BEGIN + IF COUNT'FIRST /= COUNT(IDENT_INT (0)) THEN + FAILED ("COUNT'FIRST NOT 0; IS" & + COUNT'IMAGE(COUNT'FIRST)); + END IF; + + IF POSITIVE_COUNT'FIRST /= POSITIVE_COUNT (IDENT_INT (1)) THEN + FAILED ("POSITIVE_COUNT'FIRST NOT 1; IS" & + COUNT'IMAGE(POSITIVE_COUNT'FIRST)); + END IF; + + IF POSITIVE_COUNT'LAST /= COUNT'LAST THEN + FAILED ("POSITIVE_COUNT'LAST NOT EQUAL COUNT'LAST"); + END IF; + + IF COUNT'LAST /= $COUNT_LAST THEN + FAILED ("COUNT'LAST NOT $COUNT_LAST; IS" & + COUNT'IMAGE(COUNT'LAST)); + END IF; + + X := POSITIVE_COUNT (IDENT_INT (1)); + A := X; + A := COUNT (IDENT_INT (1)); + X := A; + END; + + RESULT; + +END CE3002B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3002c.tst b/gcc/testsuite/ada/acats/tests/ce/ce3002c.tst new file mode 100644 index 000000000..c240907f8 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3002c.tst @@ -0,0 +1,69 @@ +-- CE3002C.TST + +-- 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 FIELD IS A SUBTYPE OF INTEGER, FIELD'FIRST = 0, AND +-- FIELD'LAST HAS A SPECIFIED IMPLEMENTATION-DEPENDENT VALUE. + +-- HISTORY: +-- SPS 09/30/82 +-- SPS 11/09/82 +-- JBG 03/16/83 +-- JLH 08/07/87 REVISED VALUES USED IN INTEGER AND FIELD TO THE +-- INTEGER VALUE 1. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3002C IS +BEGIN + + TEST ("CE3002C", "CHECK THAT FIELD IS A SUBTYPE OF INTEGER AND " & + "FIELD'FIRST = 0"); + + DECLARE + A : INTEGER; + B : FIELD; + BEGIN + IF FIELD'FIRST /= IDENT_INT (0) THEN + FAILED ("FIELD'FIRST NOT 0; IS" & + FIELD'IMAGE(FIELD'FIRST)); + END IF; + + IF FIELD'LAST /= $FIELD_LAST THEN + FAILED ("FIELD'LAST NOT $FIELD_LAST; IS" & + FIELD'IMAGE(FIELD'LAST)); + END IF; + + A := IDENT_INT (1); + B := A; + B := IDENT_INT (1); + A := B; + END; + + RESULT; + +END CE3002C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3002d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3002d.ada new file mode 100644 index 000000000..3d1976014 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3002d.ada @@ -0,0 +1,61 @@ +-- CE3002D.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 NUMBER_BASE IS A SUBTYPE OF INTEGER, WITH +-- NUMBER_BASE'FIRST EQUAL 2 AND NUMBER_BASE'LAST EQUAL 16. + +-- SPS 10/1/82 + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3002D IS +BEGIN + + TEST ("CE3002D", "CHECK THAT NUMBER_BASE IS A SUBTYPE " & + "OF INTEGER WITH NUMBER_BASE'FIRST = 2 " & + "AND NUMBER_BASE'LAST = 16"); + + DECLARE + X : INTEGER; + Y : NUMBER_BASE; + BEGIN + IF NUMBER_BASE'FIRST /= IDENT_INT (2) THEN + FAILED ("NUMBER_BASE'FIRST NOT 2"); + END IF; + + IF NUMBER_BASE'LAST /= IDENT_INT (16) THEN + FAILED ("NUMBER_BASE'LAST NOT 16"); + END IF; + + X := IDENT_INT (3); + Y := X; + Y := IDENT_INT (8); + X := Y; + END; + +RESULT; +END CE3002D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3002f.ada b/gcc/testsuite/ada/acats/tests/ce/ce3002f.ada new file mode 100644 index 000000000..ad15ecdee --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3002f.ada @@ -0,0 +1,55 @@ +-- CE3002F.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 UNBOUNDED HAS TYPE COUNT AND VALUE ZERO. + +-- SPS 10/1/82 +-- SPS 11/9/82 + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3002F IS +BEGIN + + TEST ("CE3002F", "CHECK THAT UNBOUNDED HAS TYPE COUNT AND " & + "VALUE ZERO"); + + DECLARE + Z : COUNT := 0; + BEGIN + IF UNBOUNDED /= COUNT(IDENT_INT(0)) THEN + FAILED ("UNBOUNDED NOT 0"); + END IF; + + IF UNBOUNDED /= Z THEN + FAILED ("UNBOUNDED NOT COUNT"); + END IF; + END; + + RESULT; + +END CE3002F; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3102a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3102a.ada new file mode 100644 index 000000000..ec5c5001d --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3102a.ada @@ -0,0 +1,151 @@ +-- CE3102A.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 STATUS_ERROR IS RAISED BY CREATE AND OPEN +-- IF THE GIVEN TEXT FILES ARE ALREADY OPEN. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH MODE OUT_FILE FOR TEXT FILES. + +-- HISTORY: +-- ABW 08/24/82 +-- SPS 09/16/82 +-- SPS 11/09/82 +-- JBG 07/25/83 +-- JLH 08/07/87 COMPLETE REVISION OF TEST. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3102A IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + +BEGIN + + TEST ("CE3102A" , "CHECK THAT STATUS_ERROR IS RAISED " & + "APPROPRIATELY FOR TEXT FILES"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + CREATE (FILE, OUT_FILE); + FAILED ("STATUS_ERROR NOT RAISED FOR CREATE - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE - 1"); + END; + + BEGIN + CREATE (FILE, IN_FILE); + FAILED ("STATUS_ERROR NOT RAISED FOR CREATE - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE - 2"); + END; + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + FAILED ("STATUS_ERROR NOT RAISED FOR CREATE - 3"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE - 3"); + END; + + BEGIN + OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME); + FAILED ("STATUS_ERROR NOT RAISED FOR OPEN - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR OPEN - 1"); + END; + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + FAILED ("STATUS_ERROR NOT RAISED FOR OPEN - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR OPEN - 2"); + END; + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME (2, "CE3102A")); + FAILED ("STATUS_ERROR NOT RAISED FOR OPEN - 3"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR OPEN - 3"); + END; + + BEGIN + CREATE (FILE, IN_FILE, LEGAL_FILE_NAME (2, "CE3102A")); + FAILED ("STATUS_ERROR NOT RAISED FOR OPEN - 4"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR OPEN - 4"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3102A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3102b.tst b/gcc/testsuite/ada/acats/tests/ce/ce3102b.tst new file mode 100644 index 000000000..2383d45d8 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3102b.tst @@ -0,0 +1,184 @@ +-- CE3102B.TST + +-- 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 FOR TEXT FILES NAME_ERROR IS RAISED BY CREATE AND +-- OPEN IF THE GIVEN NAME STRING DOES NOT ALLOW THE IDENTIFICATION +-- OF AN EXTERNAL FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE FOR TEXT_IO. + +-- HISTORY: +-- ABW 08/24/82 +-- JBG 03/16/83 +-- EG 05/30/85 +-- JLH 08/12/87 REMOVED UNNECESSARY CODE, ADDED NEW CASES FOR OPEN, +-- AND REMOVED DEPENDENCE ON DELETE. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3102B IS + + FILE1, FILE2 : FILE_TYPE; + FILE_NAME_OK : BOOLEAN := FALSE; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3102B", "CHECK THAT NAME_ERROR IS RAISED " & + "APPROPRIATELY"); + + -- CHECK THAT A LEGAL FILE NAME IS OK SO TEST IS VALID + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "OF ASSUMED VALID FILE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "OF ASSUMED VALID FILE"); + RAISE INCOMPLETE; + END; + + BEGIN + DELETE (FILE1); + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + FAILED ("FILE STILL EXISTS AFTER DELETE"); + EXCEPTION + WHEN NAME_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "IN_FILE MODE"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT OPEN"); + END; + + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + -- PERFORM VARIOUS CHECKS + + BEGIN + OPEN (FILE2, IN_FILE, LEGAL_FILE_NAME(2)); + FAILED ("NO EXCEPTION FOR NON-EXISTENT FILE - IN_FILE"); + EXCEPTION + WHEN NAME_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR OPEN OF " & + "NON-EXISTENT FILE - IN_FILE"); + END; + + BEGIN + OPEN (FILE2, OUT_FILE, LEGAL_FILE_NAME(3)); + FAILED ("NO EXCEPTION FOR NON-EXISTENT FILE - OUT_FILE"); + EXCEPTION + WHEN NAME_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR OPEN FOR " & + "NON-EXISTENT FILE - OUT_FILE"); + END; + + BEGIN + CREATE (FILE1, NAME => "$ILLEGAL_EXTERNAL_FILE_NAME1"); + FAILED ("NO EXCEPTION RAISED FOR " & + "$ILLEGAL_EXTERNAL_FILE_NAME1 - CREATE"); + EXCEPTION + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED FOR " & + "$ILLEGAL_EXTERNAL_FILE_NAME1 - CREATE"); + WHEN NAME_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR " & + "$ILLEGAL_EXTERNAL_FILE_NAME1 - CREATE"); + END; + + BEGIN + CREATE (FILE2, NAME => "$ILLEGAL_EXTERNAL_FILE_NAME2"); + FAILED ("NO EXCEPTION RAISED FOR " & + "$ILLEGAL_EXTERNAL_FILE_NAME2 - CREATE"); + EXCEPTION + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED FOR " & + "$ILLEGAL_EXTERNAL_FILE_NAME2 - CREATE"); + WHEN NAME_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR " & + "$ILLEGAL_EXTERNAL_FILE_NAME2 - CREATE"); + END; + + BEGIN + OPEN (FILE2, IN_FILE, + NAME => "$ILLEGAL_EXTERNAL_FILE_NAME1"); + FAILED ("NO EXCEPTION RAISED FOR " & + "$ILLEGAL_EXTERNAL_FILE_NAME1 - OPEN"); + EXCEPTION + WHEN USE_ERROR => + FAILED ("USE ERROR RAISED FOR " & + "$ILLEGAL_EXTERNAL_FILE_NAME1 - OPEN"); + WHEN NAME_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR " & + "$ILLEGAL_EXTERNAL_FILE_NAME1 - OPEN"); + END; + + BEGIN + OPEN (FILE1, IN_FILE, + NAME => "$ILLEGAL_EXTERNAL_FILE_NAME2"); + FAILED ("NO EXCEPTION RAISED FOR " & + "$ILLEGAL_EXTERNAL_FILE_NAME2 - OPEN"); + EXCEPTION + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED FOR " & + "$ILLEGAL_EXTERNAL_FILE_NAME2 - OPEN"); + WHEN NAME_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR " & + "$ILLEGAL_EXTERNAL_FILE_NAME2 - OPEN"); + END; + + RESULT; + +EXCEPTION + + WHEN INCOMPLETE => + RESULT; + +END CE3102B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3102d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3102d.ada new file mode 100644 index 000000000..0f58c1976 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3102d.ada @@ -0,0 +1,145 @@ +-- CE3102D.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 STATUS_ERROR IS RAISED BY CLOSE, DELETE, RESET, MODE, +-- NAME, AND FORM IF THE GIVEN TEXT FILES ARE NOT OPEN. + +-- HISTORY: +-- JLH 08/10/87 CREATED ORIGINAL TEST. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3102D IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + FT : FILE_TYPE; + +BEGIN + + TEST ("CE3102D" , "CHECK THAT STATUS_ERROR IS RAISED " & + "APPROPRIATELY FOR TEXT FILES"); + + BEGIN + CREATE (FT); + CLOSE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR CREATE"); + END; + + BEGIN + RESET (FT); + FAILED ("STATUS_ERROR NOT RAISED FOR RESET"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED FOR RESET OF CLOSED FILE"); + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR RESET"); + END; + + BEGIN + DECLARE + MD : FILE_MODE := MODE (FT); + BEGIN + FAILED ("STATUS_ERROR NOT RAISED FOR MODE"); + END; + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED FOR MODE OF CLOSED FILE"); + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR MODE"); + END; + + BEGIN + DECLARE + NM : CONSTANT STRING := NAME (FT); + BEGIN + FAILED ("STATUS_ERROR NOT RAISED FOR NAME"); + END; + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED FOR NAME OF CLOSED FILE"); + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR NAME"); + END; + + BEGIN + DECLARE + FM : CONSTANT STRING := FORM (FT); + BEGIN + FAILED ("STATUS_ERROR NOT RAISED FOR FORM"); + END; + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED FOR FORM OF CLOSED FILE"); + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR FORM"); + END; + + BEGIN + CLOSE (FT); + FAILED ("STATUS_ERROR NOT RAISED FOR CLOSE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED WHEN CLOSING CLOSED FILE"); + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR CLOSE"); + END; + + BEGIN + DELETE (FT); + FAILED ("STATUS_ERROR NOT RAISED FOR DELETE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED FOR DELETE OF CLOSED FILE"); + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR DELETE"); + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3102D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3102e.ada b/gcc/testsuite/ada/acats/tests/ce/ce3102e.ada new file mode 100644 index 000000000..c971abd48 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3102e.ada @@ -0,0 +1,63 @@ +-- CE3102E.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 USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE +-- IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR CREATE BY THE +-- IMPLEMENTATION FOR TEXT FILES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT IN_FILE MODE WITH CREATE FOR TEXT FILES. + +-- HISTORY: +-- JLH 08/12/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3102E IS + + FILE1 : FILE_TYPE; + +BEGIN + + TEST ("CE3102E", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " & + "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " & + "OF CREATE FOR TEXT FILES"); + + BEGIN + CREATE (FILE1, IN_FILE); + CLOSE (FILE1); + NOT_APPLICABLE ("CREATE WITH MODE IN_FILE ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + END; + + RESULT; + +END CE3102E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3102f.ada b/gcc/testsuite/ada/acats/tests/ce/ce3102f.ada new file mode 100644 index 000000000..d87b80ae4 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3102f.ada @@ -0,0 +1,130 @@ +-- CE3102F.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 USE_ERROR IS RAISED WHEN AN EXTERNAL FILE +-- CANNOT BE RESET. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES, BUT DO NOT SUPPORT RESET OF EXTERNAL FILES. + +-- HISTORY: +-- JLH 08/12/87 CREATED ORIGINAL TEST. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3102F IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + +BEGIN + + TEST ("CE3102F", "CHECK THAT USE_ERROR IS RAISED WHEN AN " & + "EXTERNAL FILE CANNOT BE RESET"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (FILE); + NOT_APPLICABLE ("RESET FOR OUT_FILE MODE ALLOWED - 1"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET - 1"); + END; + + PUT (FILE, "HELLO"); + + BEGIN + RESET (FILE, IN_FILE); + NOT_APPLICABLE ("RESET FROM OUT_FILE TO IN_FILE MODE " & + "ALLOWED - 1"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RASIED FOR RESET - 2"); + END; + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("TEXT_IO NOT SUPPORTED FOR IN_FILE " & + "OPEN"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (FILE); + NOT_APPLICABLE ("RESET FOR IN_FILE MODE ALLOWED - 2"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET - 3"); + END; + + BEGIN + RESET (FILE, OUT_FILE); + NOT_APPLICABLE ("RESET FROM IN_FILE TO OUT_FILE MODE " & + "ALLOWED - 2"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET - 4"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3102F; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3102g.ada b/gcc/testsuite/ada/acats/tests/ce/ce3102g.ada new file mode 100644 index 000000000..a60f50f22 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3102g.ada @@ -0,0 +1,84 @@ +-- CE3102G.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 USE_ERROR IS RAISED WHEN AN EXTERNAL FILE +-- CANNOT BE DELETED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES, BUT DO NOT SUPPORT DELETION OF EXTERNAL FILES. + +-- HISTORY: +-- JLH 08/12/87 CREATED ORIGINAL TEST. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3102G IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + VAR1 : CHARACTER := 'A'; + +BEGIN + + TEST ("CE3102G" , "CHECK THAT USE_ERROR IS RAISED WHEN AN " & + "EXTERNAL FILE CANNOT BE DELETED"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + WHEN OTHERS => + NOT_APPLICABLE ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, VAR1); + + BEGIN + DELETE (FILE); + NOT_APPLICABLE ("DELETION OF EXTERNAL FILES ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR DELETE"); + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3102G; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3102h.ada b/gcc/testsuite/ada/acats/tests/ce/ce3102h.ada new file mode 100644 index 000000000..152b6eabc --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3102h.ada @@ -0,0 +1,116 @@ +-- CE3102H.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 MODE_ERROR IS RAISED WHEN ATTEMPTING TO CHANGE +-- THE MODE OF A FILE SERVING AS THE CURRENT DEFAULT INPUT +-- OR DEFAULT OUTPUT FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JLH 08/12/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3102H IS + + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + ITEM : CHARACTER := 'A'; + +BEGIN + + TEST ("CE3102H", "CHECK THAT MODE_ERROR IS RAISED WHEN " & + "ATTEMPTING TO CHANGE THE MODE OF A FILE " & + "SERVING AS THE CURRENT DEFAULT INPUT OR " & + "DEFAULT OUTPUT FILE"); + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + SET_OUTPUT (FILE1); + + BEGIN + RESET (FILE1, IN_FILE); + FAILED ("MODE_ERROR NOT RAISED FOR RESET"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET"); + END; + + SET_OUTPUT (STANDARD_OUTPUT); + + PUT (FILE1, ITEM); + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN"); + RAISE INCOMPLETE; + END; + + SET_INPUT (FILE1); + + BEGIN + RESET (FILE1, OUT_FILE); + FAILED ("MODE_ERROR NOT RAISED FOR RESET"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET"); + END; + + SET_INPUT (STANDARD_INPUT); + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3102H; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3102i.ada b/gcc/testsuite/ada/acats/tests/ce/ce3102i.ada new file mode 100644 index 000000000..cc126bc7e --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3102i.ada @@ -0,0 +1,63 @@ +-- CE3102I.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 USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE +-- OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR CREATE BY THE +-- IMPLEMENTATION FOR TEXT_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT OUT_FILE FOR CREATE FOR TEXT_IO. + +-- HISTORY: +-- JLH 08/12/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3102I IS + + FILE1 : FILE_TYPE; + +BEGIN + + TEST ("CE3102I", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " & + "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " & + "OF CREATE FOR TEXT_IO"); + + BEGIN + CREATE (FILE1, OUT_FILE); + CLOSE (FILE1); + NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + END; + + RESULT; + +END CE3102I; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3102j.ada b/gcc/testsuite/ada/acats/tests/ce/ce3102j.ada new file mode 100644 index 000000000..ce1b5f689 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3102j.ada @@ -0,0 +1,98 @@ +-- CE3102J.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 USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE +-- IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE +-- IMPLEMENTATION FOR TEXT_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT IN_FILE MODE FOR OPEN FOR TEXT_IO. + +-- HISTORY: +-- JLH 08/12/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3102J IS + + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + RAISED_USE_ERROR : BOOLEAN := FALSE; + VAR1 : CHARACTER := 'A'; + +BEGIN + + TEST ("CE3102J", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " & + "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " & + "OF OPEN FOR TEXT_IO"); + BEGIN + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE1, VAR1); + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + NOT_APPLICABLE ("OPEN FOR IN_FILE MODE ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + END; + + IF IS_OPEN (FILE1) THEN + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END IF; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3102J; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3102k.ada b/gcc/testsuite/ada/acats/tests/ce/ce3102k.ada new file mode 100644 index 000000000..151a4d687 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3102k.ada @@ -0,0 +1,98 @@ +-- CE3102K.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 USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE +-- OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE +-- IMPLEMENTATION FOR TEXT_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT +-- SUPPORT OUT_FILE MODE FOR OPEN FOR TEXT_IO. + +-- HISTORY: +-- JLH 08/12/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3102K IS + + FILE1 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + RAISED_USE_ERROR : BOOLEAN := FALSE; + VAR1 : CHARACTER := 'A'; + +BEGIN + + TEST ("CE3102K", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " & + "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " & + "OF OPEN FOR TEXT_IO"); + BEGIN + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE1, VAR1); + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, OUT_FILE, LEGAL_FILE_NAME); + NOT_APPLICABLE ("OPEN FOR OUT_FILE MODE ALLOWED"); + EXCEPTION + WHEN USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + END; + + IF IS_OPEN (FILE1) THEN + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END IF; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3102K; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3103a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3103a.ada new file mode 100644 index 000000000..7b09a7727 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3103a.ada @@ -0,0 +1,216 @@ +-- CE3103A.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 THE PAGE AND LINE LENGTH OF TEXT FILES ARE ZERO +-- AFTER A CREATE, OPEN, OR RESET TO OUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILE. + +-- HISTORY: +-- ABW 08/24/82 +-- SPS 09/16/82 +-- SPS 11/09/82 +-- SPS 01/18/83 +-- EG 11/02/84 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 08/13/87 REVISED TEST TO INCLUDE CASES TO RESET THE FILE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3103A IS + + SUBTEST : EXCEPTION; + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + ZERO : CONSTANT COUNT := COUNT(IDENT_INT(0)); + TWO : CONSTANT COUNT := COUNT (IDENT_INT(2)); + FIVE : CONSTANT COUNT := COUNT (IDENT_INT(5)); + +BEGIN + + TEST ("CE3103A" , "CHECK THAT PAGE AND LINE LENGTH " & + "ARE SET TO ZERO AFTER CREATE, " & + "OPEN, OR RESET"); + +BEGIN + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + END; + + IF LINE_LENGTH (FILE) /= ZERO THEN + FAILED ("LINE_LENGTH FOR CREATE IS NOT ZERO"); + END IF; + IF PAGE_LENGTH (FILE) /= ZERO THEN + FAILED ("PAGE_LENGTH FOR CREATE IS NOT ZERO"); + END IF; + + SET_LINE_LENGTH (FILE, TWO); + SET_PAGE_LENGTH (FILE, FIVE); + + PUT_LINE (FILE, "HI"); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN"); + RAISE INCOMPLETE; + END; + + IF LINE_LENGTH (FILE) /= ZERO THEN + FAILED ("LINE_LENGTH FOR OPEN IS NOT ZERO"); + END IF; + IF PAGE_LENGTH (FILE) /= ZERO THEN + FAILED ("PAGE_LENGTH FOR OPEN IS NOT ZERO"); + END IF; + + SET_LINE_LENGTH (FILE, TWO); + SET_PAGE_LENGTH (FILE, TWO); + + PUT_LINE (FILE, "HI"); + + BEGIN + BEGIN + RESET (FILE, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + RAISE SUBTEST; + END; + + IF LINE_LENGTH (FILE) /= ZERO THEN + FAILED ("LINE_LENGTH FOR RESET TO OUT_FILE IS NOT " & + "ZERO - 1"); + END IF; + IF PAGE_LENGTH (FILE) /= ZERO THEN + FAILED ("PAGE_LENGTH FOR RESET TO OUT_FILE IS NOT " & + "ZERO - 1"); + END IF; + EXCEPTION + WHEN SUBTEST => + NULL; + END; + + SET_LINE_LENGTH (FILE, FIVE); + SET_PAGE_LENGTH (FILE, FIVE); + + PUT_LINE (FILE, "HELLO"); + + IF LINE_LENGTH (FILE) /= 5 THEN + FAILED ("LINE_LENGTH FOR RESET IN OUT_FILE, PLUS HELLO " & + "IS NOT FIVE"); + END IF; + IF PAGE_LENGTH (FILE) /= 5 THEN + FAILED ("PAGE_LENGTH FOR RESET IN OUT_FILE, PLUS HELLO " & + "IS NOT FIVE"); + END IF; + + BEGIN + BEGIN + RESET (FILE); + EXCEPTION + WHEN USE_ERROR => + RAISE SUBTEST; + END; + + IF LINE_LENGTH (FILE) /= ZERO THEN + FAILED ("LINE_LENGTH FOR RESET IS NOT ZERO"); + END IF; + IF PAGE_LENGTH (FILE) /= ZERO THEN + FAILED ("PAGE_LENGTH FOR RESET IS NOT ZERO"); + END IF; + EXCEPTION + WHEN SUBTEST => + NULL; + END; + + SET_LINE_LENGTH (FILE, FIVE); + SET_PAGE_LENGTH (FILE, FIVE); + + PUT_LINE (FILE, "HELLO"); + + IF LINE_LENGTH (FILE) /= 5 THEN + FAILED ("LINE_LENGTH FOR RESET PLUS HELLO"); + END IF; + IF PAGE_LENGTH (FILE) /= 5 THEN + FAILED ("PAGE_LENGTH FOR RESET PLUS HELLO"); + END IF; + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + RAISE INCOMPLETE; + END; + + BEGIN + RESET (FILE, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + RAISE INCOMPLETE; + END; + + IF LINE_LENGTH (FILE) /= ZERO THEN + FAILED ("LINE_LENGTH FOR RESET TO OUT_FILE IS NOT ZERO - 2"); + END IF; + IF PAGE_LENGTH (FILE) /= ZERO THEN + FAILED ("PAGE_LENGTH FOR RESET TO OUT_FILE IS NOT ZERO - 2"); + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + +EXCEPTION + WHEN INCOMPLETE => + NULL; +END; + +RESULT; + +END CE3103A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3104a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3104a.ada new file mode 100644 index 000000000..4725f2473 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3104a.ada @@ -0,0 +1,231 @@ +-- CE3104A.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 THE CURRENT COLUMN, LINE, AND PAGE NUMBERS OF +-- TEXT FILES ARE SET TO ONE AFTER A CREATE, OPEN, OR RESET. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/24/82 +-- SPS 09/16/82 +-- SPS 11/09/82 +-- JBG 03/16/83 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 08/13/87 CHANGED FAILED MESSAGES AND ADDED SUBTEST +-- EXCEPTION. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3104A IS + + INCOMPLETE, SUBTEST : EXCEPTION; + FILE, FT : FILE_TYPE; + ONE : CONSTANT POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1)); + CHAR : CHARACTER; + +BEGIN + + TEST ("CE3104A" , "CHECK THAT COLUMN, LINE, AND " & + "PAGE NUMBERS ARE ONE AFTER A " & + "CREATE, OPEN, OR RESET"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + IF COL (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM COLUMN AFTER CREATE"); + END IF; + IF LINE (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM LINE AFTER CREATE"); + END IF; + IF PAGE (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM PAGE AFTER CREATE"); + END IF; + + NEW_PAGE (FILE); + NEW_LINE (FILE); + PUT (FILE, "STRING"); + + CLOSE (FILE); + + BEGIN + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + RAISE SUBTEST; + END; + + IF COL (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM COLUMN AFTER " & + "OPEN - IN_FILE"); + END IF; + IF LINE (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM LINE AFTER " & + "OPEN - IN_FILE"); + END IF; + IF PAGE (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM PAGE AFTER " & + "OPEN - IN_FILE"); + END IF; + + GET (FILE, CHAR); -- SETS PAGE, LINE, AND COL /= 1 + + BEGIN + RESET (FILE); + EXCEPTION + WHEN USE_ERROR => + CLOSE (FILE); + RAISE SUBTEST; + END; + + IF COL (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM COLUMN AFTER RESET"); + END IF; + IF LINE (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM LINE AFTER RESET"); + END IF; + IF PAGE (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM PAGE AFTER RESET"); + END IF; + + GET (FILE, CHAR); -- CHANGES LINE, PAGE, COL; STILL IN_FILE + + BEGIN + RESET (FILE,OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + CLOSE (FILE); + RAISE SUBTEST; + END; + + IF COL (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM COLUMN AFTER RESET " & + "TO OUT_FILE"); + END IF; + IF LINE (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM LINE AFTER RESET " & + "TO OUT_FILE"); + END IF; + IF PAGE (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM PAGE AFTER RESET " & + "TO OUT_FILE"); + END IF; + + CLOSE (FILE); + + EXCEPTION + WHEN SUBTEST => + NULL; + END; + + BEGIN + BEGIN + OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + RAISE SUBTEST; + END; + + IF COL (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM COLUMN AFTER OPEN " & + "TO OUT_FILE"); + END IF; + IF LINE (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM LINE AFTER OPEN " & + "TO OUT_FILE"); + END IF; + IF PAGE (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM PAGE AFTER OPEN " & + "TO OUT_FILE"); + END IF; + + EXCEPTION + WHEN SUBTEST => + NULL; + END; + + BEGIN + BEGIN + CREATE (FT, IN_FILE); + EXCEPTION + WHEN USE_ERROR => + RAISE SUBTEST; + END; + + IF COL (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM COLUMN AFTER CREATE " & + "IN IN_FILE"); + END IF; + IF LINE (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM LINE AFTER CREATE " & + "IN IN_FILE"); + END IF; + IF PAGE (FILE) /= ONE THEN + FAILED ("INCORRECT RESULTS FROM PAGE AFTER CREATE " & + "IN IN_FILE"); + END IF; + + CLOSE (FT); + + EXCEPTION + WHEN SUBTEST => + NULL; + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; +END CE3104A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3104b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3104b.ada new file mode 100644 index 000000000..34af98936 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3104b.ada @@ -0,0 +1,120 @@ +-- CE3104B.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 THE FILE REMAINS OPEN AFTER A RESET. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- DWC 08/13/87 CREATED ORIGINAL TEST. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3104B IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + ITEM1 : STRING (1..5) := "STUFF"; + +BEGIN + + TEST ("CE3104B", "CHECK THAT THE FILE REMAINS OPEN AFTER " & + "A RESET"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + PUT_LINE (FILE, ITEM1); + CLOSE (FILE); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE WITH OUT_FILE MODE " & + "NOT SUPPORTED"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED DURING " & + "FILE I/O"); + RAISE INCOMPLETE; + END; + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN WITH IN_FILE MODE NOT " & + "SUPPORTED"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + IF IS_OPEN (FILE) THEN + CLOSE (FILE); + ELSE + FAILED ("RESET FOR IN_FILE, CLOSED FILE"); + END IF; + + BEGIN + OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("OPEN WITH OUT_FILE MODE NOT " & + "SUPPORTED"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + IF IS_OPEN (FILE) THEN + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + ELSE + FAILED ("RESET FOR OUT_FILE CLOSED FILE"); + END IF; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; +END CE3104B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3104c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3104c.ada new file mode 100644 index 000000000..a9379ef42 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3104c.ada @@ -0,0 +1,117 @@ +-- CE3104C.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 THE MODE PARAMETER IN RESET CHANGES THE MODE OF A +-- GIVEN FILE, AND IF NO MODE IS SUPPLIED, THE MODE IS LEFT AS IT +-- WAS BEFORE THE RESET. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- RESET FOR TEXT FILES. + +-- HISTORY: +-- DWC 08/17/87 CREATED ORIGINAL TEST. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3104C IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + ITEM1 : STRING (1..5) := "STUFF"; + ITEM2 : STRING (1..5); + LENGTH : NATURAL; + +BEGIN + + TEST ("CE3104C", "CHECK THAT THE FILE REMAINS OPEN AFTER " & + "A RESET"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + PUT_LINE (FILE, ITEM1); + EXCEPTION + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATE WITH OUT_FILE MODE NOT " & + "SUPPORTED"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED DURING " & + "FILE I/O"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (FILE); + IF MODE (FILE) /= OUT_FILE THEN + FAILED ("RESET CHANGED MODE OF OUT_FILE"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET FOR OUT_FILE MODE NOT " & + "SUPPORTED FOR TEXT FILES"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (FILE, IN_FILE); + IF MODE (FILE) /= IN_FILE THEN + FAILED ("RESET MODE TO IN_FILE"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET FROM OUT_FILE TO IN_FILE " & + "NOT SUPPORTED FOR TEXT FILES"); + RAISE INCOMPLETE; + END; + + BEGIN + RESET (FILE); + IF MODE (FILE) /= IN_FILE THEN + FAILED ("RESET CHANGED MODE OF IN_FILE"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("RESET OF IN_FILE MODE NOT SUPPORTED " & + "FOR TEXT FILES"); + RAISE INCOMPLETE; + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; +END CE3104C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3106a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3106a.ada new file mode 100644 index 000000000..474a66ade --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3106a.ada @@ -0,0 +1,226 @@ +-- CE3106A.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 CLOSING A FILE HAS THE FOLLOWING EFFECT: +-- 1) IF THERE IS NO LINE TERMINATOR, A LINE TERMINATOR, PAGE +-- TERMINATOR, AND FILE TERMINATOR ARE WRITTEN AT THE END +-- OF THE FILE. +-- 2) IF THERE IS A LINE TERMINATOR BUT NO PAGE TERMINATOR, A +-- PAGE TERMINATOR AND A FILE TERMINATOR ARE WRITTEN. +-- 3) IF THERE IS A PAGE TERMINATOR, A FILE TERMINATOR IS +-- WRITTEN. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JLH 07/08/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3106A IS + + INCOMPLETE : EXCEPTION; + FILE1, FILE2, FILE3 : FILE_TYPE; + ITEM : CHARACTER; + +BEGIN + + TEST ("CE3106A", "CHECK THAT CLOSING A FILE HAS THE CORRECT " & + "EFFECT ON THE FILE CONCERNING LINE, PAGE, " & + "AND FILE TERMINATORS"); + + BEGIN + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE" & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE1, 'A'); + NEW_LINE (FILE1); + PUT (FILE1, 'B'); + + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH MODE IN_FILE"); + RAISE INCOMPLETE; + END; + + GET (FILE1, ITEM); + + IF LINE (FILE1) /= 1 THEN + FAILED ("INCORRECT LINE NUMBER - 1"); + END IF; + + GET (FILE1, ITEM); + IF ITEM /= 'B' THEN + FAILED ("INCORRECT VALUE READ - 1"); + END IF; + + IF LINE (FILE1) /= 2 THEN + FAILED ("INCORRECT LINE NUMBER - 2"); + END IF; + + IF NOT END_OF_LINE (FILE1) THEN + FAILED ("LINE TERMINATOR NOT WRITTEN WHEN FILE " & + "IS CLOSED"); + END IF; + + IF NOT END_OF_PAGE (FILE1) THEN + FAILED ("PAGE TERMINATOR NOT WRITTEN WHEN FILE " & + "IS CLOSED"); + END IF; + + IF NOT END_OF_FILE (FILE1) THEN + FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " & + "IS CLOSED"); + END IF; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME(2)); + PUT (FILE2, 'A'); + NEW_LINE (FILE2); + PUT (FILE2, 'B'); + NEW_PAGE (FILE2); + PUT (FILE2, 'C'); + NEW_LINE (FILE2); + + CLOSE (FILE2); + + OPEN (FILE2, IN_FILE, LEGAL_FILE_NAME(2)); + + GET (FILE2, ITEM); + + GET (FILE2, ITEM); + IF ITEM /= 'B' THEN + FAILED ("INCORRECT VALUE READ - 2"); + END IF; + + IF LINE (FILE2) /= 2 THEN + FAILED ("INCORRECT LINE NUMBER - 3"); + END IF; + + GET (FILE2, ITEM); + + IF LINE (FILE2) /= 1 THEN + FAILED ("INCORRECT LINE NUMBER - 4"); + END IF; + + IF PAGE (FILE2) /= 2 THEN + FAILED ("INCORRECT PAGE NUMBER - 1"); + END IF; + + IF NOT END_OF_PAGE (FILE2) THEN + FAILED ("PAGE TERMINATOR NOT WRITTEN WHEN FILE " & + "IS CLOSED - 2"); + END IF; + + IF NOT END_OF_FILE (FILE2) THEN + FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " & + "IS CLOSED - 2"); + END IF; + + BEGIN + DELETE (FILE2); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + CREATE (FILE3, OUT_FILE, LEGAL_FILE_NAME(3)); + PUT (FILE3, 'A'); + NEW_PAGE (FILE3); + PUT (FILE3, 'B'); + NEW_PAGE (FILE3); + NEW_LINE (FILE3); + PUT (FILE3, 'C'); + NEW_PAGE (FILE3); + + CLOSE (FILE3); + + OPEN (FILE3, IN_FILE, LEGAL_FILE_NAME(3)); + + GET (FILE3, ITEM); + + GET (FILE3, ITEM); + IF ITEM /= 'B' THEN + FAILED ("INCORRECT VALUE READ - 3"); + END IF; + + GET (FILE3, ITEM); + + IF LINE (FILE3) /= 2 THEN + FAILED ("INCORRECT LINE NUMBER - 5"); + END IF; + + IF PAGE (FILE3) /= 3 THEN + FAILED ("INCORRECT PAGE NUMBER - 2"); + END IF; + + IF NOT END_OF_FILE (FILE3) THEN + FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " & + "IS CLOSED - 3"); + END IF; + + BEGIN + DELETE (FILE3); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3106A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3106b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3106b.ada new file mode 100644 index 000000000..9d507a97c --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3106b.ada @@ -0,0 +1,220 @@ +-- CE3106B.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 AN OUT_FILE TO AN IN_FILE HAS THE FOLLOWING +-- EFFECT: +-- 1) IF THERE IS NO LINE TERMINATOR, A LINE TERMINATOR, PAGE +-- TERMINATOR, AND FILE TERMINATOR ARE WRITTEN AT THE END +-- OF THE FILE. +-- 2) IF THERE IS A LINE TERMINATOR BUT NO PAGE TERMINATOR, A +-- PAGE TERMINATOR AND A FILE TERMINATOR ARE WRITTEN. +-- 3) IF THERE IS A PAGE TERMINATOR, A FILE TERMINATOR IS +-- WRITTEN. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JLH 07/08/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3106B IS + + INCOMPLETE : EXCEPTION; + FILE1, FILE2, FILE3 : FILE_TYPE; + ITEM : CHARACTER; + +BEGIN + + TEST ("CE3106B", "CHECK THAT RESETTING AN OUT_FILE TO AN " & + "IN_FILE HAS THE CORRECT EFFECT ON THE " & + "FILE CONCERNING LINE, PAGE, AND FILE " & + "TERMINATORS"); + + BEGIN + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE" & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE1, 'A'); + NEW_LINE (FILE1); + PUT (FILE1, 'B'); + + BEGIN + RESET (FILE1, IN_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON FILE RESET " & + "FROM OUT_FILE TO IN_FILE"); + RAISE INCOMPLETE; + END; + + GET (FILE1, ITEM); + + IF LINE (FILE1) /= 1 THEN + FAILED ("INCORRECT LINE NUMBER - 1"); + END IF; + + GET (FILE1, ITEM); + IF ITEM /= 'B' THEN + FAILED ("INCORRECT VALUE READ - 1"); + END IF; + + IF LINE (FILE1) /= 2 THEN + FAILED ("INCORRECT LINE NUMBER - 2"); + END IF; + + IF NOT END_OF_LINE (FILE1) THEN + FAILED ("LINE TERMINATOR NOT WRITTEN WHEN FILE " & + "IS RESET"); + END IF; + + IF NOT END_OF_PAGE (FILE1) THEN + FAILED ("PAGE TERMINATOR NOT WRITTEN WHEN FILE " & + "IS RESET"); + END IF; + + IF NOT END_OF_FILE (FILE1) THEN + FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " & + "IS RESET"); + END IF; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME(2)); + PUT (FILE2, 'A'); + NEW_LINE (FILE2); + PUT (FILE2, 'B'); + NEW_PAGE (FILE2); + PUT (FILE2, 'C'); + NEW_LINE (FILE2); + + RESET (FILE2, IN_FILE); + + GET (FILE2, ITEM); + GET (FILE2, ITEM); + + IF LINE (FILE2) /= 2 THEN + FAILED ("INCORRECT LINE NUMBER - 3"); + END IF; + + GET (FILE2, ITEM); + IF ITEM /= 'C' THEN + FAILED ("INCORRECT VALUE READ - 2"); + END IF; + + IF LINE(FILE2) /= 1 THEN + FAILED ("INCORRECT LINE NUMBER - 4"); + END IF; + + IF PAGE(FILE2) /= 2 THEN + FAILED ("INCORRECT PAGE NUMBER - 1"); + END IF; + + IF NOT END_OF_PAGE (FILE2) THEN + FAILED ("PAGE TERMINATOR NOT WRITTEN WHEN FILE " & + "IS RESET - 2"); + END IF; + + IF NOT END_OF_FILE (FILE2) THEN + FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " & + "IS RESET - 2"); + END IF; + + BEGIN + DELETE (FILE2); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + CREATE (FILE3, OUT_FILE, LEGAL_FILE_NAME(3)); + PUT (FILE3, 'A'); + NEW_PAGE (FILE3); + PUT (FILE3, 'B'); + NEW_PAGE (FILE3); + NEW_LINE (FILE3); + PUT (FILE3, 'C'); + NEW_PAGE (FILE3); + + RESET (FILE3, IN_FILE); + + GET (FILE3, ITEM); + IF ITEM /= 'A' THEN + FAILED ("INCORRECT VALUE READ - 3"); + END IF; + + GET (FILE3, ITEM); + GET (FILE3, ITEM); + + IF LINE(FILE3) /= 2 THEN + FAILED ("INCORRECT LINE NUMBER - 5"); + END IF; + + IF PAGE(FILE3) /= 3 THEN + FAILED ("INCORRECT PAGE NUMBER - 2"); + END IF; + + IF NOT END_OF_FILE (FILE3) THEN + FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " & + "IS RESET - 3"); + END IF; + + BEGIN + DELETE (FILE3); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3106B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3107a.tst b/gcc/testsuite/ada/acats/tests/ce/ce3107a.tst new file mode 100644 index 000000000..96646fb71 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3107a.tst @@ -0,0 +1,135 @@ +-- CE3107A.TST + +-- 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 IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF +-- TYPE TEXT_IO. + +-- HISTORY: +-- DLD 08/10/82 +-- SPS 11/09/82 +-- JBG 03/24/83 +-- EG 05/29/85 +-- DWC 08/17/87 SPLIT OUT CASES WHICH DEPEND ON A TEXT FILE +-- BEING CREATED OR SUCCESSFULLY OPENED. PLACED +-- CASES INTO CE3107B.ADA. +-- PWB 03/07/97 ADDED CHECK FOR FILE SUPPORT. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3107A IS + + TEST_FILE_ZERO : FILE_TYPE; + TEST_FILE_ONE : FILE_TYPE; + TEST_FILE_TWO : FILE_TYPE; + TEST_FILE_THREE : FILE_TYPE; + VAL : BOOLEAN; + + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST("CE3107A", "CHECK THAT IS_OPEN RETURNS THE PROPER " & + "VALUES FOR UNOPENED FILES OF TYPE TEXT_IO"); + +-- FIRST TEST WHETHER IMPLEMENTATION SUPPORTS TEXT FILES AT ALL + + BEGIN + TEXT_IO.CREATE ( TEST_FILE_ZERO, + TEXT_IO.OUT_FILE, + REPORT.LEGAL_FILE_NAME ); + EXCEPTION + WHEN TEXT_IO.USE_ERROR | TEXT_IO.NAME_ERROR => + REPORT.NOT_APPLICABLE + ( "TEXT FILES NOT SUPPORTED -- CREATE OUT-FILE" ); + RAISE INCOMPLETE; + END; + TEXT_IO.DELETE ( TEST_FILE_ZERO ); + +-- WHEN FILE IS DECLARED BUT NOT OPEN + + VAL := TRUE; + VAL := IS_OPEN(TEST_FILE_ONE); + IF VAL = TRUE THEN + FAILED("FILE NOT OPEN BUT IS_OPEN RETURNS TRUE"); + END IF; + +-- FOLLOWING UNSUCCESSFUL CREATE + + BEGIN + VAL := TRUE; + CREATE(TEST_FILE_TWO, OUT_FILE, + "$ILLEGAL_EXTERNAL_FILE_NAME1"); + FAILED("NAME_ERROR NOT RAISED - UNSUCCESSFUL CREATE"); + EXCEPTION + WHEN NAME_ERROR => + VAL := IS_OPEN(TEST_FILE_TWO); + IF VAL = TRUE THEN + FAILED("IS_OPEN GIVES TRUE AFTER AN " & + "UNSUCCESSFUL CREATE"); + END IF; + END; + +-- FOLLOWING UNSUCCESSFUL OPEN + + BEGIN + VAL := FALSE; + OPEN(TEST_FILE_TWO, IN_FILE, LEGAL_FILE_NAME); + FAILED("NAME_ERROR NOT RAISED - " & + "UNSUCCESSFUL OPEN"); + EXCEPTION + WHEN NAME_ERROR => + VAL := IS_OPEN(TEST_FILE_TWO); + IF VAL = TRUE THEN + FAILED("IS_OPEN GIVES TRUE - " & + "UNSUCCESSFUL OPEN"); + END IF; + END; + +-- CLOSE FILE WHILE NOT OPEN + + BEGIN + VAL := TRUE; + CLOSE(TEST_FILE_THREE); -- STATUS ERROR + FAILED("STATUS_ERROR NOT RAISED - UNSUCCESSFUL CLOSE"); + EXCEPTION + WHEN OTHERS => + VAL := IS_OPEN(TEST_FILE_THREE); + IF VAL = TRUE THEN + FAILED("IS_OPEN GIVES TRUE - UNSUCCESSFUL " & + "CLOSE"); + END IF; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + NULL; + REPORT.RESULT; + WHEN OTHERS => + REPORT.FAILED ( "UNEXPECTED EXCEPTION" ); + REPORT.RESULT; +END CE3107A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3107b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3107b.ada new file mode 100644 index 000000000..6c40c5d60 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3107b.ada @@ -0,0 +1,141 @@ +-- CE3107B.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 IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF +-- TYPE TEXT_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION WITH OUT_FILE MODE FOR TEXT FILES. + +-- HISTORY: +-- DWC 08/17/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3107B IS + + TEST_FILE_ONE : FILE_TYPE; + TEST_FILE_TWO : FILE_TYPE; + VAL : BOOLEAN; + + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST("CE3107B", "CHECK THAT IS_OPEN RETURNS THE " & + "PROPER VALUES FOR FILES OF TYPE TEXT_IO"); + +-- FOLLOWING A CREATE + + BEGIN + VAL := FALSE; + CREATE(TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME); + VAL := IS_OPEN(TEST_FILE_ONE); + IF VAL = FALSE THEN + FAILED("IS_OPEN RETURNS FALSE AFTER CREATE"); + END IF; + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + +-- FOLLOWING CLOSE + + VAL := TRUE; + IF IS_OPEN(TEST_FILE_ONE) = TRUE THEN + CLOSE(TEST_FILE_ONE); + END IF; + VAL := IS_OPEN(TEST_FILE_ONE); + IF VAL = TRUE THEN + FAILED("IS_OPEN RETURNS TRUE AFTER CLOSE"); + END IF; + +-- FOLLOWING OPEN + + BEGIN + VAL := FALSE; + BEGIN + OPEN (TEST_FILE_TWO, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + IF IS_OPEN (TEST_FILE_TWO) /= FALSE THEN + FAILED ("FILE OPEN AFTER USE_ERROR " & + "DURING OPEN"); + END IF; + RAISE INCOMPLETE; + END; + VAL := IS_OPEN(TEST_FILE_TWO); + IF VAL = FALSE THEN + FAILED("IS_OPEN RETURNS FALSE AFTER OPEN"); + END IF; + +-- AFTER RESET + + BEGIN + VAL := FALSE; + RESET(TEST_FILE_TWO); + VAL := IS_OPEN(TEST_FILE_TWO); + IF VAL = FALSE THEN + FAILED("IS_OPEN RETURNS FALSE AFTER RESET"); + END IF; + EXCEPTION + WHEN USE_ERROR => + COMMENT("IMPLEMENTATION DOES NOT SUPPORT RESET"); + END; + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + +-- AFTER DELETE + + BEGIN + VAL := TRUE; + DELETE(TEST_FILE_TWO); + VAL := IS_OPEN(TEST_FILE_TWO); + IF VAL = TRUE THEN + FAILED("IS_OPEN RETURNS TRUE AFTER DELETE"); + END IF; + EXCEPTION + WHEN USE_ERROR => + IF IS_OPEN (TEST_FILE_TWO) /= FALSE THEN + FAILED ("FILE OPEN AFTER USE_ERROR " & + "DURING DELETE"); + END IF; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3107B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3108a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3108a.ada new file mode 100644 index 000000000..f5297a60a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3108a.ada @@ -0,0 +1,106 @@ +-- CE3108A.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 A FILE CAN BE CLOSED AND THEN RE-OPENED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- DLD 08/11/82 +-- SPS 11/09/82 +-- JBG 03/24/83 +-- EG 05/16/85 +-- GMT 08/17/87 REMOVED UNNECESSARY CODE AND ADDED A CHECK FOR +-- USE_ERROR ON DELETE. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3108A IS + + TXT_FILE : FILE_TYPE; + VAR : STRING (1..2); + LAST : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3108A", "CHECK THAT A FILE CAN BE CLOSED " & + "AND THEN RE-OPENED"); + + -- INITIALIZE TEST FILES + + BEGIN + + BEGIN + CREATE (TXT_FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + PUT (TXT_FILE, "17"); + CLOSE (TXT_FILE); + + -- RE-OPEN TEXT TEST FILE + + BEGIN + OPEN (TXT_FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN"); + RAISE INCOMPLETE; + END; + + GET (TXT_FILE, VAR); + IF VAR /= "17" THEN + FAILED ("WRONG DATA RETURNED FROM READ -TEXT"); + END IF; + + -- DELETE TEST FILES + + BEGIN + DELETE (TXT_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3108A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3108b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3108b.ada new file mode 100644 index 000000000..0c366f6ab --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3108b.ada @@ -0,0 +1,111 @@ +-- CE3108B.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 THE NAME RETURNED BY THE NAME FUNCTION CAN BE USED +-- IN A SUBSEQUENT OPEN. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- DLD 08/11/82 +-- SPS 11/09/82 +-- JBG 03/24/83 +-- EG 05/16/85 +-- GMT 08/17/87 REMOVED UNNECESSARY CODE AND ADDED A CHECK FOR +-- USE_ERROR ON DELETE. + +WITH TEXT_IO; USE TEXT_IO; +WITH REPORT; USE REPORT; + +PROCEDURE CE3108B IS + + TYPE ACC_STR IS ACCESS STRING; + + TXT_FILE : FILE_TYPE; + TXT_FILE_NAME : ACC_STR; + DIR_FILE_NAME : ACC_STR; + VAR : STRING(1..2); + LAST : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3108B", "CHECK THAT THE NAME RETURNED BY THE NAME-" & + "FUNCTION CAN BE USED IN A SUBSEQUENT OPEN"); + + -- CREATE TEST FILES + + BEGIN + BEGIN + CREATE (TXT_FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE - 1"); + RAISE INCOMPLETE; + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 2"); + RAISE INCOMPLETE; + END; + + BEGIN + PUT (TXT_FILE, "14"); + TXT_FILE_NAME := NEW STRING'(NAME (TXT_FILE)); + CLOSE (TXT_FILE); + + -- ATTEMPT TO RE-OPEN TEXT TEST FILE USING RETURNED NAME + -- VALUE + + BEGIN + OPEN (TXT_FILE, IN_FILE, TXT_FILE_NAME.ALL); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR ON RE-OPEN - 3"); + RAISE INCOMPLETE; + END; + + GET (TXT_FILE, VAR); + IF VAR /= "14" THEN + FAILED ("WRONG DATA RETURNED FROM READ - 4"); + END IF; + + -- CLOSE AND DELETE TEST FILES + + BEGIN + DELETE (TXT_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END; + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3108B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3110a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3110a.ada new file mode 100644 index 000000000..f6d756a75 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3110a.ada @@ -0,0 +1,107 @@ +-- CE3110A.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 AFTER A SUCCESSFUL DELETE OF AN EXTERNAL FILE, THE +-- NAME OF THE FILE CAN BE USED IN A CREATE OPERATION. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION AND DELETION OF TEXT FILES. + +-- HISTORY: +-- SPS 08/25/82 +-- SPS 11/09/82 +-- JBG 06/04/84 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 08/18/87 CORRECTED EXCEPTION FORMAT. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3110A IS +BEGIN + + TEST ("CE3110A", "CHECK THAT AN EXTERNAL FILE CAN BE CREATED " & + "AFTER AN EXTERNAL FILE WITH SAME NAME HAS BEEN" & + " DELETED"); + DECLARE + FL1 : FILE_TYPE; + FL2 : FILE_TYPE; + T_FAILED : BOOLEAN := FALSE; + D_FILE : BOOLEAN := FALSE; + BEGIN + BEGIN + CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + T_FAILED := TRUE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + T_FAILED := TRUE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT " & + "CREATE WITH OUT_FILE MODE"); + T_FAILED := TRUE; + END; + + IF NOT T_FAILED THEN + BEGIN + DELETE (FL1); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("DELETION OF EXTERNAL " & + "FILES NOT SUPPORTED"); + T_FAILED := TRUE; + END; + END IF; + + IF NOT T_FAILED THEN + BEGIN + CREATE (FL2, OUT_FILE, LEGAL_FILE_NAME); + D_FILE := TRUE; + EXCEPTION + WHEN OTHERS => + FAILED ("UNABLE TO RECREATE FILE AFTER " & + "DELETION - TEXT"); + END; + IF D_FILE THEN + BEGIN + DELETE (FL2); + EXCEPTION + WHEN OTHERS => + FAILED ("DELETE SHOULD STILL BE " & + "SUPPORTED"); + END; + END IF; + END IF; + END; + + RESULT; + +END CE3110A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3112c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3112c.ada new file mode 100644 index 000000000..3ee20cf1b --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3112c.ada @@ -0,0 +1,81 @@ +-- CE3112C.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 AN EXTERNAL TEXT FILE SPECIFIED BY A NON-NULL +-- STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN +-- PROGRAM. + +-- THIS TEST CREATES A TEXT FILE WHICH CE3112D.ADA WILL READ. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF AN EXTERNAL TEXT FILE WITH OUT_FILE MODE. + +-- HISTORY: +-- GMT 08/13/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; + +PROCEDURE CE3112C IS + + INCOMPLETE : EXCEPTION; + FILE_NAME : TEXT_IO.FILE_TYPE; + PREVENT_EMPTY_FILE : STRING (1..5) := "HELLO"; + +BEGIN + TEST ("CE3112C" , "CHECK THAT AN EXTERNAL TEXT FILE SPECIFIED " & + "BY A NON-NULL STRING NAME IS ACCESSIBLE " & + "AFTER THE COMPLETION OF THE MAIN PROGRAM"); + BEGIN + BEGIN + TEXT_IO.CREATE (FILE_NAME, TEXT_IO.OUT_FILE, + LEGAL_FILE_NAME); + EXCEPTION + WHEN TEXT_IO.USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE - 1"); + RAISE INCOMPLETE; + WHEN TEXT_IO.NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE - 2"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "TEXT CREATE - 3"); + RAISE INCOMPLETE; + END; + + TEXT_IO.PUT (FILE_NAME, PREVENT_EMPTY_FILE); + TEXT_IO.CLOSE (FILE_NAME); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3112C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3112d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3112d.ada new file mode 100644 index 000000000..3328c8161 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3112d.ada @@ -0,0 +1,112 @@ +-- CE3112D.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 AN EXTERNAL TEXT FILE SPECIFIED BY A NON-NULL STRING +-- NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN PROGRAM. + +-- THIS TEST CHECKS THE CREATION OF A TEXT FILE X3112C, WHICH WAS +-- CREATED BY CE3112C.ADA. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- GMT 08/13/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; + +PROCEDURE CE3112D IS + + INCOMPLETE : EXCEPTION; + CHECK_SUPPORT, FILE_NAME : TEXT_IO.FILE_TYPE; + PREVENT_EMPTY_FILE : STRING (1..5); + +BEGIN + TEST ("CE3112D", "CHECK THAT AN EXTERNAL TEXT FILE SPECIFIED BY " & + "A NON-NULL STRING NAME IS ACCESSIBLE AFTER " & + "THE COMPLETION OF THE MAIN PROGRAM"); + + -- TEST FOR TEXT FILE SUPPORT. + + BEGIN + TEXT_IO.CREATE (CHECK_SUPPORT, TEXT_IO.OUT_FILE, + LEGAL_FILE_NAME); + BEGIN + TEXT_IO.DELETE (CHECK_SUPPORT); + EXCEPTION + WHEN TEXT_IO.USE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "DELETE - 1"); + END; + EXCEPTION + WHEN TEXT_IO.USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " & + "OUT_FILE MODE - 2"); + RAISE INCOMPLETE; + WHEN TEXT_IO.NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE - 3"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " & + "CREATE - 4"); + RAISE INCOMPLETE; + END; + + -- BEGIN TEST OBJECTIVE. + + BEGIN + TEXT_IO.OPEN (FILE_NAME, TEXT_IO.IN_FILE, + LEGAL_FILE_NAME (1, "CE3112C")); + EXCEPTION + WHEN TEXT_IO.USE_ERROR => + NOT_APPLICABLE("USE_ERROR RAISED ON OPEN FOR TEXT " & + "FILE WITH IN_FILE MODE - 5"); + RAISE INCOMPLETE; + END; + + TEXT_IO.GET (FILE_NAME, PREVENT_EMPTY_FILE); + + IF PREVENT_EMPTY_FILE /= "HELLO" THEN + FAILED ("OPENED WRONG FILE OR DATA ERROR - 6"); + END IF; + BEGIN + TEXT_IO.DELETE (FILE_NAME); + EXCEPTION + WHEN TEXT_IO.USE_ERROR => + COMMENT ("IMPLEMENTATION WOULD NOT ALLOW DELETION OF " & + "EXTERNAL FILE - 7"); + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; +END CE3112D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3114a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3114a.ada new file mode 100644 index 000000000..f217cde6a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3114a.ada @@ -0,0 +1,102 @@ +-- CE3114A.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 AN EXTERNAL TEXT FILE CEASES TO EXIST AFTER +-- A SUCCESSFUL DELETE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION AND DELETION OF TEXT FILES. + +-- HISTORY: +-- SPS 08/25/82 +-- SPS 11/09/82 +-- JBG 04/01/83 +-- EG 05/16/85 +-- GMT 08/25/87 COMPLETELY REVISED. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3114A IS +BEGIN + + TEST ("CE3114A", "CHECK THAT AN EXTERNAL TEXT FILE CEASES TO " & + "EXIST AFTER A SUCCESSFUL DELETE"); + + DECLARE + FL1, FL2 : FILE_TYPE; + VAR1 : CHARACTER := 'A'; + INCOMPLETE : EXCEPTION; + BEGIN + BEGIN + CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE - 1"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE - 2"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "CREATE - 3"); + RAISE INCOMPLETE; + END; + + BEGIN + PUT (FL1, VAR1); -- THIS PUTS TO THE FILE IF + EXCEPTION -- IT CAN, NOT NECESSARY FOR + WHEN OTHERS => -- THE OBJECTIVE. + NULL; + END; + + BEGIN + DELETE (FL1); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("DELETION OF EXTERNAL TEXT FILES " & + "IS NOT SUPPORTED - 4"); + RAISE INCOMPLETE; + END; + + BEGIN + OPEN (FL2, IN_FILE, LEGAL_FILE_NAME); + FAILED ("EXTERNAL TEXT FILE STILL EXISTS AFTER " & + "A SUCCESSFUL DELETION - 5"); + EXCEPTION + WHEN NAME_ERROR => + NULL; + END; + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3114A; 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; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3201a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3201a.ada new file mode 100644 index 000000000..eb7b6ead4 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3201a.ada @@ -0,0 +1,71 @@ +-- CE3201A.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 THE STANDARD INPUT AND OUTPUT FILES EXIST +-- AND ARE OPEN. + +-- ABW 8/25/82 +-- SPS 9/16/82 +-- SPS 12/14/82 +-- JBG 3/17/83 + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3201A IS + CH : CHARACTER; +BEGIN + + TEST ("CE3201A", "CHECK THAT STANDARD INPUT AND " & + "OUTPUT EXIST AND ARE OPEN"); + + IF NOT IS_OPEN (STANDARD_INPUT) THEN + FAILED ("STANDARD_INPUT NOT OPEN - IS_OPEN"); + END IF; + + IF NOT IS_OPEN (STANDARD_OUTPUT) THEN + FAILED ("STANDARD_OUTPUT NOT OPEN - IS_OPEN"); + END IF; + + BEGIN + PUT ('X'); + EXCEPTION + WHEN OTHERS => + FAILED ("STANDARD_OUTPUT NOT AVAILABLE - " & + "PUT DEFAULT"); + END; + + BEGIN + PUT (STANDARD_OUTPUT, 'D'); + EXCEPTION + WHEN OTHERS => + FAILED ("STANDARD_OUTPUT NOT AVAILABLE - " & + "PUT"); + END; + + RESULT; + +END CE3201A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3202a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3202a.ada new file mode 100644 index 000000000..755d48850 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3202a.ada @@ -0,0 +1,57 @@ +-- CE3202A.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 CURRENT_INPUT AND CURRENT_OUTPUT INITIALLY +-- CORRESPOND TO STANDARD FILES. + +-- ABW 8/25/82 +-- SPS 11/9/82 +-- JBG 3/17/83 +-- JBG 5/8/84 + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3202A IS + + +BEGIN + + TEST ("CE3202A", "CHECK THAT CURRENT_INPUT AND " & + "CURRENT_OUTPUT INITIALLY " & + "CORRESPOND TO STANDARD FILES"); + + IF NAME (CURRENT_INPUT) /= NAME (STANDARD_INPUT) THEN + FAILED ("CURRENT_INPUT INCORRECT - NAME"); + END IF; + + IF NAME (CURRENT_OUTPUT) /= NAME (STANDARD_OUTPUT) THEN + FAILED ("CURRENT_OUTPUT INCORRECT - NAME"); + END IF; + + RESULT; + +END CE3202A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3206a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3206a.ada new file mode 100644 index 000000000..a865b6091 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3206a.ada @@ -0,0 +1,103 @@ +-- CE3206A.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 SET_INPUT AND SET_OUTPUT RAISE STATUS_ERROR WHEN +-- CALLED WITH A FILE PARAMETER DENOTING A CLOSED FILE. + +-- HISTORY: +-- ABW 08/31/82 +-- SPS 10/01/82 +-- SPS 11/09/82 +-- JLH 08/18/87 ADDED NEW CASES FOR SET_INPUT AND SET_OUTPUT. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3206A IS + + FILE_IN, FILE1 : FILE_TYPE; + ITEM : CHARACTER := 'A'; + +BEGIN + + TEST ("CE3206A", "CHECK THAT SET_INPUT AND SET_OUTPUT " & + "RAISE STATUS_ERROR WHEN CALLED WITH A " & + "FILE PARAMETER DENOTING A CLOSED FILE"); + + BEGIN + SET_INPUT (FILE_IN); + FAILED ("STATUS_ERROR NOT RAISED FOR SET_INPUT - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR SET_INPUT - 1"); + END; + + BEGIN + SET_OUTPUT (FILE_IN); + FAILED ("STATUS_ERROR NOT RAISED FOR SET_OUTPUT - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR SET_OUTPUT - 1"); + END; + + BEGIN + CREATE (FILE1, OUT_FILE); + PUT (FILE1, ITEM); + CLOSE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + BEGIN + SET_INPUT (FILE1); + FAILED ("STATUS_ERROR NOT RAISED FOR SET_INPUT - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR SET_INPUT - 2"); + END; + + BEGIN + SET_OUTPUT (FILE1); + FAILED ("STATUS_ERROR NOT RAISED FOR SET_OUTPUT - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR SET_OUTPUT - 2"); + END; + + + RESULT; + +END CE3206A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3207a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3207a.ada new file mode 100644 index 000000000..6b234cef0 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3207a.ada @@ -0,0 +1,107 @@ +-- CE3207A.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 MODE_ERROR IS RAISED IF THE PARAMETER TO SET_INPUT HAS +-- MODE OUT_FILE OR THE PARAMETER TO SET_OUTPUT HAS MODE IN_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JLH 07/07/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3207A IS + + FILE1, FILE2 : FILE_TYPE; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3207A", "CHECK THAT MODE_ERROR IS RAISED IF THE " & + "PARAMETER TO SET_INPUT HAS MODE OUT_FILE " & + "OR THE PARAMETER TO SET_OUTPUT HAS MODE " & + "IN_FILE"); + + BEGIN + + BEGIN + CREATE (FILE1, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + SET_INPUT (FILE1); + FAILED ("MODE_ERROR NOT RAISED FOR SET_INPUT WITH " & + "MODE OUT_FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR SET_INPUT"); + END; + + CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME); + + PUT (FILE2, "OUTPUT STRING"); + CLOSE (FILE2); + OPEN (FILE2, IN_FILE, LEGAL_FILE_NAME); + + BEGIN + SET_OUTPUT (FILE2); + FAILED ("MODE_ERROR NOT RAISED FOR SET_OUTPUT WITH " & + "MODE IN_FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR SET_OUTPUT"); + END; + + BEGIN + DELETE (FILE2); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3207A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3301a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3301a.ada new file mode 100644 index 000000000..4766cb9c0 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3301a.ada @@ -0,0 +1,176 @@ +-- CE3301A.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 WHEN THE LINE AND PAGE LENGTH ARE NONZERO, LINE AND +-- PAGE TERMINATORS ARE OUTPUT AT THE APPROPRIATE POINTS. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/22/82 +-- SPS 11/15/82 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/27/87 COMPLETELY REVISED TEST. +-- LDC 05/26/88 ADDED "FILE" PARAMETERS. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3301A IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + TWO : CONSTANT COUNT := COUNT(IDENT_INT(2)); + TEN : CONSTANT COUNT := COUNT(IDENT_INT(10)); + THREE : CONSTANT COUNT := COUNT(IDENT_INT(3)); + ITEM1 : STRING (1..10); + ITEM2 : STRING (1..2); + +BEGIN + + TEST ("CE3301A", "CHECK THAT WHEN THE LINE AND PAGE LENGTH ARE " & + "NONZERO, LINE AND PAGE TERMINATORS ARE " & + "OUTPUT AT THE APPROPRIATE POINTS"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + IF LINE_LENGTH (FILE) /= UNBOUNDED THEN + FAILED ("LINE LENGTH NOT INITIALLY UNBOUNDED"); + END IF; + + IF PAGE_LENGTH (FILE) /= UNBOUNDED THEN + FAILED ("PAGE LENGTH NOT INITIALLY UNBOUNDED"); + END IF; + + SET_LINE_LENGTH (FILE,TEN); + SET_PAGE_LENGTH (FILE,TWO); + + FOR I IN 1 .. 30 LOOP + PUT (FILE,'C'); + END LOOP; + + IF PAGE (FILE) /= 2 AND LINE (FILE) /= 1 THEN + FAILED ("LINE AND PAGE LENGTHS WERE NOT BOUND " & + "CORRECTLY"); + END IF; + + SET_LINE_LENGTH (FILE, TWO); + SET_PAGE_LENGTH (FILE, THREE); + PUT (FILE, "DDDDDDD"); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FILE, ITEM1); + + IF NOT (END_OF_LINE (FILE)) THEN + FAILED ("INCORRECT VALUE BEFORE LINE TERMINATOR"); + END IF; + + IF END_OF_PAGE (FILE) THEN + FAILED ("PAGE TERMINATOR OUTPUT AT INAPPROPRIATE POINT"); + END IF; + + GET (FILE, ITEM1); + + IF ITEM1 /= "CCCCCCCCCC" THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + + IF NOT (END_OF_LINE(FILE)) THEN + FAILED ("INCORRECT VALUE BEFORE LINE TERMINATOR"); + END IF; + + IF NOT (END_OF_PAGE(FILE)) THEN + FAILED ("INCORRECT VALUE BEFORE PAGE TERMINATOR"); + END IF; + + GET (FILE, ITEM1); + GET (FILE, ITEM2); + + IF ITEM2 /= "DD" THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + + IF NOT (END_OF_LINE(FILE)) THEN + FAILED ("INCORRECT VALUE BEFORE LINE TERMINATOR"); + END IF; + + IF END_OF_PAGE (FILE) THEN + FAILED ("PAGE TERMINATOR OUTPUT AT INAPPROPRIATE POINT"); + END IF; + + GET (FILE, ITEM2); + + IF ITEM2 /= "DD" THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + + IF NOT (END_OF_LINE(FILE)) THEN + FAILED ("INCORRECT VALUE BEFORE LINE TERMINATOR"); + END IF; + + IF NOT (END_OF_PAGE(FILE)) THEN + FAILED ("INCORRECT VALUE BEFORE PAGE TERMINATOR"); + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3301A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3302a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3302a.ada new file mode 100644 index 000000000..905da7abe --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3302a.ada @@ -0,0 +1,138 @@ +-- CE3302A.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 SET_LINE_LENGTH, SET_PAGE_LENGTH, LINE_LENGTH, AND +-- PAGE_LENGTH RAISE MODE_ERROR WHEN APPLIED TO A FILE OF MODE +-- IN_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/16/82 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/19/87 CREATED AN EXTERNAL FILE WITH A NAME, REMOVED +-- DEPENDENCE ON RESET, AND ADDED CODE TO DELETE +-- EXTERNAL FILE. +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3302A IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + FIVE : COUNT := COUNT(IDENT_INT(5)); + VAR1 : COUNT; + ITEM : CHARACTER := 'A'; + +BEGIN + TEST ("CE3302A", "CHECK THAT SET_LINE_LENGTH, SET_PAGE_LENGTH, " & + "LINE_LENGTH, AND PAGE_LENGTH RAISE MODE_ERROR " & + "WHEN APPLIED TO A FILE OF MODE IN_FILE"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT FILE CREATE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT FILE CREATE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR TEXT CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, ITEM); + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT FILE OPEN"); + RAISE INCOMPLETE; + END; + + BEGIN + SET_LINE_LENGTH (FILE, FIVE); + FAILED ("MODE_ERROR NOT RAISED - SET_LINE_LENGTH"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - SET_LINE_LENGTH"); + END; + + BEGIN + SET_PAGE_LENGTH (FILE, FIVE); + FAILED ("MODE_ERROR NOT RAISED - SET_PAGE_LENGTH"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - SET_PAGE_LENGTH"); + END; + + BEGIN + VAR1 := LINE_LENGTH (FILE); + FAILED ("MODE_ERROR NOT RAISED - LINE_LENGTH"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - LINE_LENGTH"); + END; + + BEGIN + VAR1 := PAGE_LENGTH (FILE); + FAILED ("MODE_ERROR NOT RAISED - PAGE_LENGTH"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - PAGE_LENGTH"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3302A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3303a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3303a.ada new file mode 100644 index 000000000..50facadb9 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3303a.ada @@ -0,0 +1,152 @@ +-- CE3303A.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 SET_LINE_LENGTH, SET_PAGE_LENGTH, LINE_LENGTH, AND +-- PAGE_LENGTH RAISE STATUS_ERROR WHEN APPLIED TO A CLOSED FILE. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/16/82 +-- JLH 08/19/87 ADDED AN ATTEMPT TO CREATE AN EXTERNAL FILE; +-- ADDED CHECKS TO THE SAME FOUR CASES WHICH EXIST +-- IN TEST AGAINST ATTEMPTED CREATE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3303A IS + + FILE : FILE_TYPE; + FIVE : COUNT := COUNT(IDENT_INT(5)); + C : COUNT; + ITEM : CHARACTER := 'A'; + +BEGIN + + TEST ("CE3303A" , "CHECK THAT SET_LINE_LENGTH, " & + "SET_PAGE_LENGTH, LINE_LENGTH, AND " & + "PAGE_LENGTH RAISE STATUS_ERROR " & + "WHEN APPLIED TO A CLOSED FILE"); + +-- FILE NONEXISTANT + + BEGIN + SET_LINE_LENGTH (FILE, FIVE); + FAILED ("STATUS_ERROR NOT RAISED FOR SET_LINE_LENGTH - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR SET_LINE_LENGTH " & + "- 1"); + END; + + BEGIN + SET_PAGE_LENGTH (FILE, FIVE); + FAILED ("STATUS_ERROR NOT RAISED FOR SET_PAGE_LENGTH - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR SET_PAGE_LENGTH " & + "- 1"); + END; + + BEGIN + C := LINE_LENGTH (FILE); + FAILED ("STATUS_ERROR NOT RAISED FOR LINE_LENGTH - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR LINE_LENGTH - 1"); + END; + + BEGIN + C := PAGE_LENGTH (FILE); + FAILED ("STATUS_ERROR NOT RAISED FOR PAGE_LENGTH - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR PAGE_LENGTH - 1"); + END; + + BEGIN + CREATE (FILE, OUT_FILE); + PUT (FILE, ITEM); + CLOSE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + BEGIN + SET_LINE_LENGTH (FILE, FIVE); + FAILED ("STATUS_ERROR NOT RAISED FOR SET_LINE_LENGTH - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR SET_LINE_LENGTH " & + "- 2"); + END; + + BEGIN + SET_PAGE_LENGTH (FILE, FIVE); + FAILED ("STATUS_ERROR NOT RAISED FOR SET_PAGE_LENGTH - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR SET_PAGE_LENGTH " & + "- 2"); + END; + + BEGIN + C := LINE_LENGTH (FILE); + FAILED ("STATUS_ERROR NOT RAISED FOR LINE_LENGTH - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR LINE_LENGTH - 2"); + END; + + BEGIN + C := PAGE_LENGTH (FILE); + FAILED ("STATUS_ERROR NOT RAISED FOR PAGE_LENGTH - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR PAGE_LENGTH - 2"); + END; + + RESULT; + +END CE3303A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3304a.tst b/gcc/testsuite/ada/acats/tests/ce/ce3304a.tst new file mode 100644 index 000000000..e1ee3f859 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3304a.tst @@ -0,0 +1,204 @@ +-- CE3304A.TST + +-- 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 USE_ERROR IS RAISED BY A CALL TO SET_LINE_LENGTH +-- OR TO SET_PAGE_LENGTH WHEN THE SPECIFIED VALUE IS INAPPROPRIATE +-- FOR THE EXTERNAL FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE TO IMPLEMENTATIONS THAT SATISFY THE +-- FOLLOWING CONDITIONS: +-- 1) TEXT FILES ARE SUPPORTED +-- 2) EITHER BY DEFAULT OR BY USE OF THE "FORM" PARAMETER TO +-- THE CREATE PROCEDURE, A TEXT FILE CAN BE CREATED FOR +-- WHICH AT LEAST ONE OF THE FOLLOWING CONDITIONS HOLDS: +-- A) THERE IS A VALUE OF TYPE TEXT_IO.COUNT THAT IS NOT +-- AN APPROPRIATE LINE-LENGTH FOR THE FILE, +-- OR +-- B) THERE IS A VALUE OF TYPE TEXT_IO.COUNT THAT IS NOT +-- AN APPROPRIATE PAGE-LENGTH FOR THE FILE. + +-- MACRO SUBSTITUTIONS: +-- FOR THE MACRO SYMBOL "$FORM_STRING," SUBSTITUTE A STRING LITERAL +-- SPECIFIYING THAT THE EXTERNAL FILE MEETS BOTH OF THE CONDITIONS +-- (A) AND (B) ABOVE. IF IT IS NOT POSSIBLE TO SATISFY BOTH +-- CONDITIONS, THEN SUBSTITUTE A STRING LITERAL SPECIFYING THAT THE +-- EXTERNAL FILE SATISFIES ONE OF THE CONDITIONS. IF IT IS NOT +-- POSSIBLE TO SATISFY EITHER CONDITION, THEN SUBSTITUE THE NULL +-- STRING (""). +-- FOR THE MACRO SYMBOL "$INAPPROPRIATE_LINE_LENGTH," SUBSTITUTE +-- A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE LINE-LENGTH +-- FOR THE EXTERNAL FILE. IF THERE IS NO SUCH VALUE, THEN USE -1. +-- FOR THE MACRO SYMBOL "$INAPPROPRIATE_PAGE_LENGTH," SUBSTITUTE +-- A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE PAGE-LENGTH +-- FOR THE EXTERNAL FILE. IF THERE IS NO SUCH VALUE, THEN USE -1. + +-- HISTORY: +-- PWB 07/07/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3304A IS + + FILE1, + FILE2, + FILE3 : FILE_TYPE; + + LINE_LENGTH_SHOULD_WORK, + PAGE_LENGTH_SHOULD_WORK : BOOLEAN; + + INCOMPLETE : EXCEPTION; + + TEST_VALUE : COUNT; + +BEGIN + + TEST ("CE3304A", "CHECK THAT USE_ERROR IS RAISED IF A CALL TO " & + "SET_LINE_LENGTH OR SET_PAGE_LENGTH SPECIFIES " & + "A VALUE THAT IS INAPPROPRIATE FOR THE " & + "EXTERNAL FILE"); + + BEGIN -- CHECK WHETHER TEXT FILES ARE SUPPORTED. + + CREATE(FILE1, OUT_FILE, LEGAL_FILE_NAME(1), + FORM => $FORM_STRING); + PUT_LINE(FILE1, "AAA"); + CLOSE(FILE1); + + EXCEPTION + + WHEN USE_ERROR | NAME_ERROR => + NOT_APPLICABLE ("CREATION OF TEXT FILES NOT SUPPORTED"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED AT INITIAL CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN -- CHECK INAPPROPRIATE LINE LENGTH. + + BEGIN -- IS THERE AN INAPPROPRIATE VALUE? + TEST_VALUE := + COUNT(IDENT_INT($INAPPROPRIATE_LINE_LENGTH)); + IF NOT EQUAL (INTEGER(TEST_VALUE), + INTEGER(TEST_VALUE)) THEN + COMMENT ("OPTIMIZATION DEFEATED" & + COUNT'IMAGE(TEST_VALUE)); + END IF; + LINE_LENGTH_SHOULD_WORK := TRUE; + EXCEPTION + WHEN CONSTRAINT_ERROR => + LINE_LENGTH_SHOULD_WORK := FALSE; + COMMENT("THERE IS NO INAPPROPRIATE LINE LENGTH"); + END; + + IF LINE_LENGTH_SHOULD_WORK THEN + BEGIN + CREATE(FILE2, OUT_FILE, LEGAL_FILE_NAME(2), + FORM => $FORM_STRING); + SET_LINE_LENGTH(FILE2, $INAPPROPRIATE_LINE_LENGTH); + FAILED("NO EXCEPTION FOR INAPPROPRIATE LINE " & + "LENGTH"); + EXCEPTION + WHEN USE_ERROR => + IF NOT IS_OPEN(FILE2) THEN + FAILED ("FILE NOT OPENED -- LINE LENGTH"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR " & + "INAPPROPRIATE LINE LENGTH"); + END; + END IF; + END; + +----------------------------------------------------------------------- + + BEGIN -- CHECK INAPPROPRIATE PAGE LENGTH. + + BEGIN -- IS THERE AN INAPPROPRIATE VALUE? + TEST_VALUE := + COUNT(IDENT_INT($INAPPROPRIATE_PAGE_LENGTH)); + IF NOT EQUAL (INTEGER(TEST_VALUE), + INTEGER(TEST_VALUE)) THEN + COMMENT ("OPTIMIZATION DEFEATED" & + COUNT'IMAGE(TEST_VALUE)); + END IF; + PAGE_LENGTH_SHOULD_WORK := TRUE; + EXCEPTION + WHEN CONSTRAINT_ERROR => + PAGE_LENGTH_SHOULD_WORK := FALSE; + COMMENT("THERE IS NO INAPPROPRIATE PAGE LENGTH"); + END; + + IF PAGE_LENGTH_SHOULD_WORK THEN + BEGIN + CREATE(FILE3, OUT_FILE, LEGAL_FILE_NAME(3), + FORM => $FORM_STRING); + SET_PAGE_LENGTH(FILE3, $INAPPROPRIATE_PAGE_LENGTH); + FAILED("NO EXCEPTION FOR INAPPROPRIATE PAGE " & + "LENGTH"); + EXCEPTION + WHEN USE_ERROR => + IF NOT IS_OPEN(FILE3) THEN + FAILED ("FILE NOT OPENED -- PAGE LENGTH"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR " & + "INAPPROPRIATE PAGE LENGTH"); + END; + END IF; + END; + + IF NOT (PAGE_LENGTH_SHOULD_WORK OR LINE_LENGTH_SHOULD_WORK) THEN + NOT_APPLICABLE("NO INAPPROPRIATE VALUES FOR EITHER LINE " & + "LENGTH OR PAGE LENGTH"); + END IF; + + BEGIN -- CLEAN UP FILES. + + IF IS_OPEN(FILE1) THEN + CLOSE(FILE1); + END IF; + + IF IS_OPEN(FILE2) THEN + CLOSE(FILE2); + END IF; + + IF IS_OPEN(FILE3) THEN + CLOSE(FILE3); + END IF; + + EXCEPTION + WHEN USE_ERROR => + COMMENT("FILES NOT DELETED"); + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; +END CE3304A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3305a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3305a.ada new file mode 100644 index 000000000..1807d9128 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3305a.ada @@ -0,0 +1,182 @@ +-- CE3305A.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 THE LINE AND PAGE LENGTHS MAY BE ALTERED DYNAMICALLY +-- SEVERAL TIMES. CHECK THAT WHEN RESET TO ZERO, THE LENGTHS ARE +-- UNBOUNDED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES WITH UNBOUNDED LINE LENGTH. + +-- HISTORY: +-- SPS 09/28/82 +-- EG 05/22/85 +-- DWC 08/18/87 ADDED CHECK_FILE WITHOUT A'S. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; +WITH CHECK_FILE; + +PROCEDURE CE3305A IS + + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3305A", "CHECK THAT LINE AND PAGE LENGTHS MAY BE " & + "ALTERED DYNAMICALLY"); + + DECLARE + FT : FILE_TYPE; + + PROCEDURE PUT_CHARS (CNT: INTEGER; CH: CHARACTER) IS + BEGIN + FOR I IN 1 .. CNT LOOP + PUT (FT, CH); + END LOOP; + END PUT_CHARS; + + BEGIN + + BEGIN + CREATE(FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + SET_LINE_LENGTH (FT, 10); + SET_PAGE_LENGTH (FT, 5); + + PUT_CHARS (150, 'X'); -- 15 LINES + + BEGIN + SET_LINE_LENGTH (FT, 5); + SET_PAGE_LENGTH (FT, 10); + EXCEPTION + WHEN OTHERS => + FAILED ("UNABLE TO CHANGE LINE OR PAGE LENGTH"); + END; + + PUT_CHARS (50, 'B'); -- 10 LINES + + BEGIN + SET_LINE_LENGTH (FT, 25); + SET_PAGE_LENGTH (FT,4); + EXCEPTION + WHEN OTHERS => + FAILED ("UNABLE TO CHANGE LINE OR PAGE LENGTH - 2"); + END; + + PUT_CHARS (310, 'K'); -- 12 LINES, 10 CHARACTERS + +-- THIS CAN RAISE USE_ERROR IF AN IMPLEMENTATION REQUIRES A BOUNDED +-- LINE LENGTH FOR AN EXTERNAL FILE. + + BEGIN + BEGIN + SET_LINE_LENGTH (FT, UNBOUNDED); + SET_PAGE_LENGTH (FT, UNBOUNDED); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("BOUNDED LINE LENGTH " & + "REQUIRED"); + RAISE INCOMPLETE; + END; + + PUT_CHARS (100, 'A'); -- ONE LINE + + CHECK_FILE (FT,"XXXXXXXXXX#" & + "XXXXXXXXXX#" & + "XXXXXXXXXX#" & + "XXXXXXXXXX#" & + "XXXXXXXXXX#@" & + "XXXXXXXXXX#" & + "XXXXXXXXXX#" & + "XXXXXXXXXX#" & + "XXXXXXXXXX#" & + "XXXXXXXXXX#@" & + "XXXXXXXXXX#" & + "XXXXXXXXXX#" & + "XXXXXXXXXX#" & + "XXXXXXXXXX#" & + "XXXXXXXXXX#" & + "BBBBB#" & + "BBBBB#" & + "BBBBB#" & + "BBBBB#" & + "BBBBB#@" & + "BBBBB#" & + "BBBBB#" & + "BBBBB#" & + "BBBBB#" & + "BBBBBKKKKKKKKKKKKKKKKKKKK#@" & + "KKKKKKKKKKKKKKKKKKKKKKKKK#" & + "KKKKKKKKKKKKKKKKKKKKKKKKK#" & + "KKKKKKKKKKKKKKKKKKKKKKKKK#" & + "KKKKKKKKKKKKKKKKKKKKKKKKK#@" & + "KKKKKKKKKKKKKKKKKKKKKKKKK#" & + "KKKKKKKKKKKKKKKKKKKKKKKKK#" & + "KKKKKKKKKKKKKKKKKKKKKKKKK#" & + "KKKKKKKKKKKKKKKKKKKKKKKKK#@" & + "KKKKKKKKKKKKKKKKKKKKKKKKK#" & + "KKKKKKKKKKKKKKKKKKKKKKKKK#"& + "KKKKKKKKKKKKKKKKKKKKKKKKK#"& + "KKKKKKKKKKKKKKKAAAAAAAAAAA" & + "AAAAAAAAAAAAAAAAAAAAAAAAAA" & + "AAAAAAAAAAAAAAAAAAAAAAAAAA" & + "AAAAAAAAAAAAAAAAAAAAAAAAAA" & + "AAAAAAAAAAA#@%"); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3305A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3306a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3306a.ada new file mode 100644 index 000000000..c021f3147 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3306a.ada @@ -0,0 +1,82 @@ +-- CE3306A.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 CONSTRAINT_ERROR IS RAISED IF THE VALUE OF 'TO' IS +-- NEGATIVE OR GREATER THAN COUNT'LAST WHEN COUNT'LAST IS LESS THAN +-- COUNT'BASE'LAST. + +-- HISTORY: +-- JET 08/17/88 CREATED ORIGINAL TEST. +-- PWN 10/27/95 REMOVED CONSTRAINT CHECK THAT NOW HAPPENS AT +-- COMPILE TIME. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; +PROCEDURE CE3306A IS + +BEGIN + TEST ("CE3306A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE " & + "VALUE OF 'TO' IS NEGATIVE OR GREATER THAN " & + "COUNT'LAST WHEN COUNT'LAST IS LESS THAN " & + "COUNT'BASE'LAST"); + + BEGIN + SET_LINE_LENGTH(-1); + FAILED("NO EXCEPTION FOR SET_LINE_LENGTH(-1)"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED("UNEXPECTED EXCEPTION FOR SET_LINE_LENGTH(-1)"); + END; + + BEGIN + SET_PAGE_LENGTH(COUNT(IDENT_INT(-1))); + FAILED("NO EXCEPTION FOR SET_PAGE_LENGTH(-1)"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED("UNEXPECTED EXCEPTION FOR SET_PAGE_LENGTH(-1)"); + END; + + IF COUNT'LAST < COUNT'BASE'LAST THEN + BEGIN + SET_LINE_LENGTH(COUNT'LAST + COUNT(IDENT_INT(1))); + FAILED("NO EXCEPTION FOR SET_LINE_LENGTH(COUNT'LAST+1)"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED("UNEXPECTED EXCEPTION FOR SET_LINE_LENGTH" & + "(COUNT'LAST+1)"); + END; + + ELSE + COMMENT("COUNT'LAST IS EQUAL TO COUNT'BASE'LAST"); + END IF; + + RESULT; +END CE3306A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3401a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3401a.ada new file mode 100644 index 000000000..714e16c03 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3401a.ada @@ -0,0 +1,105 @@ +-- CE3401A.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 THE FORMAL PARAMETERS OF EACH COLUMN, LINE, AND +-- PAGE OPERATION ARE NAMED CORRECTLY. + +-- HISTORY: +-- JET 08/17/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; +PROCEDURE CE3401A IS + + FIN, FOUT : FILE_TYPE; + B : BOOLEAN; + C : COUNT; + FILE_OK : BOOLEAN := FALSE; + +BEGIN + TEST ("CE3401A", "CHECK THAT THE FORMAL PARAMETERS OF EACH " & + "COLUMN, LINE, AND PAGE OPERATION ARE NAMED " & + "CORRECTLY"); + + BEGIN + CREATE(FOUT, OUT_FILE, LEGAL_FILE_NAME); + FILE_OK := TRUE; + EXCEPTION + WHEN OTHERS => + NOT_APPLICABLE("OUTPUT FILE COULD NOT BE CREATED"); + END; + + IF FILE_OK THEN + NEW_LINE(FILE => FOUT, SPACING => 1); + NEW_PAGE(FILE => FOUT); + SET_COL(FILE => FOUT, TO => 1); + SET_LINE(FILE => FOUT, TO => 1); + C := COL(FILE => FOUT); + C := LINE(FILE => FOUT); + C := PAGE(FILE => FOUT); + + NEW_PAGE(FOUT); + + BEGIN + CLOSE(FOUT); + EXCEPTION + WHEN OTHERS => + FAILED("OUTPUT FILE COULD NOT BE CLOSED"); + FILE_OK := FALSE; + END; + END IF; + + IF FILE_OK THEN + BEGIN + OPEN(FIN, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN OTHERS => + FAILED("INPUT FILE COULD NOT BE OPENED"); + FILE_OK := FALSE; + END; + END IF; + + IF FILE_OK THEN + SKIP_LINE(FILE => FIN, SPACING => 1); + SKIP_PAGE(FILE => FIN); + B := END_OF_LINE(FILE => FIN); + B := END_OF_PAGE(FILE => FIN); + B := END_OF_FILE(FILE => FIN); + + BEGIN + DELETE(FIN); + EXCEPTION + WHEN USE_ERROR => + COMMENT("FILE COULD NOT BE DELETED"); + WHEN OTHERS => + FAILED("UNEXPECTED ERROR AT DELETION"); + END; + END IF; + + RESULT; +EXCEPTION + WHEN OTHERS => + FAILED("UNEXPECTED EXCEPTION RAISED"); +END CE3401A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3402a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3402a.ada new file mode 100644 index 000000000..18773f848 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3402a.ada @@ -0,0 +1,117 @@ +-- CE3402A.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 NEW_LINE RAISES MODE_ERROR WHEN THE FILE MODE +-- IS IN_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/16/82 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 08/19/87 ADDED ATTEMPT TO DELETE THE FILE AND REPLACED +-- RESET WITH CLOSE AND OPEN. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3402A IS + + INCOMPLETE : EXCEPTION; + FILE1 : FILE_TYPE; + SPAC : CONSTANT POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1)); + +BEGIN + + TEST ("CE3402A" , "CHECK THAT NEW_LINE RAISES MODE_ERROR " & + "WHEN THE FILE MODE IS IN_FILE"); + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + PUT_LINE (FILE1, "STUFF"); + CLOSE (FILE1); + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED FOR OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + NEW_LINE (FILE1,SPAC); + FAILED ("MODE_ERROR NOT RAISED FOR IN_FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR IN_FILE"); + END; + + BEGIN + NEW_LINE (STANDARD_INPUT,SPAC); + FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_INPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR STANDARD_INPUT"); + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3402A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3402c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3402c.ada new file mode 100644 index 000000000..ed5d27b1b --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3402c.ada @@ -0,0 +1,112 @@ +-- CE3402C.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 NEW_LINE INCREMENTS THE CURRENT PAGE BY ONE AND +-- SETS THE CURRENT LINE NUMBER TO ONE WHEN THE PAGE LENGTH IS +-- BOUNDED AND THE LINE NUMBER WOULD HAVE EXCEEDED THE +-- MAXIMUM PAGE LENGTH. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 09/01/82 +-- SPS 11/30/82 +-- SPS 01/24/82 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 08/19/87 ADDED ORIGINAL_LINE_LENGTH AND +-- ORIGINAL_PAGE_LENGTH VARIABLES AND CLOSED FILE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; +WITH CHECK_FILE; + +PROCEDURE CE3402C IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1)); + TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2)); + THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3)); + CHAR : CHARACTER := ('C'); + ITEM_CHAR : CHARACTER; + ORIGINAL_LINE_LENGTH : COUNT := LINE_LENGTH; + ORIGINAL_PAGE_LENGTH : COUNT := PAGE_LENGTH; + +BEGIN + + TEST ("CE3402C" , "CHECK END_OF_PAGE BEHAVIOR OF NEW_LINE"); + + BEGIN + CREATE (FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + END; + + SET_LINE_LENGTH (FILE,THREE); + SET_PAGE_LENGTH (FILE,TWO); + + FOR I IN 1..6 + LOOP + PUT (FILE,CHAR); + END LOOP; + + NEW_LINE (FILE); + + IF PAGE (FILE) /= TWO THEN + FAILED ("PAGE NOT INCREMENTED BY ONE"); + END IF; + + IF LINE (FILE) /= ONE THEN + FAILED ("LINE NOT SET TO ONE"); + END IF; + + NEW_LINE (FILE, 7); + IF PAGE (FILE) /= POSITIVE_COUNT(IDENT_INT (5)) THEN + FAILED ("MULTIPLE PAGES NOT CREATED BY NEW_LINE"); + END IF; + + SET_LINE_LENGTH (FILE, ORIGINAL_LINE_LENGTH); + SET_PAGE_LENGTH (FILE, ORIGINAL_PAGE_LENGTH); + CHECK_FILE (FILE, "CCC#CCC#@##@##@##@#@%"); + + CLOSE (FILE); + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3402C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3402d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3402d.ada new file mode 100644 index 000000000..a52c7dea6 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3402d.ada @@ -0,0 +1,92 @@ +-- CE3402D.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 NEW_LINE SETS THE CURRENT COLUMN NUMBER TO ONE, +-- AND NEW_LINE OUTPUTS LINE TERMINATORS WHEN THE SPACING IS +-- GREATER THAN ONE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATE WITH OUT_FILE MODE FOR TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 08/19/87 CHANGED FAILED MESSAGE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3402D IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1)); + SPAC3 : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3)); + FOUR : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(4)); + +BEGIN + + TEST ("CE3402D", "CHECK THAT NEW_LINE SETS THE CURRENT " & + "COLUMN NUMBER TO ONE, AND NEW_LINE OUTPUTS " & + "TERMINATORS WHEN THE SPACING IS " & + "GREATER THAN ONE"); + + BEGIN + CREATE (FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + END; + + FOR I IN 1..5 LOOP + PUT (FILE, 'X'); + END LOOP; + + NEW_LINE (FILE, SPAC3); + IF LINE (FILE) /= FOUR THEN + FAILED ("NEW_LINE DID NOT OUTPUT LINE TERMINATORS"); + END IF; + + IF COL (FILE) /= ONE THEN + FAILED ("COLUMN NOT SET TO ONE"); + END IF; + CLOSE (FILE); + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3402D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3402e.ada b/gcc/testsuite/ada/acats/tests/ce/ce3402e.ada new file mode 100644 index 000000000..7b498795a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3402e.ada @@ -0,0 +1,106 @@ +-- CE3402E.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 NEW_LINE RAISES CONSTRAINT_ERROR IF SPACING IS +-- ZERO, OR NEGATIVE. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/16/82 +-- JBG 08/30/83 +-- DWC 08/19/87 ADDED COUNT'LAST CASE. +-- PWN 10/27/95 REMOVED OUT OF RANGE STATIC VALUE CHECKS. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3402E IS + + FILE : FILE_TYPE; + +BEGIN + + TEST ("CE3402E" , "CHECK THAT NEW_LINE RAISES CONSTRAINT_ERROR " & + "IF SPACING IS ZERO, OR NEGATIVE"); + + BEGIN + NEW_LINE (FILE,POSITIVE_COUNT(IDENT_INT(0))); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR ZERO"); + END; + + BEGIN + NEW_LINE (FILE,POSITIVE_COUNT(IDENT_INT(-2))); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR NEGATIVE NUMBER"); + END; + + BEGIN + CREATE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + BEGIN + NEW_LINE (FILE,POSITIVE_COUNT(IDENT_INT(0))); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR ZERO"); + END; + + BEGIN + NEW_LINE (FILE,POSITIVE_COUNT(IDENT_INT(-2))); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR NEGATIVE NUMBER"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + RESULT; + +END CE3402E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3403a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3403a.ada new file mode 100644 index 000000000..67ed44c7d --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3403a.ada @@ -0,0 +1,109 @@ +-- CE3403A.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 SKIP_LINE CAN ONLY BE APPLIED TO FILES OF MODE +-- IN_FILE, MODE_ERROR IS RAISED FOR FILES OF MODE OUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT CREATION OF TEMPORARY FILES WITH OUT_FILE MODE. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/16/82 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/04/87 REVISED EXCEPTION HANDLERS AND ADDED A CASE +-- FOR STANDARD_OUTPUT. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3403A IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + SPAC : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1)); + +BEGIN + + TEST ("CE3403A" , "CHECK THAT SKIP_LINE CAN ONLY BE " & + "APPLIED TO FILES OF MODE IN_FILE"); + + BEGIN + CREATE (FILE, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE OF " & + "TEMPORARY FILE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + SKIP_LINE (FILE,SPAC); + FAILED ("MODE_ERROR NOT RAISED FOR OUT_FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR OUT_FILE"); + END; + + BEGIN + SKIP_LINE (CURRENT_OUTPUT,SPAC); + FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR " & + "CURRENT_OUTPUT"); + END; + + BEGIN + SKIP_LINE (STANDARD_OUTPUT,SPAC); + FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR " & + "STANDARD_OUTPUT"); + END; + + CLOSE (FILE); + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3403A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3403b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3403b.ada new file mode 100644 index 000000000..5cae13d47 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3403b.ada @@ -0,0 +1,152 @@ +-- CE3403B.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 THE SPACING PARAMETER OF SKIP_LINE IS OPTIONAL, +-- AND THAT THE DEFAULT VALUE IS ONE. +-- CHECK THAT THE FILE PARAMETER IS ALSO OPTIONAL, AND THAT THE +-- FUNCTION IS THEN APPLIED TO THE CURRENT DEFAULT INPUT FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 12/14/82 +-- JBG 1/17/83 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/04/87 REVISED EXCEPTION HANDLERS, REMOVED +-- DEPENDENCIES ON RESET, AND ADDED AN ATTEMPT +-- TO DELETE FILE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3403B IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + SPAC, TWO : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2)); + A : INTEGER := CHARACTER'POS('A'); + CH : CHARACTER; + +BEGIN + + TEST ("CE3403B" , "CHECK DEFAULT SPACING AND FILE " & + "OF SKIP_LINE"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + END; + + FOR I IN 1 .. 3 LOOP -- CREATES "BBB#CC#D##F#@%" + FOR J IN 1 .. 4-I LOOP + PUT (FILE, CHARACTER'VAL(A + I)); + END LOOP; + NEW_LINE (FILE); + END LOOP; + NEW_LINE (FILE); + PUT (FILE, 'F'); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & + "FOR IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FILE, CH); + IF CH /= CHARACTER'VAL (A + 1) THEN + FAILED ("LINE CONTENT WRONG - 1"); + END IF; + + SKIP_LINE (FILE); + + IF LINE (FILE) /= TWO THEN + FAILED ("SPACING DEFAULT NOT ONE"); + END IF; + + GET (FILE, CH); + IF CH /= CHARACTER'VAL (A + 2) THEN + FAILED ("LINE CONTENT WRONG - 2"); + END IF; + + SET_INPUT (FILE); + SKIP_LINE (FILE); + + IF LINE (FILE) /= 3 THEN + FAILED ("SKIP_LINE DOES NOT OPERATE CORRECTLY ON " & + "DEFAULT FILE"); + END IF; + + GET (FILE, CH); + IF CH /= CHARACTER'VAL (A + 3) THEN + FAILED ("LINE CONTENT WRONG - 3"); + END IF; + + SKIP_LINE; + + IF LINE (FILE) /= 4 THEN + FAILED ("LINE COUNT NOT 4; WAS " & COUNT'IMAGE(LINE(FILE))); + END IF; + + GET (FILE, CH); + IF CH /= 'F' THEN + FAILED ("NOT RIGHT LINE"); + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3403B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3403c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3403c.ada new file mode 100644 index 000000000..d6dd6586a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3403c.ada @@ -0,0 +1,122 @@ +-- CE3403C.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 SKIP_LINE SETS THE CURRENT COLUMN NUMBER TO ONE, +-- AND THAT IT IS PERFORMED SPACING TIMES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/08/87 REVISED EXCEPTION HANDLING, REMOVED +-- DEPENDENCE ON RESET, AND ADDED NEW CASES. +-- GJD 11/15/95 FIXED ADA 95 INCOMPATIBLE USE OF CHARACTER LITERALS. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3403C IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1)); + SPAC3 : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3)); + FOUR : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(4)); + CH: CHARACTER; + +BEGIN + + TEST ("CE3403C" , "CHECK THAT SKIP_LINE SETS THE CURRENT " & + "COLUMN NUMBER TO ONE, AND THAT IT IS " & + "PERFORMED SPACING TIMES"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + END; + + FOR I IN CHARACTER RANGE 'A' .. 'E' LOOP + FOR J IN 1 .. 3 LOOP + PUT (FILE, I); + END LOOP; + NEW_LINE (FILE); + END LOOP; + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & + "FOR IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + IF COL (FILE) /= ONE THEN + FAILED ("COLUMN NOT SET TO ONE"); + END IF; + + GET (FILE, CH); + + IF CH /= 'A' THEN + FAILED ("INCORRECT VALUE READ - 1"); + END IF; + + SKIP_LINE (FILE,SPAC3); + GET (FILE, CH); + + IF CH /= 'D' THEN + FAILED ("INCORRECT VALUE READ - 2"); + END IF; + + IF LINE (FILE) /= FOUR THEN + FAILED ("NOT PERFORMED SPACING TIMES"); + END IF; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3403C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3403d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3403d.ada new file mode 100644 index 000000000..6fc1a2532 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3403d.ada @@ -0,0 +1,99 @@ +-- CE3403D.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 SKIP_LINE RAISES CONSTRAINT_ERROR IF SPACING IS +-- ZERO OR NEGATIVE. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/16/82 +-- SPS 11/11/82 +-- DWC 09/09/87 ADDED CASE FOR COUNT'LAST. +-- KAS 11/27/95 REMOVED CASES FOR COUNT'LAST +-- TMB 11/19/96 FIXED OBJECTIVE + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3403D IS + + FILE : FILE_TYPE; + +BEGIN + + TEST ("CE3403D" , "CHECK THAT SKIP_LINE RAISES " & + "CONSTRAINT_ERROR IF SPACING IS ZERO, " & + "OR NEGATIVE" ); + BEGIN + SKIP_LINE (FILE, POSITIVE_COUNT(IDENT_INT(0))); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR ZERO"); + END; + + BEGIN + SKIP_LINE (FILE, POSITIVE_COUNT(IDENT_INT(-2))); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR " & + "NEGATIVE NUMBER"); + END; + + + BEGIN + SKIP_LINE (POSITIVE_COUNT(IDENT_INT(0))); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO - DEFAULT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR ZERO " & + "- DEFAULT"); + END; + + BEGIN + SKIP_LINE (POSITIVE_COUNT(IDENT_INT(-6))); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUM " & + "- DEFAULT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED NEGATIVE NUM " & + "- DEFAULT"); + END; + + + RESULT; + +END CE3403D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3403e.ada b/gcc/testsuite/ada/acats/tests/ce/ce3403e.ada new file mode 100644 index 000000000..3d324a72c --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3403e.ada @@ -0,0 +1,150 @@ +-- CE3403E.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 SKIP_LINE INCREMENTS THE CURRENT LINE NUMBER BY ONE +-- AND SETS THE CURRENT COLUMN NUMBER TO ONE IF THE LINE TERMINATOR +-- IS NOT FOLLOWED BY A PAGE TERMINATOR, AND THAT IT SETS BOTH THE +-- LINE AND COLUMN NUMBERS TO ONE AND INCREMENTS THE CURRENT PAGE +-- NUMBER BY ONE IF THE LINE TERMINATOR IS FOLLOWED BY A PAGE +-- TERMINATOR. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/20/82 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/09/87 REVISED TEST TO USE A FILE NAME, REMOVED +-- DEPENDENCE ON RESET, AND ATTEMPTED TO +-- DELETE THE FILE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3403E IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1)); + TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2)); + CHAR : CHARACTER := ('C'); + +BEGIN + + TEST ("CE3403E" , "CHECK THAT SKIP_LINE SETS COLUMN, " & + "LINE, AND PAGE NUMBERS CORRECTLY"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, CHAR); + NEW_LINE (FILE); + PUT (FILE, CHAR); + NEW_PAGE (FILE); + PUT (FILE, CHAR); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + IF (LINE (FILE) /= ONE) OR (PAGE (FILE) /= ONE) THEN + FAILED ("INCORRECT LINE AND PAGE NUMBERS"); + ELSE + +-- LINE TERMINATOR NOT FOLLOWED BY PAGE TERMINATOR + + GET (FILE, CHAR); + + IF CHAR /= 'C' THEN + FAILED ("INCORRECT VALUE READ - 1"); + END IF; + + SKIP_LINE (FILE); + IF LINE (FILE) /= TWO THEN + FAILED ("FIRST SUBTEST - LINE NOT INCREMENTED"); + END IF; + IF COL (FILE) /= ONE THEN + FAILED ("FIRST SUBTEST - COLUMN NOT SET TO ONE"); + END IF; + +-- LINE TERMINATOR FOLLOWED BY PAGE TERMINATOR + + GET (FILE, CHAR); + + IF CHAR /= 'C' THEN + FAILED ("INCORRECT VALUE READ - 2"); + END IF; + + SKIP_LINE (FILE); + IF LINE (FILE) /= ONE THEN + FAILED ("SECOND SUBTEST - LINE NOT SET TO ONE"); + END IF; + IF COL (FILE) /= ONE THEN + FAILED ("SECOND SUBTEST - COLUMN NOT SET TO ONE"); + END IF; + IF PAGE (FILE) /= TWO THEN + FAILED ("SECOND SUBTEST - PAGE NOT INCREMENTED"); + END IF; + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3403E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3403f.ada b/gcc/testsuite/ada/acats/tests/ce/ce3403f.ada new file mode 100644 index 000000000..ebd6420f5 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3403f.ada @@ -0,0 +1,156 @@ +-- CE3403F.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 SKIP_LINE RAISES END_ERROR IF AN ATTEMPT IS +-- MADE TO SKIP A FILE TERMINATOR. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 11/11/82 +-- SPS 12/14/82 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/09/87 REVISED TEST TO USE A FILE NAME, REMOVED +-- DEPENDENCE ON RESET, AND ADDED ATTEMPT TO +-- DELETE THE FILE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3403F IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + CHAR : CHARACTER := ('C'); + ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT (1)); + TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT (2)); + +BEGIN + TEST ("CE3403F" , "CHECK THAT SKIP_LINE RAISES END_ERROR " & + "IF AN ATTEMPT IS MADE TO SKIP A FILE " & + "TERMINATOR"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + END; + + FOR I IN 1..3 + LOOP + PUT (FILE,CHAR); + END LOOP; + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & + "FOR IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + GET (FILE, CHAR); + IF CHAR /= 'C' THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + + SKIP_LINE (FILE); + SKIP_LINE (FILE); + FAILED ("END_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN END_ERROR => + + IF COL (FILE) /= ONE THEN + FAILED ("COL NOT RESET CORRECTLY"); + END IF; + + IF NOT END_OF_FILE (FILE) THEN + FAILED ("NOT POSITIONED AT END OF FILE"); + END IF; + + IF PAGE (FILE) /= TWO THEN + FAILED ("PAGE NOT INCREMENTED"); + END IF; + + IF LINE (FILE) /= ONE THEN + FAILED ("LINE NOT RESET CORRECTLY"); + END IF; + + IF NOT END_OF_LINE (FILE) THEN + FAILED ("EOL FALSE AT FILE TERMINATOR"); + END IF; + + IF NOT END_OF_PAGE (FILE) THEN + FAILED ("EOP FALSE AT FILE TERMINATOR"); + END IF; + + BEGIN + SKIP_LINE (FILE); + FAILED ("END_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED - 1"); + END; + + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED - 2"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3403F; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3404a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3404a.ada new file mode 100644 index 000000000..a944138ec --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3404a.ada @@ -0,0 +1,94 @@ +-- CE3404A.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 END_OF_LINE RAISES MODE_ERROR WHEN APPLIED TO +-- AN OUT_FILE. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/17/82 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- GMT 29/28/87 COMPLETELY REVISED. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3404A IS + + MY_FILE : FILE_TYPE; + BOOL : BOOLEAN; + +BEGIN + + TEST ("CE3404A", "CHECK THAT END_OF_LINE RAISES MODE_ERROR " & + "WHEN APPLIED TO AN OUT_FILE"); + + BEGIN + BOOL := END_OF_FILE (CURRENT_OUTPUT); + FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT - 1"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR " & + "CURRENT_OUTPUT - 2"); + END; + + BEGIN + BOOL := END_OF_FILE (STANDARD_OUTPUT); + FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_OUTPUT - 3"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR " & + "STANDARD_OUTPUT - 4"); + END; + + BEGIN + CREATE (MY_FILE); + BEGIN + BOOL := END_OF_FILE (MY_FILE); + FAILED ("MODE_ERROR NOT RAISED FOR MY_FILE - 5"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR " & + "MY_FILE - 6"); + + END; + + CLOSE (MY_FILE); + + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +END CE3404A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3404b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3404b.ada new file mode 100644 index 000000000..87ae4b166 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3404b.ada @@ -0,0 +1,130 @@ +-- CE3404B.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 END_OF_LINE OPERATES ON THE CURRENT DEFAULT INPUT FILE +-- IF NO FILE IS SPECIFIED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/17/82 +-- SPS 11/11/82 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- GMT 09/22/87 CREATED A NON-TEMP FILE, REMOVED DEPENDENCE ON +-- RESET, AND CHECKED THE VALUE OF THE CHAR READ. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3404B IS + + INCOMPLETE : EXCEPTION; + MY_FILE : FILE_TYPE; + LOOP_COUNT : INTEGER := 0; + BOOL : BOOLEAN; + CHAR : CHARACTER := ('C'); + +BEGIN + + TEST ("CE3404B", "CHECK THAT END_OF_LINE OPERATES ON THE " & + "CURRENT DEFAULT INPUT FILE IF NO FILE " & + "IS SPECIFIED"); + +-- CREATE AND INITIALIZE THE FILE + + BEGIN + CREATE (MY_FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE - 1"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE - 2"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE - 3"); + RAISE INCOMPLETE; + END; + + FOR I IN 1..3 LOOP + PUT (MY_FILE,CHAR); + END LOOP; + NEW_LINE (MY_FILE); + PUT (MY_FILE,CHAR); + + CLOSE (MY_FILE); + + BEGIN + OPEN (MY_FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE ERROR RAISED ON ATTEMPT TO " & + "RE-OPEN WITH MODE OF IN_FILE - 4"); + RAISE INCOMPLETE; + END; + + SET_INPUT (MY_FILE); + +-- START THE TEST + + LOOP + GET (CHAR); + IF CHAR /= 'C' THEN + FAILED ("CHAR READ FROM FILE HAS WRONG VALUE - 5"); + RAISE INCOMPLETE; + END IF; + EXIT WHEN END_OF_LINE; + LOOP_COUNT := LOOP_COUNT + 1; + IF LOOP_COUNT > IDENT_INT (3) THEN + FAILED ("END_OF_LINE ON DEFAULT INCORRECT - 6"); + EXIT; + END IF; + END LOOP; + + GET (CHAR); + IF CHAR /= 'C' THEN + FAILED ("FINAL CHAR READ FROM FILE HAS WRONG VALUE - 7"); + END IF; + + BEGIN + DELETE (MY_FILE); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3404B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3404c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3404c.ada new file mode 100644 index 000000000..c03cf557a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3404c.ada @@ -0,0 +1,165 @@ +-- CE3404C.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 END_OF_LINE RETURNS THE CORRECT VALUE WHEN POSITIONED +-- AT THE BEGINNING AND THE END OF A LINE, AND WHEN POSITIONED JUST +-- BEFORE THE FILE TERMINATOR. + +-- CASE 1) BOUNDED LINE LENGTH + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/17/82 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- GMT 09/22/87 REMOVED DEPENDENCE ON RESET AND MOVED THE CHECK +-- FOR UNBOUNDED LINE_LENGTH TO CE3404D.ADA. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3404C IS + INCOMPLETE : EXCEPTION; + MY_FILE : FILE_TYPE; + ITEM_CHAR : CHARACTER; + CHAR : CHARACTER := ('C'); + TEN : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(10)); + BLANK_COUNTER : NATURAL := 0; + +BEGIN + + TEST ("CE3404C", "CHECK THAT END_OF_LINE RETURNS THE CORRECT " & + "VALUE WHEN POSITIONED AT THE BEGINNING " & + "AND THE END OF A LINE, AND WHEN POSITIONED " & + "JUST BEFORE THE FILE TERMINATOR"); + +-- CREATE AND INITIALIZE TEST FILE WITH BOUNDED LINE LENGTH + + BEGIN + CREATE (MY_FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + SET_LINE_LENGTH (MY_FILE,TEN); + + FOR I IN 1..5 LOOP + PUT (MY_FILE, CHAR); + END LOOP; + NEW_LINE (MY_FILE); + PUT (MY_FILE, 'B'); + + CLOSE (MY_FILE); + + BEGIN + OPEN (MY_FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + +-- BEGIN THE TEST + + IF END_OF_LINE (MY_FILE) THEN + FAILED ("END_OF_LINE: INCORRECT VALUE AT FIRST POSITION - 5"); + END IF; + + IF COL (MY_FILE) /= 1 THEN + FAILED ("EOL MODIFIED COL NUMBER - 6"); + END IF; + + FOR I IN 1..4 LOOP + GET (MY_FILE,ITEM_CHAR); + END LOOP; + + IF END_OF_LINE (MY_FILE) THEN + FAILED ("END_OF_LINE: INCORRECT VALUE AT FIFTH POSITION - 7"); + END IF; + + GET (MY_FILE,ITEM_CHAR); + + WHILE NOT END_OF_LINE (MY_FILE) LOOP + GET (MY_FILE, ITEM_CHAR); + IF ITEM_CHAR = ' ' THEN + BLANK_COUNTER := BLANK_COUNTER + 1; + ELSE + FAILED ("STRING WAS PADDED WITH SOMETHING OTHER THAN " & + "BLANKS - 8"); + END IF; + END LOOP; + + IF BLANK_COUNTER > 5 THEN + FAILED ("TOO MANY BLANKS WERE USED FOR PADDING - 9"); + END IF; + + IF LINE (MY_FILE) /= 1 THEN + FAILED ("EOL SKIPPED LINE TERMINATOR - 10"); + END IF; + + IF NOT END_OF_LINE (MY_FILE) THEN + FAILED ("EOL SKIPPED LINE TERMINATOR - 11"); + END IF; + + SKIP_PAGE (MY_FILE); + + IF PAGE (MY_FILE) /= 2 THEN + FAILED ("INCORRECT PAGE NUMBER"); + END IF; + + IF NOT END_OF_LINE (MY_FILE) THEN + FAILED ("INCORRECT VALUE WHEN POSITIONED JUST BEFORE FILE " & + "TERMINATOR"); + END IF; + + BEGIN + DELETE (MY_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3404C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3404d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3404d.ada new file mode 100644 index 000000000..33e1f725b --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3404d.ada @@ -0,0 +1,152 @@ +-- CE3404D.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 END_OF_LINE RETURNS THE CORRECT VALUE WHEN POSITIONED +-- AT THE BEGINNING AND THE END OF A LINE, AND WHEN POSITIONED JUST +-- BEFORE THE FILE TERMINATOR. + +-- CASE 2) UNBOUNDED LINE LENGTH + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- GMT 09/22/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3404D IS + INCOMPLETE : EXCEPTION; + MY_FILE : FILE_TYPE; + ITEM_CHAR : CHARACTER; + CHAR : CHARACTER := ('C'); + TEN : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(10)); + BLANK_COUNTER : NATURAL := 0; + +BEGIN + + TEST ("CE3404D", "CHECK THAT END_OF_LINE RETURNS THE CORRECT " & + "VALUE WHEN POSITIONED AT THE BEGINNING AND " & + "THE END OF A LINE, AND WHEN POSITIONED JUST " & + "BEFORE THE FILE TERMINATOR"); + +-- CREATE AND INITIALIZE TEST FILE WITH BOUNDED LINE LENGTH + + BEGIN + CREATE (MY_FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + FOR I IN 1..5 LOOP + PUT (MY_FILE, CHAR); + END LOOP; + NEW_LINE (MY_FILE); + PUT (MY_FILE, 'B'); + + CLOSE (MY_FILE); + + BEGIN + OPEN (MY_FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + +-- BEGIN THE TEST + + IF END_OF_LINE (MY_FILE) THEN + FAILED ("END_OF_LINE: INCORRECT VALUE AT FIRST POSITION - 5"); + END IF; + + IF COL (MY_FILE) /= 1 THEN + FAILED ("EOL MODIFIED COL NUMBER - 6"); + END IF; + + FOR I IN 1..4 LOOP + GET (MY_FILE,ITEM_CHAR); + END LOOP; + + IF END_OF_LINE (MY_FILE) THEN + FAILED ("END_OF_LINE: INCORRECT VALUE AT FIFTH POSITION - 7"); + END IF; + + GET (MY_FILE,ITEM_CHAR); + + WHILE NOT END_OF_LINE (MY_FILE) LOOP + GET (MY_FILE, ITEM_CHAR); + IF ITEM_CHAR = ' ' THEN + FAILED ("STRING WAS PADDED WITH SOMETHING OTHER THAN " & + "BLANKS - 8"); + END IF; + END LOOP; + + IF LINE (MY_FILE) /= 1 THEN + FAILED ("EOL SKIPPED LINE TERMINATOR - 10"); + END IF; + + IF NOT END_OF_LINE (MY_FILE) THEN + FAILED ("EOL SKIPPED LINE TERMINATOR - 11"); + END IF; + + SKIP_PAGE (MY_FILE); + + IF PAGE (MY_FILE) /= 2 THEN + FAILED ("INCORRECT PAGE NUMBER"); + END IF; + + IF NOT END_OF_LINE (MY_FILE) THEN + FAILED ("INCORRECT VALUE WHEN POSITIONED JUST BEFORE " & + "TERMINATOR"); + END IF; + + BEGIN + DELETE (MY_FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3404D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3405a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3405a.ada new file mode 100644 index 000000000..d035af7ce --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3405a.ada @@ -0,0 +1,127 @@ +-- CE3405A.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 NEW_PAGE OUTPUTS A LINE TERMINATOR FOLLOWED BY A PAGE +-- TERMINATOR IF THE CURRENT LINE IS NOT AT COLUMN 1 OR IF THE +-- CURRENT PAGE IS AT LINE 1; IF THE CURRENT LINE IS AT COLUMN 1, +-- OUTPUTS A PAGE TERMINATOR ONLY. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- ABW 09/02/82 +-- JBG 01/18/83 +-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/23/87 ADDED A CASE WHICH CALLS NEW_LINE AND NEW_PAGE +-- CONSECUTIVELY AND SEPARATED CASES INTO DIFFERENT +-- IF STATEMENTS. ADDED CHECK FOR USE_ERROR ON +-- DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; +WITH CHECK_FILE; + +PROCEDURE CE3405A IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1)); + TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2)); + THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3)); + FOUR : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(4)); + CHAR : CHARACTER := ('C'); + +BEGIN + + TEST ("CE3405A", "CHECK THAT NEW_PAGE OUTPUTS A LINE TERMINATOR " & + "FOLLOWED BY A PAGE TERMINATOR IF THE CURRENT " & + "LINE IS NOT AT COLUMN 1 OR IF THE CURRENT " & + "PAGE IS AT LINE 1; IF THE CURRENT LINE IS AT " & + "COLUMN 1, OUTPUTS A PAGE TERMINATOR ONLY"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + NEW_PAGE (FILE); + NEW_PAGE (FILE); -- CURRENT PAGE TERMINATED + IF PAGE (FILE) /= THREE THEN + FAILED ("INITIAL PAGE COUNT INCORRECT"); + END IF; + + SET_LINE_LENGTH (FILE,THREE); + PUT (FILE,CHAR); + NEW_LINE (FILE); + + IF LINE (FILE) /= TWO THEN + FAILED ("INCORRECT LINE NUMBER - 1"); + END IF; + + IF PAGE (FILE) /= THREE THEN + FAILED ("INCORRECT PAGE NUMBER - 2"); + END IF; + + NEW_PAGE (FILE); -- CURRENT LINE TERMINATED (B) + IF LINE (FILE) /= ONE THEN + FAILED ("LINE NUMBER NOT INCREMENTED"); + END IF; + IF PAGE (FILE) /= FOUR THEN + FAILED ("PAGE NUMBER NOT INCREMENTED"); + END IF; + PUT (FILE, IDENT_CHAR('E')); -- CURRENT LINE NOT TERM (C) + NEW_PAGE (FILE); + NEW_LINE (FILE); + NEW_PAGE (FILE); + + CHECK_FILE (FILE, "#@#@C#@E#@#@%"); + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3405A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3405c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3405c.ada new file mode 100644 index 000000000..27f157440 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3405c.ada @@ -0,0 +1,126 @@ +-- CE3405C.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 NEW_PAGE RAISES MODE_ERROR IF THE FILE SPECIFIED +-- HAS MODE IN_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/23/87 CREATED AN EXTERNAL FILE, REMOVED DEPENDENCE ON +-- RESET, AND CHECKED FOR USE_ERROR ON DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3405C IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + +BEGIN + + TEST ("CE3405C", "CHECK THAT NEW_PAGE RAISES MODE_ERROR IF THE " & + "FILE SPECIFIED HAS MODE IN_FILE"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, "STUFF"); + + CLOSE (FILE); + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + NEW_PAGE (FILE); + FAILED ("MODE_ERROR NOT RAISED FOR IN_FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR IN_FILE"); + END; + + BEGIN + NEW_PAGE (STANDARD_INPUT); + FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_INPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR STANDARD_INPUT"); + END; + + BEGIN + NEW_PAGE (CURRENT_INPUT); + FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_INPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR CURRENT_INPUT"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3405C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3405d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3405d.ada new file mode 100644 index 000000000..b21fb1df6 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3405d.ada @@ -0,0 +1,114 @@ +-- CE3405D.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 NEW_PAGE INCREMENTS THE CURRENT PAGE NUMBER AND +-- SETS THE CURRENT COLUMN AND LINE NUMBERS TO ONE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 08/28/82 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/23/87 CORRECTED EXCEPTION HANDLING AND ADDED CASES FOR +-- CONSECUTIVE NEW_LINE AND NEW_PAGE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; +WITH CHECK_FILE; + +PROCEDURE CE3405D IS + INCOMPLETE : EXCEPTION; +BEGIN + + TEST ("CE3405D", "CHECK THAT NEW_PAGE INCREMENTS PAGE COUNT " & + "AND SETS COLUMN AND LINE TO ONE"); + + DECLARE + FT : FILE_TYPE; + CH : CHARACTER; + PG_NUM : POSITIVE_COUNT; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "FOR TEMP FILE WITH OUT_FILE " & + "MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FT, "STRING"); + NEW_LINE (FT); + PUT (FT, 'X'); + PG_NUM := PAGE (FT); + + NEW_PAGE (FT); + + IF COL(FT) /= 1 THEN + FAILED ("COLUMN NUMBER NOT RESET - OUTPUT - 1"); + END IF; + IF LINE (FT) /= 1 THEN + FAILED ("LINE NUMBER NOT RESET - OUTPUT - 1"); + END IF; + IF PAGE (FT) /= PG_NUM + 1 THEN + FAILED ("PAGE NUMBER NOT INCREMENTED - OUTPUT - 1"); + END IF; + + PUT (FT, "MORE STUFF"); + NEW_LINE (FT); + NEW_PAGE (FT); + + IF COL(FT) /= 1 THEN + FAILED ("COLUMN NUMBER NOT RESET - OUTPUT - 2"); + END IF; + IF LINE (FT) /= 1 THEN + FAILED ("LINE NUMBER NOT RESET - OUTPUT - 2"); + END IF; + IF PAGE (FT) /= PG_NUM + 2 THEN + FAILED ("PAGE NUMBER NOT INCREMENTED - OUTPUT - 2"); + END IF; + + CHECK_FILE (FT, "STRING#X#@MORE STUFF#@%"); + + CLOSE (FT); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3405D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3406a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3406a.ada new file mode 100644 index 000000000..14765189f --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3406a.ada @@ -0,0 +1,159 @@ +-- CE3406A.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 SKIP_PAGE READS AND DISCARDS CHARACTERS AND LINE +-- TERMINATORS UNTIL A PAGE TERMINATOR IS READ, ADDS ONE TO THE +-- CURRENT PAGE NUMBER, AND SETS THE CURRENT COLUMN NUMBER AND LINE +-- NUMBER TO ONE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/17/82 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/24/87 CREATED NON-TEMPORARY FILE, REMOVED DEPENDENCE +-- ON RESET, AND CHECKED FOR USE_ERROR ON DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3406A IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + CHAR_X : CHARACTER := ('X'); + ITEM_CHAR : CHARACTER; + ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1)); + TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2)); + THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3)); + +BEGIN + + TEST ("CE3406A", "CHECK THAT SKIP_LINE READS AND " & + "SETS PAGE AND COLUMN CORRECTLY"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, "CDE"); + NEW_LINE (FILE); + PUT (FILE, "FGHI"); + NEW_LINE (FILE); + PUT (FILE, "JK"); + NEW_PAGE (FILE); + NEW_PAGE (FILE); + PUT (FILE,CHAR_X); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + IF (LINE (FILE) /= ONE) THEN + FAILED ("LINE NUMBER NOT EQUAL TO ONE"); + END IF; + + IF (PAGE (FILE) /= ONE) THEN + FAILED ("PAGE NUMBER NOT EQUAL TO ONE"); + END IF; + + GET (FILE, ITEM_CHAR); + + IF ITEM_CHAR /= 'C' THEN + FAILED ("INCORRECT VALUE READ FROM FILE - 1"); + END IF; + + SKIP_PAGE (FILE); + + IF COL (FILE) /= ONE THEN + FAILED ("COLUMN NOT SET TO ONE - 1"); + END IF; + + IF LINE (FILE) /= ONE THEN + FAILED ("LINE NOT SET TO ONE - 1"); + END IF; + + IF PAGE (FILE) /= TWO THEN + FAILED ("PAGE NOT SET TO TWO"); + END IF; + + SKIP_PAGE (FILE); + + IF COL (FILE) /= ONE THEN + FAILED ("COLUMN NOT SET TO ONE - 2"); + END IF; + + IF LINE (FILE) /= ONE THEN + FAILED ("LINE NOT SET TO ONE - 2"); + END IF; + + IF PAGE (FILE) /= THREE THEN + FAILED ("PAGE NOT SET TO THREE"); + END IF; + + GET (FILE, ITEM_CHAR); + IF ITEM_CHAR /= 'X' THEN + FAILED ("INCORRECT VALUE READ FROM FILE - 2"); + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3406A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3406b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3406b.ada new file mode 100644 index 000000000..95e7c7adb --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3406b.ada @@ -0,0 +1,104 @@ +-- CE3406B.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 SKIP_PAGE CAN ONLY BE APPLIED TO FILES OF MODE +-- IN_FILE, MODE_ERROR IS RAISED FOR FILES OF MODE OUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILE CREATE WITH OUT_FILE MODE. + +-- HISTORY: +-- ABW 08/26/82 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/24/87 CORRECTED EXCEPTION HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3406B IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + +BEGIN + + TEST ("CE3406B", "CHECK THAT SKIP_PAGE CAN ONLY BE " & + "APPLIED TO FILES OF MODE IN_FILE"); + + BEGIN + CREATE (FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "FOR TEMPORARY FILE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + SKIP_PAGE (FILE); + FAILED ("MODE_ERROR NOT RAISED FOR OUT_FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR OUT_FILE"); + END; + + BEGIN + SKIP_PAGE (STANDARD_OUTPUT); + FAILED ("MODE_ERROR RAISED FOR STANDARD_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR STANDARD_OUTPUT"); + END; + + BEGIN + SKIP_PAGE (CURRENT_OUTPUT); + FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR CURRENT_OUTPUT"); + END; + + CLOSE (FILE); + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3406B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3406c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3406c.ada new file mode 100644 index 000000000..bc3027429 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3406c.ada @@ -0,0 +1,148 @@ +-- CE3406C.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 SKIP_PAGE RAISES END_ERROR WHEN THE FILE IS POSITIONED +-- BEFORE THE FILE TERMINATOR BUT NOT WHEN THE FILE IS POSITIONED +-- BEFORE THE FINAL PAGE TERMINATOR. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/17/82 +-- JBG 01/24/83 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/24/87 CREATED NON-TEMPORARY FILE, REMOVED DEPENDENCE +-- ON RESET, AND CHECKED CHARACTER READ IN. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3406C IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + CHAR : CHARACTER := ('C'); + ITEM_CHAR : CHARACTER; + TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2)); + +BEGIN + + TEST ("CE3406C", "CHECK THAT SKIP_PAGE RAISES END_ERROR WHEN " & + "THE FILE IS POSITIONED BEFORE THE FILE " & + "TERMINATOR BUT NOT WHEN THE FILE IS " & + "POSITIONED BEFORE THE FINAL PAGE TERMINATOR"); + +-- CREATE AND INITIALIZE FILE + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + FOR I IN 1..2 LOOP + FOR I IN 1..3 LOOP + PUT (FILE,CHAR); + END LOOP; + NEW_LINE (FILE); + END LOOP; + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + +-- START TEST + +-- TEST SKIP_PAGE BEFORE FINAL PAGE TERMINATOR + + WHILE NOT END_OF_PAGE (FILE) LOOP + GET (FILE, ITEM_CHAR); + IF ITEM_CHAR /= 'C' THEN + FAILED ("INCORRECT VALUE READ FROM FILE"); + END IF; + END LOOP; + + BEGIN + SKIP_PAGE (FILE); + EXCEPTION + WHEN END_ERROR => + FAILED ("RAISED END_ERROR BEFORE FINAL PAGE " & + "TERMINATOR - 1"); + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 1"); + END; + + IF PAGE (FILE) /= TWO THEN + FAILED ("PAGE NOT SET TO TWO"); + END IF; + +-- TEST SKIP_PAGE BEFORE FILE TERMINATOR + BEGIN + SKIP_PAGE (FILE); + FAILED ("END_ERROR NOT RAISED"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 2"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3406C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3406d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3406d.ada new file mode 100644 index 000000000..fa1ba25f0 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3406d.ada @@ -0,0 +1,122 @@ +-- CE3406D.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 SKIP_PAGE OPERATES ON THE CURRENT DEFAULT INPUT +-- FILE WHEN NO FILE IS SPECIFIED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- JBG 01/26/83 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/24/87 CREATED NON-TEMPORARY FILE, REMOVED DEPENDENCE +-- ON RESET, AND CHECKED CHARACTER READ IN. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3406D IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + ITEM_CHAR : CHARACTER; + TWO : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2)); + THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3)); + +BEGIN + + TEST ("CE3406D", "CHECK THAT SKIP_PAGE OPERATES ON THE CURRENT " & + "DEFAULT INPUT FILE WHEN NO FILE IS SPECIFIED"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, "ABC"); + NEW_PAGE (FILE); + PUT (FILE, "DEF"); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + SET_INPUT (FILE); + + SKIP_PAGE; + + GET (FILE, ITEM_CHAR); + IF ITEM_CHAR /= 'D' THEN + FAILED ("INCORRECT VALUE READ FROM FILE"); + END IF; + + IF PAGE (CURRENT_INPUT) /= TWO THEN + FAILED ("SKIP_PAGE NOT APPLIED TO CURRENT_INPUT"); + END IF; + + SKIP_PAGE (FILE); + + IF PAGE (CURRENT_INPUT) /= THREE THEN + FAILED ("SKIP_PAGE NOT APPLIED TO CURRENT_INPUT"); + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3406D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3407a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3407a.ada new file mode 100644 index 000000000..d3a0052f2 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3407a.ada @@ -0,0 +1,141 @@ +-- CE3407A.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 END_OF_PAGE RETURNS THE CORRECT VALUE WHEN POSITIONED +-- AT THE BEGINNING AND AT THE END OF THE PAGE, AND BEFORE A FILE +-- TERMINATOR. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/22/82 +-- JBG 01/26/83 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/28/87 REMOVED UNNECESSARY CODE, REMOVED DEPENDENCE +-- ON RESET AND CHECKED FOR USE_ERROR ON DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3407A IS + + INCOMPLETE : EXCEPTION; + FILE1 : FILE_TYPE; + CHAR : CHARACTER := ('C'); + ITEM_CHAR : CHARACTER; + +BEGIN + + TEST ("CE3407A", "CHECK THAT END_OF_PAGE RETURNS " & + "THE CORRECT VALUE"); + +-- CREATE & INITIALIZE OUTPUT FILE + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + FOR I IN 1..6 LOOP + PUT (FILE1, CHAR); + END LOOP; + + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + IF END_OF_PAGE (FILE1) THEN + FAILED ("INCORRECT VALUE AT FIRST POSITION - 1"); + END IF; + + IF END_OF_PAGE (FILE1) THEN + FAILED ("INCORRECT VALUE AT FIRST POSITION - 2"); + END IF; + +-- TEST WHEN POSITIONED BEFORE LAST CHARACTER IN FILE + + FOR I IN 1..5 LOOP + GET (FILE1, ITEM_CHAR); + END LOOP; + + IF END_OF_PAGE (FILE1) THEN + FAILED ("INCORRECT VALUE BEFORE LAST CHARACTER"); + END IF; + +-- TEST WHEN AT END OF FILE + + GET (FILE1, ITEM_CHAR); + IF NOT END_OF_PAGE (FILE1) THEN + FAILED ("INCORRECT VALUE AT LAST POSITION"); + END IF; + + SKIP_PAGE (FILE1); + + IF NOT END_OF_PAGE (FILE1) THEN + FAILED ("INCORRECT VALUE BEFORE FILE TERMINATOR - 1"); + END IF; + + IF NOT END_OF_PAGE (FILE1) THEN + FAILED ("INCORRECT VALUE BEFORE FILE TERMINATOR - 2"); + END IF; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3407A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3407b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3407b.ada new file mode 100644 index 000000000..c4a509c3d --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3407b.ada @@ -0,0 +1,107 @@ +-- CE3407B.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 END_OF_PAGE CAN ONLY BE APPLIED TO FILES OF MODE +-- IN_FILE, THAT MODE_ERROR IS RAISED FOR FILES OF MODE OUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/22/82 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/28/87 CORRECTED EXCEPTION HANDLING AND ADDED CASE +-- FOR CURRENT_OUTPUT. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3407B IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + BOOL : BOOLEAN; + +BEGIN + + TEST ("CE3407B", "CHECK THAT END_OF_PAGE RAISES MODE_ERROR " & + "FOR FILES OF MODE OUT_FILE"); + + BEGIN + CREATE (FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE FOR " & + "TEMPORARY FILE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + BOOL := END_OF_PAGE (FILE); + FAILED ("MODE_ERROR NOT RAISED FOR OUT_FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR OUT_FILE"); + END; + + BEGIN + BOOL := END_OF_PAGE (STANDARD_OUTPUT); + FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR STANDARD_OUTPUT"); + END; + + BEGIN + BOOL := END_OF_PAGE (CURRENT_OUTPUT); + FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED FOR CURRENT_OUTPUT"); + END; + + CLOSE (FILE); + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3407B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3407c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3407c.ada new file mode 100644 index 000000000..7be1f47c4 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3407c.ada @@ -0,0 +1,134 @@ +-- CE3407C.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 THE FILE PARAMETER OF END_OF_PAGE IS OPTIONAL, AND +-- THAT THE FUNCTION IS THEN APPLIED TO THE CURRENT DEFAULT INPUT +-- FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/28/87 REMOVED DEPENDENCE ON RESET, ADDED MORE CASES FOR +-- END_OF_PAGE, AND CHECKED FOR USE_ERROR ON DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3407C IS + + INCOMPLETE : EXCEPTION; + FILE_IN : FILE_TYPE; + CHAR : CHARACTER := 'C'; + ITEM_CHAR : CHARACTER; + +BEGIN + + TEST ("CE3407C", "CHECK THAT THE FILE PARAMETER OF END_OF_PAGE " & + "IS OPTIONAL, AND THAT THE FUNCTION IS THEN " & + "APPLIED TO THE CURRENT DEFAULT INPUT FILE"); + + BEGIN + CREATE (FILE_IN, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " & + "MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + FOR I IN 1..3 LOOP + PUT (FILE_IN, CHAR); + END LOOP; + NEW_PAGE (FILE_IN); + PUT (FILE_IN, 'D'); + + CLOSE (FILE_IN); + + BEGIN + OPEN (FILE_IN, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + SET_INPUT (FILE_IN); + + IF END_OF_PAGE THEN + FAILED ("INCORRECT VALUE AT FIRST POSITION"); + END IF; + + IF END_OF_PAGE /= END_OF_PAGE (FILE_IN) THEN + FAILED ("END OF PAGE DOES NOT OPERATE WITH DEFAULT FILE"); + END IF; + + GET (ITEM_CHAR); + GET (ITEM_CHAR); + GET (ITEM_CHAR); + + IF END_OF_PAGE /= TRUE THEN + FAILED ("INCORRECT VALUE BEFORE PAGE TERMINATOR"); + END IF; + + IF END_OF_PAGE /= END_OF_PAGE (FILE_IN) THEN + FAILED ("END_OF_PAGE WITHOUT PARAMETER DOES " & + "NOT OPERATE ON THE DEFAULT INPUT FILE"); + END IF; + + GET (ITEM_CHAR); + + IF NOT (END_OF_PAGE) THEN + FAILED ("INCORRECT VALUE AT LAST POSITION"); + END IF; + + BEGIN + DELETE (FILE_IN); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3407C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3408a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3408a.ada new file mode 100644 index 000000000..2b0107e5a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3408a.ada @@ -0,0 +1,142 @@ +-- CE3408A.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 END_OF_FILE RETURNS TRUE ONLY IF POSITIONED BEFORE THE +-- FINAL PAGE TERMINATOR OR BEFORE THE FILE TERMINATOR. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- JBG 01/26/83 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/31/87 REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY +-- CODE, AND CHECKED FOR USE_ERROR ON DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3408A IS + + INCOMPLETE : EXCEPTION; + COUNT : INTEGER := 0; + FILE : FILE_TYPE; + CHAR : CHARACTER := ('C'); + ITEM_CHAR : CHARACTER; + +BEGIN + + TEST ("CE3408A", "CHECK THAT END_OF_FILE RETURNS " & + "THE CORRECT VALUE"); + +-- CREATE & INITIALIZE OUTPUT FILE. + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + FOR I IN 1..6 LOOP + PUT (FILE, CHAR); + END LOOP; + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + +-- TEST WHEN POSITIONED TO BEGINNING OF FILE. + + IF END_OF_FILE (FILE) THEN + FAILED ("INCORRECT VALUE AT FIRST POSITION - 1"); + END IF; + + IF END_OF_FILE (FILE) THEN + FAILED ("INCORRECT VALUE AT FIRST POSITION - 2"); + END IF; + +-- TEST WHEN POSITIONED BEFORE LAST CHARACTER IN FILE. + + FOR I IN 1..5 LOOP + GET (FILE, ITEM_CHAR); + END LOOP; + + IF END_OF_FILE (FILE) THEN + FAILED ("INCORRECT VALUE BEFORE LAST CHARACTER"); + END IF; + +-- TEST WHEN AT END OF FILE. + + GET (FILE, ITEM_CHAR); + IF NOT END_OF_FILE (FILE) THEN + FAILED ("INCORRECT VALUE AT LAST POSITION"); + END IF; + + SKIP_PAGE (FILE); + + IF NOT END_OF_FILE (FILE) THEN + FAILED ("INCORRECT VALUE BEFORE FILE TERMINATOR - 1"); + END IF; + + IF NOT END_OF_FILE (FILE) THEN + FAILED ("INCORRECT VALUE BEFORE FILE TERMINATOR - 2"); + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3408A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3408b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3408b.ada new file mode 100644 index 000000000..a8269f7ab --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3408b.ada @@ -0,0 +1,109 @@ +-- CE3408B.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 END_OF_FILE CAN ONLY BE APPLIED TO FILES OF MODE +-- IN_FILE, MODE_ERROR IS RAISED FOR FILES OF MODE OUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/20/82 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/31/87 CORRECTED EXCEPTION HANDLING, REMOVED UNNECESSARY +-- CODE, AND CHECKED FOR USE_ERROR ON DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3408B IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + BOOL : BOOLEAN; + +BEGIN + + TEST ("CE3408B", "CHECK THAT END_OF_FILE CAN ONLY BE " & + "APPLIED TO FILES OF MODE IN_FILE"); + + BEGIN + CREATE (FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE FOR " & + "TEMPORARY FILE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + BOOL := END_OF_FILE (FILE); + FAILED ("MODE_ERROR NOT RAISED FOR OUT_FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR OUT_FILE"); + END; + + BEGIN + BOOL := END_OF_FILE (STANDARD_OUTPUT); + FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR " & + "STANDARD_OUTPUT"); + END; + + BEGIN + BOOL := END_OF_FILE (CURRENT_OUTPUT); + FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR " & + "CURRENT_OUTPUT"); + END; + + CLOSE (FILE); + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3408B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3408c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3408c.ada new file mode 100644 index 000000000..db74ac5bc --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3408c.ada @@ -0,0 +1,138 @@ +-- CE3408C.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 THE FILE PARAMETER OF END_OF_FILE IS OPTIONAL, AND +-- THAT THE FUNCTION IS THEN APPLIED TO THE CURRENT DEFAULT INPUT +-- FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/31/87 REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY +-- CODE, AND CHECKED FOR USE_ERROR ON DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3408C IS + + INCOMPLETE : EXCEPTION; + FILE_IN : FILE_TYPE; + CHAR : CHARACTER := 'A'; + ITEM_CHAR : CHARACTER; + +BEGIN + + TEST ("CE3408C", "CHECK THAT THE FILE PARAMETER OF END_OF_FILE " & + "IS OPTIONAL, AND THAT THE FUNCTION IS THEN " & + "APPLIED TO THE CURRENT DEFAULT INPUT FILE"); + + +-- CREATE TEST FILE + + BEGIN + CREATE (FILE_IN, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + FOR I IN 1..3 LOOP + PUT (FILE_IN, CHAR); + END LOOP; + NEW_PAGE (FILE_IN); + + PUT (FILE_IN, CHAR); + + CLOSE (FILE_IN); + + BEGIN + OPEN (FILE_IN, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "MODE IN_FILE"); + RAISE INCOMPLETE; + END; + + SET_INPUT (FILE_IN); + IF END_OF_FILE THEN + FAILED ("INCORRECT VALUE AT FIRST POSITION"); + END IF; + + IF END_OF_FILE /= END_OF_FILE (FILE_IN) THEN + FAILED ("END OF FILE DOES NOT OPERATE WITH DEFAULT FILE"); + END IF; + + WHILE NOT END_OF_PAGE (FILE_IN) + LOOP + GET (ITEM_CHAR); + END LOOP; + + IF END_OF_FILE THEN + FAILED ("INCORRECT VALUE BEFORE LAST CHARACTER"); + END IF; + + IF END_OF_FILE /= END_OF_FILE (FILE_IN) THEN + FAILED ("END_OF_FILE WITHOUT PARAMETER DOES " & + "NOT OPERATE ON THE DEFAULT INPUT FILE"); + END IF; + + GET (ITEM_CHAR); + + IF NOT (END_OF_FILE) THEN + FAILED ("INCORRECT VALUE AT LAST POSITION"); + END IF; + + BEGIN + DELETE (FILE_IN); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3408C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3409a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3409a.ada new file mode 100644 index 000000000..6dd5d1cc9 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3409a.ada @@ -0,0 +1,111 @@ +-- CE3409A.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 SET_COL RAISES LAYOUT_ERROR IF THE LINE LENGTH IS +-- BOUNDED AND THE GIVEN COLUMN POSITION EXCEEDS THE LINE LENGTH +-- FOR FILES OF MODE OUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE. + +-- HISTORY: +-- ABW 08/26/82 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/31/87 CORRECTD EXCEPTION HANDLING AND ADDED NEW CASES +-- FOR OBJECTIVE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3409A IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + THREE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(3)); + FOUR : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4)); + FIVE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(5)); + +BEGIN + + TEST ("CE3409A", "CHECK THAT SET_COL RAISES " & + "LAYOUT_ERROR APPROPRIATELY"); + + BEGIN + CREATE (FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE FOR " & + "TEMPORARY FILE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + SET_LINE_LENGTH (FILE, THREE); + + BEGIN + SET_COL (FILE, FOUR); + FAILED ("LAYOUT_ERROR NOT RAISED ON SET_COL - 1"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON SET_COL - 1"); + END; + + IF COL (FILE) /= 1 THEN + FAILED ("COLUMN LENGTH NOT INITIALLY ONE"); + END IF; + + PUT (FILE, 'A'); + PUT (FILE, 'B'); + PUT (FILE, 'C'); + + SET_LINE_LENGTH (FILE, FOUR); + + BEGIN + SET_COL (FILE, FIVE); + FAILED ("LAYOUT_ERROR NOT RAISED ON SET_COL - 2"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON SET_COL - 2"); + END; + + CLOSE (FILE); + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3409A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3409b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3409b.ada new file mode 100644 index 000000000..1af3f07f5 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3409b.ada @@ -0,0 +1,76 @@ +-- CE3409B.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 SET_COL RAISES CONSTRAINT_ERROR IF THE GIVEN +-- COLUMN NUMBER IS ZERO, OR NEGATIVE. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/22/82 +-- JBG 01/27/83 +-- JLH 08/31/87 CORRECTED EXCEPTION HANDLING, REMOVED UNNECESSARY +-- CODE, AND ADDED CASE FOR COUNT'LAST. +-- PWN 10/27/95 REMOVED OUT OF RANGE STATIC VALUE CHECKS. + +WITH REPORT ; +USE REPORT ; +WITH TEXT_IO ; +USE TEXT_IO ; + +PROCEDURE CE3409B IS + FILE : FILE_TYPE; +BEGIN + + TEST ("CE3409B", "CHECK THAT SET_COL RAISES CONSTRAINT_ERROR " & + "IF THE GIVEN COLUMN NUMBER IS ZERO, OR NEGATIVE."); + + BEGIN + SET_COL (FILE, POSITIVE_COUNT(IDENT_INT(0))); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR INSTEAD OF CONSTRAINT_ERROR - 1"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR ZERO"); + END; + + BEGIN + SET_COL (FILE, POSITIVE_COUNT(IDENT_INT(-2))); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR INSTEAD OF CONSTRAINT_ERROR - 2"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR NEGATIVE " & + "NUMBER"); + END; + + RESULT; + +END CE3409B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3409c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3409c.ada new file mode 100644 index 000000000..7085884a9 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3409c.ada @@ -0,0 +1,188 @@ +-- CE3409C.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 SET_COL SETS THE CURRENT COLUMN NUMBER TO THE VALUE +-- SPECIFIED BY TO FOR FILES OF MODES IN_FILE AND OUT_FILE. +-- CHECK THAT IT HAS NO EFFECT IF THE VALUE SPECIFIED BY TO IS +-- EQUAL TO THE CURRENT COLUMN NUMBER FOR BOTH IN_FILE AND OUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/20/82 +-- JBG 01/27/83 +-- SPS 02/18/83 +-- EG 05/22/85 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/31/87 REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY +-- CODE, AND CHECKED FOR USE_ERROR ON DELETE. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; +WITH CHECK_FILE; + +PROCEDURE CE3409C IS + + INCOMPLETE : EXCEPTION; + +BEGIN + TEST ("CE3409C", "CHECK THAT SET_COL SETS THE CURRENT COLUMN " & + "NUMBER TO THE VALUE SPECIFIED BY TO FOR FILES " & + "OF MODES IN_FILE AND OUT_FILE. CHECK THAT IT " & + "HAS NO EFFECT IF THE VALUE SPECIFIED BY TO IS " & + "EQUAL TO THE CURRENT COLUMN NUMBER FOR BOTH " & + "IN_FILE AND OUT_FILE"); + + DECLARE + FILE : FILE_TYPE; + CHAR : CHARACTER := ('C'); + ITEM_CHAR : CHARACTER; + ONE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1)); + TWO : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2)); + FOUR : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4)); + BEGIN + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " & + "CREATE"); + RAISE INCOMPLETE; + END; + + SET_PAGE_LENGTH (FILE, TWO); + SET_COL (FILE, FOUR); + IF COL (FILE) /= FOUR THEN + FAILED ("FOR OUT_FILE COLUMN NOT FOUR"); + ELSE + PUT (FILE, 'C'); + SET_COL (FILE, 5); + IF COL (FILE) /= FOUR+1 OR LINE (FILE) /= ONE THEN + FAILED ("FOR OUT_FILE COLUMN UNNECESSARILY " & + "CHANGED FROM FOUR"); + ELSE + SET_COL (FILE, 8); + PUT (FILE, "DE"); + SET_COL (FILE, TWO+1); + IF COL (FILE) /= TWO+ONE OR LINE (FILE) /= TWO THEN + FAILED ("FOR OUT_FILE COLUMN NOT TWO"); + END IF; + PUT (FILE, 'B'); + SET_COL (FILE, TWO); + + IF PAGE (FILE) /= TWO THEN + FAILED ("PAGE TERMINATOR NOT OUTPUT"); + END IF; + + IF LINE (FILE) /= ONE THEN + FAILED ("LINE TERMINATOR NOT OUTPUT"); + END IF; + + IF COL (FILE) /= TWO THEN + FAILED ("COL NOT TWO; IS" & + COUNT'IMAGE(COL(FILE))); + END IF; + + PUT (FILE, 'X'); + END IF; + END IF; + + CHECK_FILE (FILE, " C DE# B#@ X#@%"); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH MODE IN_FILE"); + RAISE INCOMPLETE; + END; + + SET_COL (FILE, FOUR); + IF COL (FILE) /= FOUR THEN + FAILED ("FOR IN_FILE COLUMN NOT FOUR"); + ELSE + GET (FILE, ITEM_CHAR); + IF ITEM_CHAR /= 'C' THEN + FAILED ("SET_COL FOR READ; ACTUALLY READ '" & + ITEM_CHAR & "'"); + END IF; + + SET_COL (FILE, 5); + IF COL (FILE) /= FOUR+1 OR LINE (FILE) /= ONE THEN + FAILED ("FOR IN_FILE COLUMN UNNECESSARILY " & + "CHANGED FROM FOUR"); + ELSE + SET_COL (FILE, 9); + GET (FILE, ITEM_CHAR); + IF ITEM_CHAR /= 'E' THEN + FAILED ("SET_COL FOR READ 2; ACTUALLY READ '" & + ITEM_CHAR & "'"); + END IF; + + SET_COL (FILE, 3); + GET (FILE, ITEM_CHAR); + IF ITEM_CHAR /= 'B' THEN + FAILED ("SET_COL FOR READ 3; ACTUALLY READ '" & + ITEM_CHAR & "'"); + END IF; + + IF COL (FILE) /= 4 OR LINE (FILE) /= TWO THEN + FAILED ("FOR IN_FILE COLUMN NOT TWO"); + END IF; + END IF; + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3409C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3409d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3409d.ada new file mode 100644 index 000000000..97ecd9b03 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3409d.ada @@ -0,0 +1,140 @@ +-- CE3409D.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, FOR FILES OF MODE IN_FILE, SET_COL READS UNTIL A +-- LINE FOUND HAVING A CHARACTER AT THE SPECIFIED COLUMN, SKIPPING +-- LINE AND PAGE TERMINATORS AS NECESSARY. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JBG 01/27/83 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/31/87 REMOVED DEPENDENCE ON REST, REMOVED UNNECESSARY +-- CODE, CHECKED FOR USE_ERROR ON DELETE, AND ADDED +-- NEW CASES FOR SET_COL. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3409D IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + FOUR : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4)); + ITEM_CHAR : CHARACTER; + +BEGIN + + TEST ("CE3409D", "CHECK THAT SET_COL SKIPS LINE AND PAGE " & + "TERMINATORS WHEN NECESSARY"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " & + "MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, "ABC"); + NEW_LINE (FILE); + PUT (FILE, "DEFGHI"); + NEW_PAGE (FILE); + PUT (FILE, "XYZ"); + NEW_PAGE (FILE); + PUT (FILE, "IJKL"); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "MODE IN_FILE"); + RAISE INCOMPLETE; + END; + + SET_COL (FILE, FOUR); + GET (FILE, ITEM_CHAR); + + IF ITEM_CHAR = ' ' THEN + BEGIN + COMMENT ("FILE PADS LINES WITH SPACES"); + + SET_COL (FILE, FOUR); + GET (FILE, ITEM_CHAR); + IF ITEM_CHAR /= 'G' THEN + FAILED ("INCORRECT VALUE FROM SET_COL - 1"); + END IF; + + SET_COL (FILE, FOUR); + GET (FILE, ITEM_CHAR); + IF ITEM_CHAR /= ' ' THEN + FAILED ("LINES SHOULD STILL BE PADDED WITH BLANKS"); + END IF; + END; + + ELSIF ITEM_CHAR /= 'G' THEN + FAILED ("SET_COL DOESN'T SKIP LINE MARKS; " & + "ACTUALLY READ '" & ITEM_CHAR & "'"); + ELSE + BEGIN + SET_COL (FILE, FOUR); + GET (FILE, ITEM_CHAR); + + IF ITEM_CHAR /= 'L' THEN + FAILED ("SET_COL DOESN'T SKIP PAGE MARKS; " & + "ACTUALLY READ '" & ITEM_CHAR & "'"); + END IF; + END; + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3409D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3409e.ada b/gcc/testsuite/ada/acats/tests/ce/ce3409e.ada new file mode 100644 index 000000000..28d072d7a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3409e.ada @@ -0,0 +1,115 @@ +-- CE3409E.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 SET_COL RAISES END_ERROR IF NO LINE BEFORE THE END OF +-- THE FILE IS LONG ENOUGH. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/20/82 +-- JBG 01/27/83 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/31/87 REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY +-- CODE, AND CHECKED FOR USE_ERROR ON DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3409E IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + CHAR : CHARACTER := ('C'); + ITEM_CHAR : CHARACTER; + +BEGIN + + TEST ("CE3409E", "CHECK THAT SET_COL RAISES END_ERROR " & + "WHEN IT ATTEMPTS TO READ THE FILE TERMINATOR"); + +-- CREATE & INITIALIZE FILE + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, "ABCD"); + NEW_LINE (FILE); + PUT (FILE, "DEF"); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + SET_COL (FILE, 513); + FAILED ("END ERROR NOT RAISED ON SET_COL"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON SET_COL"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3409E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3410a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3410a.ada new file mode 100644 index 000000000..a4e3870af --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3410a.ada @@ -0,0 +1,89 @@ +-- CE3410A.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 SET_LINE RAISES LAYOUT_ERROR IF THE PAGE LENGTH IS +-- BOUNDED AND THE GIVEN LINE POSITION EXCEEDS THE PAGE LENGTH +-- FOR FILES OF MODE OUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE. + +-- HISTORY: +-- ABW 08/26/82 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 08/31/87 CORRECTED EXCEPTION HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3410A IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + THREE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(3)); + FOUR : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4)); + +BEGIN + + TEST ("CE3410A", "CHECK THAT SET_LINE RAISES " & + "LAYOUT_ERROR APPROPRIATELY"); + + BEGIN + CREATE (FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE FOR " & + "TEMPORARY FILE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + SET_PAGE_LENGTH (FILE, THREE); + + BEGIN + SET_LINE (FILE, FOUR); + FAILED ("LAYOUT ERROR NOT RAISED FOR SET_LINE"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR SET_LINE"); + END; + + CLOSE (FILE); + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3410A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3410b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3410b.ada new file mode 100644 index 000000000..08f185fc8 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3410b.ada @@ -0,0 +1,77 @@ +-- CE3410B.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 SET_LINE RAISES CONSTRAINT_ERROR IF THE GIVEN +-- LINE NUMBER IS ZERO, OR NEGATIVE. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/22/82 +-- JBG 01/27/83 +-- JLH 08/31/87 ADDED CASE FOR COUNT'LAST. +-- PWN 10/27/95 REMOVED OUT OF RANGE STATIC VALUE CHECKS + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3410B IS + + FILE : FILE_TYPE; + +BEGIN + + TEST ("CE3410B", "CHECK THAT SET_LINE RAISES CONSTRAINT_ERROR " & + "IF THE GIVEN LINE NUMBER IS ZERO, OR NEGATIVE"); + + BEGIN + SET_LINE (FILE, POSITIVE_COUNT(IDENT_INT(0))); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR INSTEAD OF CONSTRAINT_ERROR - 1"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR ZERO"); + END; + + BEGIN + SET_LINE (FILE, POSITIVE_COUNT(IDENT_INT(-2))); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR INSTEAD OF CONSTRAINT_ERROR - 2"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR NEGATIVE " & + "NUMBER"); + END; + + RESULT; + +END CE3410B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3410c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3410c.ada new file mode 100644 index 000000000..dc004895d --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3410c.ada @@ -0,0 +1,205 @@ +-- CE3410C.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 SET_LINE SETS THE CURRENT LINE NUMBER TO THE VALUE +-- SPECIFIED BY TO FOR FILES OF MODES IN_FILE AND OUT_FILE. +-- CHECK THAT IT HAS NO EFFECT IF THE VALUE SPECIFIED BY TO IS +-- EQUAL TO THE CURRENT LINE NUMBER FOR BOTH IN_FILE AND OUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/20/82 +-- JBG 01/27/83 +-- EG 05/22/85 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/01/87 REMOVED DEPENDENCE ON RESET, ADDED MORE TEST +-- CASES, AND CHECKED FOR USE_ERROR ON DELETE. +-- JRL 02/29/96 Added File parameter to call to Set_Page_Length. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; +WITH CHECK_FILE; + +PROCEDURE CE3410C IS + + INCOMPLETE : EXCEPTION; + +BEGIN + TEST ("CE3410C", "CHECK THAT SET_LINE SETS LINE " & + "NUMBER CORRECTLY"); + + DECLARE + FILE : FILE_TYPE; + CHAR : CHARACTER := ('C'); + ITEM_CHAR : CHARACTER; + ONE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1)); + TWO : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2)); + THREE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(3)); + FOUR : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4)); + BEGIN + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " & + "CREATE"); + RAISE INCOMPLETE; + END; + + SET_LINE (FILE, FOUR); + IF LINE (FILE) /= FOUR THEN + FAILED ("FOR OUT_FILE LINE NOT FOUR"); + ELSE + PUT (FILE, 'C'); + NEW_LINE (FILE); + SET_LINE (FILE, 5); + IF LINE (FILE) /= FOUR+1 THEN + FAILED ("FOR OUT_FILE LINE UNNECESSARILY " & + "CHANGED FROM FOUR"); + ELSE + SET_LINE (FILE, 8); + PUT (FILE, "DE"); + SET_LINE (FILE, TWO+1); + IF LINE (FILE) /= TWO+ONE THEN + FAILED ("FOR OUT_FILE LINE NOT THREE"); + END IF; + + SET_LINE (FILE, TWO); + + IF PAGE (FILE) /= ONE+TWO THEN + FAILED ("PAGE TERMINATOR NOT OUTPUT - 2"); + END IF; + + IF LINE (FILE) /= TWO THEN + FAILED ("LINE NOT TWO; IS" & + COUNT'IMAGE(LINE(FILE))); + END IF; + + SET_PAGE_LENGTH (FILE, TWO); + PUT (FILE, 'X'); + SET_LINE (FILE, TWO); + PUT (FILE, 'Y'); + + IF LINE (FILE) /= TWO THEN + FAILED ("LINE NOT TWO; IS " & + COUNT'IMAGE(LINE(FILE))); + END IF; + + IF PAGE (FILE) /= THREE THEN + FAILED ("PAGE NOT THREE; IS " & + COUNT'IMAGE(PAGE(FILE))); + END IF; + + END IF; + END IF; + + CHECK_FILE (FILE, "###C####DE#@##@#XY#@%"); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED FOR TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + SET_LINE (FILE, FOUR); + IF LINE (FILE) /= FOUR THEN + FAILED ("FOR IN_FILE LINE NOT FOUR"); + ELSE + GET (FILE, ITEM_CHAR); + IF ITEM_CHAR /= 'C' THEN + FAILED ("SET_LINE FOR READ; ACTUALLY READ '" & + ITEM_CHAR & "'"); + END IF; + + SKIP_LINE (FILE); + SET_LINE (FILE, 5); + IF LINE (FILE) /= FOUR+1 OR PAGE (FILE) /= ONE THEN + FAILED ("INCORRECT LINE OR PAGE"); + ELSE + SET_LINE (FILE, 8); + GET (FILE, ITEM_CHAR); + IF ITEM_CHAR /= 'D' THEN + FAILED ("SET_LINE FOR READ 2; ACTUALLY READ '"& + ITEM_CHAR & "'"); + END IF; + + SET_LINE (FILE, TWO); + IF PAGE (FILE) /= TWO THEN + FAILED ("FOR IN_FILE PAGE NOT TWO"); + END IF; + + SET_LINE (FILE, TWO); + IF PAGE (FILE) /= TWO OR LINE (FILE) /= TWO THEN + FAILED ("FOR IN_FILE PAGE NOT 2"); + END IF; + + SKIP_LINE (FILE); + SET_LINE (FILE, TWO); + + GET (FILE, ITEM_CHAR); + + IF ITEM_CHAR /= 'X' THEN + FAILED ("SET_LINE FOR READ 3; ACTUALLY READ '"& + ITEM_CHAR & "'"); + END IF; + + END IF; + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3410C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3410d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3410d.ada new file mode 100644 index 000000000..09fa09ebc --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3410d.ada @@ -0,0 +1,118 @@ +-- CE3410D.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, FOR FILES OF MODE IN_FILE, SET_LINE READS UNTIL A +-- PAGE IS FOUND HAVING A LINE AT THE SPECIFIED POSITION, SKIPPING +-- LINE AND PAGE TERMINATORS AS NECESSARY. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JBG 01/27/83 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/01/87 REMOVED DEPENDENCE ON RESET AND CHECKED FOR +-- USE_ERROR ON DELETE. +-- GJD 11/15/95 FIXED ADA 95 INCOMPATIBLE USE OF CHARACTER LITERALS. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3410D IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + FOUR : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4)); + ITEM_CHAR : CHARACTER; + +BEGIN + + TEST ("CE3410D", "CHECK THAT SET_LINE SKIPS PAGE " & + "TERMINATORS WHEN NECESSARY"); + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " & + "MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + FOR I IN CHARACTER RANGE 'A'..'C' LOOP + PUT (FILE, I); + NEW_LINE (FILE); + END LOOP; + + NEW_PAGE (FILE); + + FOR I IN CHARACTER RANGE 'D'..'H' -- 5 LINES + LOOP + PUT (FILE, I); + NEW_LINE (FILE); + END LOOP; + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + SET_LINE (FILE, FOUR); + GET (FILE, ITEM_CHAR); + + IF ITEM_CHAR /= 'G' THEN + FAILED ("SET_LINE DOESN'T SKIP PAGE MARKS; " & + "ACTUALLY READ '" & ITEM_CHAR & "'"); + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3410D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3410e.ada b/gcc/testsuite/ada/acats/tests/ce/ce3410e.ada new file mode 100644 index 000000000..f86608bf5 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3410e.ada @@ -0,0 +1,125 @@ +-- CE3410E.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 SET_LINE RAISES END_ERROR IF NO PAGE BEFORE THE END +-- OF THE FILE IS LONG ENOUGH. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- ABW 08/26/82 +-- SPS 09/20/82 +-- JBG 01/27/83 +-- JBG 08/30/83 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/02/87 REMOVED DEPENDENCE ON RESET, ADDED NEW CASES FOR +-- OBJECTIVE, AND CHECKED FOR USE_ERROR ON DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3410E IS + + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + CHAR : CHARACTER := ('C'); + ITEM_CHAR : CHARACTER; + FIVE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(5)); + +BEGIN + + TEST ("CE3410E", "CHECK THAT SET_LINE RAISES END_ERROR " & + "WHEN IT ATTEMPTS TO READ THE FILE TERMINATOR"); + +-- CREATE & INITIALIZE FILE + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " & + "MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, "ABCD"); + NEW_LINE (FILE); + PUT (FILE, "DEF"); + NEW_LINE (FILE, 3); + NEW_PAGE (FILE); + PUT_LINE (FILE, "HELLO"); + NEW_PAGE (FILE); + PUT_LINE (FILE, "GH"); + PUT_LINE (FILE, "IJK"); + PUT_LINE (FILE, "HI"); + PUT_LINE (FILE, "TESTING"); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " & + "MODE IN_FILE"); + RAISE INCOMPLETE; + END; + + BEGIN + SET_LINE (FILE,FIVE); + FAILED ("END ERROR NOT RAISED ON SET_LINE"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON SET_LINE"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3410E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3411a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3411a.ada new file mode 100644 index 000000000..1b81316d1 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3411a.ada @@ -0,0 +1,164 @@ +-- CE3411A.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 COL RETURNS THE VALUE OF THE CURRENT COLUMN NUMBER. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 09/29/82 +-- JBG 08/30/83 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/02/87 REMOVED DEPENDENCE ON RESET AND CHECKED FOR +-- USE_ERROR ON DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3411A IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3411A", "CHECK THAT COL RETURNS THE VALUE OF THE " & + "CURRENT COLUMN NUMBER"); + + DECLARE + FT : FILE_TYPE; + X : CHARACTER; + NUM_CHARS : POSITIVE_COUNT; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " & + "CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FT, "OUTPUT STRING"); + IF COL (FT) /= 14 THEN + FAILED ("COL INCORRECT AFTER PUT; IS" & + COUNT'IMAGE(COL(FT))); + END IF; + + NEW_LINE (FT); + IF COL (FT) /= 1 THEN + FAILED ("COL INCORRECT AFTER NEW_LINE; IS" & + COUNT'IMAGE(COL(FT))); + END IF; + + PUT (FT, "MORE OUTPUT"); + NEW_PAGE (FT); + IF COL (FT) /= 1 THEN + FAILED ("COL INCORRECT AFTER NEW_PAGE; IS" & + COUNT'IMAGE(COL(FT))); + END IF; + + PUT (FT, "FINAL"); + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + IF COL (FT) /= 1 THEN + FAILED ("COL INCORRECT AFTER REOPEN; IS" & + COUNT'IMAGE(COL(FT))); + END IF; + + FOR I IN 1 .. 4 LOOP + GET (FT, X); + END LOOP; + IF COL (FT) /= 5 THEN + FAILED ("COL INCORRECT AFTER GET; IS" & + COUNT'IMAGE(COL(FT))); + END IF; + + NUM_CHARS := COL(FT); + WHILE NOT END_OF_LINE(FT) LOOP + GET (FT, X); + NUM_CHARS := NUM_CHARS + 1; + END LOOP; + + IF COL(FT) /= NUM_CHARS THEN + FAILED ("COL INCORRECT BEFORE END OF LINE; IS" & + COUNT'IMAGE(COL(FT))); + END IF; + + SKIP_LINE (FT); + IF COL(FT) /= 1 THEN + FAILED ("COL INCORRECT AFTER SKIP_LINE; IS" & + COUNT'IMAGE(COL(FT))); + END IF; + + SET_COL (FT, 2); + IF COL (FT) /= 2 THEN + FAILED ("COL INCORRECT AFTER SET_COL; IS" & + COUNT'IMAGE(COL(FT))); + END IF; + + SKIP_PAGE (FT); + IF COL(FT) /= 1 THEN + FAILED ("COL INCORRECT AFTER SKIP_PAGE; IS" & + COUNT'IMAGE(COL(FT))); + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + END; + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; +END CE3411A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3411c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3411c.ada new file mode 100644 index 000000000..fd95831c6 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3411c.ada @@ -0,0 +1,146 @@ +-- CE3411C.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 COL OPERATES ON THE CURRENT DEFAULT OUTPUT FILE WHEN +-- NO FILE IS SPECIFIED. CHECK THAT COL CAN OPERATE ON FILES OF +-- MODES IN_FILE AND OUT_FILE, INCLUDING THE CURRENT DEFAULT +-- INPUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 09/29/82 +-- JBG 01/31/83 +-- JBG 08/30/83 +-- JLH 09/02/87 REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY +-- CODE, AND CHECKED FOR USE_ERROR ON DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3411C IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3411C", "CHECK THAT COL OPERATES ON DEFAULT IN_FILE AND "& + "OUT_FILE FILES"); + + DECLARE + F1, F2 : FILE_TYPE; + C : POSITIVE_COUNT; + X : CHARACTER; + BEGIN + IF COL /= COL (STANDARD_OUTPUT) THEN + FAILED ("COL DEFAULT NOT STANDARD_OUTPUT"); + END IF; + + IF COL /= COL (STANDARD_INPUT) THEN + FAILED ("COL DEFAULT NOT STANDARD_INPUT"); + END IF; + + IF COL /= COL (CURRENT_INPUT) THEN + FAILED ("COL DEFAULT NOT CURRENT_INPUT"); + END IF; + + IF COL /= COL (CURRENT_OUTPUT) THEN + FAILED ("COL DEFAULT NOT CURRENT_OUTPUT"); + END IF; + + BEGIN + CREATE (F1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + CREATE (F2, OUT_FILE); + + SET_OUTPUT (F2); + + PUT (F1, "STRING"); + IF COL (F1) /= 7 THEN + FAILED ("COL INCORRECT SUBTEST 1"); + END IF; + + PUT (F2, "OUTPUT STRING"); + IF COL /= COL(F2) AND COL(F2) /= 14 THEN + FAILED ("COL INCORRECT SUBTEST 2; WAS " & + COUNT'IMAGE(COL) & " VS. " & + COUNT'IMAGE(COL(F2))); + END IF; + + CLOSE (F1); + + BEGIN + OPEN (F1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + SET_INPUT (F1); + + GET (F1, X); + GET (F1, X); + GET (F1, X); + + IF X /= 'R' THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + + IF COL (CURRENT_INPUT) /= 4 AND COL /= 4 THEN + FAILED ("COL INCORRECT SUBTEST 3"); + END IF; + + BEGIN + DELETE (F1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + CLOSE (F2); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3411C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3412a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3412a.ada new file mode 100644 index 000000000..56b6744a4 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3412a.ada @@ -0,0 +1,149 @@ +-- CE3412A.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 LINE RETURNS THE VALUE OF THE CURRENT LINE NUMBER. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 09/29/82 +-- JBG 08/30/83 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/02/87 REMOVED DEPENDENCE ON RESET AND CHECKED FOR +-- USE_ERROR ON DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3412A IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3412A", "CHECK LINE RETURNS LINE NUMBER"); + + DECLARE + FT : FILE_TYPE; + X : CHARACTER; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " & + "CREATE"); + RAISE INCOMPLETE; + END; + + IF LINE (FT) /= 1 THEN + FAILED ("CURRENT LINE NUMBER NOT INITIALLY ONE"); + END IF; + + FOR I IN 1 .. 3 LOOP + PUT (FT, "OUTPUT STRING"); + NEW_LINE (FT); + END LOOP; + IF LINE (FT) /= 4 THEN + FAILED ("LINE INCORRECT AFTER PUT; IS" & + COUNT'IMAGE(LINE(FT))); + END IF; + + NEW_PAGE (FT); + IF LINE (FT) /= 1 THEN + FAILED ("LINE INCORRECT AFTER NEW_PAGE; IS" & + COUNT'IMAGE(LINE(FT))); + END IF; + + FOR I IN 1 .. 5 LOOP + PUT (FT, "MORE OUTPUT"); + NEW_LINE(FT); + END LOOP; + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + IF LINE (FT) /= 1 THEN + FAILED ("LINE INCORRECT AFTER RESET; IS" & + COUNT'IMAGE(LINE(FT))); + END IF; + + FOR I IN 1 .. 2 LOOP + SKIP_LINE (FT); + END LOOP; + IF LINE (FT) /= 3 THEN + FAILED ("LINE INCORRECT AFTER SKIP_LINE; IS" & + COUNT'IMAGE(LINE(FT))); + END IF; + + SET_LINE (FT, 2); + IF LINE (FT) /= 2 THEN + FAILED ("LINE INCORRECT AFTER SET_LINE; IS" & + COUNT'IMAGE(LINE(FT))); + END IF; + + SKIP_PAGE (FT); + IF LINE (FT) /= 1 THEN + FAILED ("LINE INCORRECT AFTER SKIP_PAGE; IS" & + COUNT'IMAGE(LINE(FT))); + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3412A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3413a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3413a.ada new file mode 100644 index 000000000..079da5edd --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3413a.ada @@ -0,0 +1,128 @@ +-- CE3413A.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 PAGE RETURNS THE VALUE OF THE CURRENT PAGE NUMBER. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 09/29/82 +-- JBG 08/30/83 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/04/87 REMOVED DEPENDENCE ON RESET AND CHECKED FOR +-- USE_ERROR ON DELETE. + + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3413A IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3413A", "CHECK THAT PAGE RETURNS THE CORRECT PAGE " & + "NUMBER"); + + DECLARE + FT : FILE_TYPE; + X : CHARACTER; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "TEXT CREATE"); + RAISE INCOMPLETE; + END; + + IF PAGE (FT) /= 1 THEN + FAILED ("CURRENT PAGE NOT INITIALLY ONE"); + END IF; + + FOR I IN 1 .. 6 LOOP + PUT (FT, "OUTPUT STRING"); + NEW_PAGE (FT); + END LOOP; + IF PAGE (FT) /= 7 THEN + FAILED ("PAGE INCORRECT AFTER PUT; IS" & + COUNT'IMAGE(PAGE(FT))); + END IF; + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + IF PAGE (FT) /= 1 THEN + FAILED ("PAGE INCORRECT AFTER OPEN IS" & + COUNT'IMAGE(PAGE(FT))); + END IF; + + FOR I IN 1 .. 4 LOOP + SKIP_PAGE (FT); + END LOOP; + IF PAGE (FT) /= 5 THEN + FAILED ("PAGE INCORRECT AFTER SKIP_PAGE; IS" & + COUNT'IMAGE(PAGE(FT))); + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3413A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3413b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3413b.ada new file mode 100644 index 000000000..cb273caa3 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3413b.ada @@ -0,0 +1,163 @@ +-- CE3413B.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 PAGE RAISES LAYOUT_ERROR WHEN THE VALUE OF THE +-- PAGE NUMBER EXCEEDS COUNT'LAST. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- *** NOTE: This test has been modified since ACVC version 1.11 to -- 9X +-- *** remove incompatibilities associated with the transition -- 9X +-- *** to Ada 9X. -- 9X +-- *** -- 9X + +-- HISTORY: +-- JLH 07/27/88 CREATED ORIGINAL TEST. +-- MRM 03/30/93 REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + + +PROCEDURE CE3413B IS + + FILE : FILE_TYPE; + INCOMPLETE, INAPPLICABLE : EXCEPTION; + ITEM : STRING(1..3) := "ABC"; + LST : NATURAL; + +BEGIN + + TEST ("CE3413B", "CHECK THAT PAGE RAISES LAYOUT_ERROR WHEN THE " & + "VALUE OF THE PAGE NUMBER EXCEEDS COUNT'LAST"); + + BEGIN + + IF COUNT'LAST > 150000 THEN + RAISE INAPPLICABLE; + END IF; + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " & + "CREATE"); + RAISE INCOMPLETE; + END; + + FOR I IN 1 .. COUNT'LAST-1 LOOP + NEW_PAGE (FILE); + END LOOP; + + PUT (FILE, ITEM); + + NEW_PAGE (FILE); + PUT (FILE, "DEF"); + + BEGIN + IF PAGE(FILE) <= POSITIVE_COUNT(COUNT'LAST) THEN + FAILED ("PAGE NUMBER INCORRECT AFTER PAGE SET - 1"); + END IF; + FAILED ("LAYOUT_ERROR NOT RAISED FOR PAGE - 1"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN CONSTRAINT_ERROR => + FAILED ("CONSTRAINT_ERROR RAISED FOR PAGE - 1"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR PAGE - 1"); + END; + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + FOR I IN 1 .. COUNT'LAST-1 LOOP + SKIP_PAGE (FILE); + END LOOP; + + IF PAGE(FILE) /= COUNT'LAST THEN + FAILED ("INCORRECT PAGE NUMBER"); + END IF; + + GET_LINE (FILE, ITEM, LST); + IF ITEM /= "ABC" THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + + SKIP_PAGE (FILE); + + BEGIN + IF PAGE(FILE) <= POSITIVE_COUNT(COUNT'LAST) THEN + FAILED ("PAGE NUMBER INCORRECT AFTER PAGE SET - 2"); + END IF; + FAILED ("LAYOUT_ERROR NOT RAISED FOR PAGE - 2"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN CONSTRAINT_ERROR => + FAILED ("CONSTRAINT_ERROR RAISED FOR PAGE - 2"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED FOR PAGE - 2"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + WHEN INAPPLICABLE => + NOT_APPLICABLE ("THE VALUE OF COUNT'LAST IS GREATER " & + "THAN 150000. THE CHECKING OF THIS " & + "OBJECTIVE IS IMPRACTICAL"); + + END; + + RESULT; + +END CE3413B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3413c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3413c.ada new file mode 100644 index 000000000..dca4c2ba6 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3413c.ada @@ -0,0 +1,152 @@ +-- CE3413C.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 PAGE OPERATES ON THE CURRENT DEFAULT OUTPUT FILE WHEN +-- NO FILE IS SPECIFIED. CHECK THAT PAGE CAN OPERATE ON FILES OF +-- MODES IN_FILE AND OUT_FILE, INCLUDING THE CURRENT DEFAULT +-- INPUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 09/29/82 +-- JBG 08/30/83 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/04/87 REMOVED DEPENDENCE ON RESET, CORRECTED EXCEPTION +-- HANDLING, AND CHECKED FOR USE_ERROR ON DELETE. + + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3413C IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3413C", "CHECK THAT PAGE OPERATES ON DEFAULT IN_FILE " & + "AND OUT_FILE FILES"); + + DECLARE + F1, F2 : FILE_TYPE; + C : POSITIVE_COUNT; + X : CHARACTER; + BEGIN + + BEGIN + CREATE (F1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "TEXT CREATE"); + RAISE INCOMPLETE; + END; + + BEGIN + CREATE (F2, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "FOR TEMPORARY FILES WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + SET_OUTPUT (F2); + + IF PAGE (F2) /= 1 AND PAGE (STANDARD_OUTPUT) /= 1 THEN + FAILED ("PAGE INCORRECT SUBTEST - 1"); + END IF; + + FOR I IN 1 .. 3 LOOP + PUT (F1, "STRING"); + NEW_PAGE (F1); + END LOOP; + + IF PAGE (F1) /= 4 THEN + FAILED ("PAGE INCORRECT SUBTEST - 2"); + END IF; + + SET_LINE_LENGTH (F2, 3); + SET_PAGE_LENGTH (F2, 1); + PUT ("OUTPUT STRING"); + IF PAGE /= PAGE(F2) THEN + FAILED ("PAGE INCORRECT SUBTEST - 3"); + END IF; + + CLOSE (F1); + + BEGIN + OPEN (F1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + SET_INPUT (F1); + + IF PAGE (F1) /= 1 THEN + FAILED ("PAGE INCORRECT SUBTEST - 4"); + END IF; + + SKIP_PAGE(F1); + SKIP_PAGE(F1); + IF PAGE (F1) /= PAGE (CURRENT_INPUT) THEN + FAILED ("PAGE INCORRECT SUBTEST - 5"); + END IF; + + BEGIN + DELETE (F1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + CLOSE (F2); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3413C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3414a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3414a.ada new file mode 100644 index 000000000..8f236ca2f --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3414a.ada @@ -0,0 +1,204 @@ +-- CE3414A.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 STATUS_ERROR IS RAISED WHEN NEW_LINE, SKIP_LINE, +-- END_OF_LINE, NEW_PAGE, SKIP_PAGE, END_OF_PAGE, END_OF_FILE, +-- SET_COL, SET_LINE, COL, LINE, AND PAGE ARE CALLED AND THE FILE +-- IS NOT OPEN. + +-- HISTORY: +-- BCB 10/27/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3414A IS + + FILE : FILE_TYPE; + + INCOMPLETE : EXCEPTION; + + X : POSITIVE_COUNT; + +BEGIN + TEST ("CE3414A", "CHECK THAT STATUS_ERROR IS RAISED WHEN " & + "NEW_LINE, SKIP_LINE, END_OF_LINE, NEW_PAGE, " & + "SKIP_PAGE, END_OF_PAGE, END_OF_FILE, SET_COL, " & + "SET_LINE, COL, LINE, AND PAGE ARE CALLED AND " & + "THE FILE IS NOT OPEN"); + + BEGIN + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, 'A'); + + CLOSE (FILE); + + BEGIN + NEW_LINE (FILE); + FAILED ("STATUS_ERROR WAS NOT RAISED - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 1"); + END; + + BEGIN + SKIP_LINE (FILE); + FAILED ("STATUS_ERROR WAS NOT RAISED - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 2"); + END; + + BEGIN + IF NOT END_OF_LINE (FILE) THEN + NULL; + END IF; + FAILED ("STATUS_ERROR WAS NOT RAISED - 3"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 3"); + END; + + BEGIN + NEW_PAGE (FILE); + FAILED ("STATUS_ERROR WAS NOT RAISED - 4"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 4"); + END; + + BEGIN + SKIP_PAGE (FILE); + FAILED ("STATUS_ERROR WAS NOT RAISED - 5"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 5"); + END; + + BEGIN + IF NOT END_OF_PAGE (FILE) THEN + NULL; + END IF; + FAILED ("STATUS_ERROR WAS NOT RAISED - 6"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 6"); + END; + + BEGIN + IF NOT END_OF_FILE (FILE) THEN + NULL; + END IF; + FAILED ("STATUS_ERROR WAS NOT RAISED - 7"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 7"); + END; + + BEGIN + SET_COL (FILE, 2); + FAILED ("STATUS_ERROR WAS NOT RAISED - 8"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 8"); + END; + + BEGIN + SET_LINE (FILE, 2); + FAILED ("STATUS_ERROR WAS NOT RAISED - 9"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 9"); + END; + + BEGIN + X := COL (FILE); + FAILED ("STATUS_ERROR WAS NOT RAISED - 10"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 10"); + END; + + BEGIN + X := LINE (FILE); + FAILED ("STATUS_ERROR WAS NOT RAISED - 11"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 11"); + END; + + BEGIN + X := PAGE (FILE); + FAILED ("STATUS_ERROR WAS NOT RAISED - 12"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 12"); + END; + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; +END CE3414A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3601a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3601a.ada new file mode 100644 index 000000000..c5b63fd61 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3601a.ada @@ -0,0 +1,187 @@ +-- CE3601A.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 GET (FOR STRINGS AND CHARACTERS), PUT (FOR STRINGS AND +-- CHARACTERS), GET_LINE, AND PUT_LINE RAISE STATUS_ERROR WHEN +-- CALLED WITH AN UNOPEN FILE PARAMETER. ALSO CHECK NAMES OF FORMAL +-- PARAMETERS. + +-- HISTORY: +-- SPS 08/27/82 +-- VKG 02/15/83 +-- JBG 03/30/83 +-- JLH 09/04/87 ADDED CASE WHICH ATTEMPTS TO CREATE FILE AND THEN +-- RETESTED OBJECTIVE. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3601A IS + +BEGIN + + TEST ("CE3601A", "STATUS_ERROR RAISED BY GET, PUT, GET_LINE, " & + "PUT_LINE WHEN FILE IS NOT OPEN"); + + DECLARE + FILE1, FILE2 : FILE_TYPE; + CH: CHARACTER := '%'; + LST: NATURAL; + ST: STRING (1 .. 10); + LN : STRING (1 .. 80); + BEGIN + BEGIN + GET (FILE => FILE1, ITEM => CH); + FAILED ("STATUS_ERROR NOT RAISED - GET CHARACTER"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET CHARACTER"); + END; + + BEGIN + GET (FILE => FILE1, ITEM => ST); + FAILED ("STATUS_ERROR NOT RAISED - GET STRING"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET STRING"); + END; + + BEGIN + GET_LINE (FILE => FILE1, ITEM => LN, LAST => LST); + FAILED ("STATUS_ERROR NOT RAISED - GET_LINE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET_LINE"); + END; + + BEGIN + PUT (FILE => FILE1, ITEM => CH); + FAILED ("STATUS_ERROR NOT RAISED - PUT CHARACTER"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - PUT CHARACTER"); + END; + + BEGIN + PUT (FILE => FILE1, ITEM => ST); + FAILED ("STATUS_ERROR NOT RAISED - PUT STRING"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - PUT STRING"); + END; + + BEGIN + PUT_LINE (FILE => FILE1, ITEM => LN); + FAILED ("STATUS_ERROR NOT RAISED - PUT_LINE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - PUT_LINE"); + END; + + BEGIN + CREATE (FILE2, OUT_FILE); -- THIS IS ONLY AN ATTEMPT TO + CLOSE (FILE2); -- CREATE A FILE. OK, WHETHER + EXCEPTION -- SUCCESSFUL OR NOT. + WHEN USE_ERROR => + NULL; + END; + + BEGIN + GET (FILE => FILE2, ITEM => CH); + FAILED ("STATUS_ERROR NOT RAISED - GET CHARACTER"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET CHARACTER"); + END; + + BEGIN + GET (FILE => FILE2, ITEM => ST); + FAILED ("STATUS_ERROR NOT RAISED - GET STRING"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET STRING"); + END; + + BEGIN + GET_LINE (FILE => FILE2, ITEM => LN, LAST => LST); + FAILED ("STATUS_ERROR NOT RAISED - GET_LINE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET_LINE"); + END; + + BEGIN + PUT (FILE => FILE2, ITEM => CH); + FAILED ("STATUS_ERROR NOT RAISED - PUT CHARACTER"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - PUT CHARACTER"); + END; + + BEGIN + PUT (FILE => FILE2, ITEM => ST); + FAILED ("STATUS_ERROR NOT RAISED - PUT STRING"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - PUT STRING"); + END; + + BEGIN + PUT_LINE (FILE => FILE2, ITEM => LN); + FAILED ("STATUS_ERROR NOT RAISED - PUT_LINE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - PUT_LINE"); + END; + + END; + + RESULT; + +END CE3601A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3602a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3602a.ada new file mode 100644 index 000000000..ff0280303 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3602a.ada @@ -0,0 +1,189 @@ +-- CE3602A.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 GET FOR CHARACTERS AND STRINGS ALLOW A STRING TO SPAN +-- OVER MORE THAN ONE LINE, SKIPPING INTERVENING LINE AND PAGE +-- TERMINATORS. ALSO CHECK THAT GET ACCEPTS A NULL STRING ACTUAL +-- PARAMETER AND A STRING SLICE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 08/30/82 +-- VKG 01/26/83 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/04/87 REMOVED DEPENDENCE ON RESET, CORRECTED EXCEPTION +-- HANDLING, AND ADDED NEW CASES FOR OBJECTIVE. + + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3602A IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3602A", "CHECK THAT GET FOR CHARACTERS AND STRINGS " & + "ALLOWS A STRING TO SPAN OVER MORE THAN ONE " & + "LINE, SKIPPING INTERVENING LINE AND PAGE " & + "TERMINATORS. ALSO CHECK THAT GET ACCEPTS " & + "A NULL STRING ACTUAL PARAMETER AND A STRING " & + "SLICE"); + + DECLARE + FILE1 : FILE_TYPE; + ST : STRING (1 .. 40); + STR: STRING (1 .. 100); + NST: STRING (1 .. 0); + ORIGINAL_LINE_LENGTH : COUNT; + +-- READ_CHARS RETURNS A STRING OF N CHARACTERS FROM A GIVEN FILE. + + FUNCTION READ_CHARS (FILE : FILE_TYPE; + N : NATURAL ) + RETURN STRING IS + C: CHARACTER; + BEGIN + IF N = 0 THEN RETURN ""; + ELSE + GET (FILE,C); + RETURN C&READ_CHARS (FILE,N-1); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("ERROR ON READ_CHARS"); + END READ_CHARS; + + + BEGIN + +-- CREATE AND INITIALIZE TEST DATA FILE + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "TEXT CREATE"); + RAISE INCOMPLETE; + END; + + ORIGINAL_LINE_LENGTH := LINE_LENGTH; + +-- LINE_LENGTH SET IN CASE IMPLEMENTATION REQUIRES BOUNDED LENGTH LINES + + SET_LINE_LENGTH (16); + PUT (FILE1, "THIS LINE SHALL "); + SET_LINE_LENGTH (10); + PUT (FILE1, "SPAN OVER "); + SET_LINE_LENGTH (14); + PUT (FILE1, "SEVERAL LINES."); + CLOSE (FILE1); + SET_LINE_LENGTH (ORIGINAL_LINE_LENGTH); + + +-- BEGIN TEST + + BEGIN + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " & + "OPEN WITH IN_FILE MODE - 1"); + RAISE INCOMPLETE; + END; + + STR(1..40) := READ_CHARS (FILE1, 40); + CLOSE (FILE1); + + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + + GET (FILE1, ST); + IF STR(1..40) /= ST THEN + FAILED ("GET FOR STRING INCORRECT"); + END IF; + + IF STR(1..40) /= "THIS LINE SHALL SPAN OVER SEVERAL " & + "LINES." THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + +-- GET NULL STRING + + CLOSE (FILE1); + + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + + BEGIN + GET (FILE1, NST); + EXCEPTION + WHEN OTHERS => + FAILED (" GET FAILED ON NULL STRING"); + END; + +-- GET NULL SLICE + + BEGIN + GET (FILE1, STR (10 .. 1)); + EXCEPTION + WHEN OTHERS => + FAILED ("GET FAILED ON A NULL SLICE"); + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3602A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3602b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3602b.ada new file mode 100644 index 000000000..71482425a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3602b.ada @@ -0,0 +1,215 @@ +-- CE3602B.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 GET (FOR CHARACTER AND STRINGS) PROPERLY SETS THE +-- PAGE, LINE, AND COLUMN NUMBERS AFTER EACH OPERATION. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 08/30/82 +-- SPS 12/17/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/04/87 REMOVED DEPENDENCE ON UNBOUNDED LINE LENGTH AND +-- CORRECTED EXCEPTION HANDLING. +-- BCB 11/13/87 GAVE SET_LINE_LENGTH PROCEDURE THE FILE VARIABLE +-- AS A PARAMETER. REMOVED LINE WHICH SAVED AND +-- RESTORED THE LINE LENGTH. + + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; +WITH CHECK_FILE; + +PROCEDURE CE3602B IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3602B", "CHECK THAT GET PROPERLY SETS PAGE, LINE, AND " & + "COLUMN NUMBERS"); + + DECLARE + FILE1 : FILE_TYPE; + LINE1 : CONSTANT STRING := "LINE ONE OF TEST DATA FILE"; + LINE2 : CONSTANT STRING := "LINE TWO"; + LINE3 : CONSTANT STRING := "LINE THREE"; + CN, LN : POSITIVE_COUNT; + CH : CHARACTER; + ST: STRING (1 .. 5); + ORIGINAL_LINE_LENGTH : COUNT; + + BEGIN + +-- CREATE AND INITIALIZE TEST DATA FILE + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "TEXT CREATE"); + RAISE INCOMPLETE; + END; + + ORIGINAL_LINE_LENGTH := LINE_LENGTH; + SET_LINE_LENGTH (FILE1, LINE1'LENGTH); + + PUT (FILE1, LINE1); + SET_LINE_LENGTH (FILE1, LINE2'LENGTH); + PUT (FILE1, LINE2); + NEW_LINE (FILE1, 2); + NEW_PAGE (FILE1); + SET_LINE_LENGTH (FILE1, LINE3'LENGTH); + PUT (FILE1, LINE3); + CLOSE (FILE1); + +-- BEGIN TEST + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + IF COL (FILE1) /= 1 THEN + FAILED ("COLUMN NUMBER NOT INITIALLY ONE"); + END IF; + + IF LINE (FILE1) /= 1 THEN + FAILED ("LINE NUMBER NOT INITIALLY ONE"); + END IF; + + IF PAGE (FILE1) /= 1 THEN + FAILED ("PAGE NUMBER NOT INITIALLY ONE"); + END IF; + +-- TEST COLUMN NUMBER FOR CHARACTER + + GET (FILE1, CH); + IF CH /= 'L' THEN + FAILED ("CHARACTER NOT EQUAL TO L - 1"); + END IF; + CN := COL (FILE1); + IF CN /= 2 THEN + FAILED ("COLUMN NUMBER NOT SET CORRECTLY " & + "- GET CHARACTER. COL NUMBER IS" & + COUNT'IMAGE(CN)); + END IF; + +-- TEST COLUMN NUMBER FOR STRING + + GET (FILE1, ST); + CN := COL (FILE1); + IF CN /= 7 THEN + FAILED ("COLUMN NUMBER NOT SET CORRECTLY " & + "- GET STRING. COL NUMBER IS" & + COUNT'IMAGE(CN)); + END IF; + +-- POSITION CURRENT INDEX TO END OF LINE + + WHILE NOT END_OF_LINE (FILE1) LOOP + GET (FILE1, CH); + END LOOP; + + IF CH /= 'E' THEN + FAILED ("CHARACTER NOT EQUAL TO E"); + END IF; + +-- TEST LINE NUMBER FOR CHARACTER + + GET(FILE1, CH); + IF CH /= 'L' THEN + FAILED ("CHARACTER NOT EQUAL TO L - 2"); + END IF; + LN := LINE (FILE1); + IF LN /= 2 THEN + FAILED ("LINE NUMBER NOT SET CORRECTLY " & + "- GET CHARACTER. LINE NUMBER IS" & + COUNT'IMAGE(LN)); + END IF; + IF PAGE (FILE1) /= POSITIVE_COUNT(IDENT_INT(1)) THEN + FAILED ("PAGE NUMBER NOT CORRECT - 1. PAGE IS" & + COUNT'IMAGE(PAGE(FILE1))); + END IF; + +-- TEST LINE NUMBER FOR STRING + + WHILE NOT END_OF_LINE (FILE1) LOOP + GET (FILE1, CH); + END LOOP; + GET (FILE1, ST); + IF ST /= "LINE " THEN + FAILED ("INCORRECT VALUE READ - ST"); + END IF; + LN := LINE (FILE1); + CN := COL (FILE1); + IF CN /= 6 THEN + FAILED ("COLUMN NUMBER NOT SET CORRECTLY " & + "- GET STRING. COL NUMBER IS" & + COUNT'IMAGE(CN)); + END IF; + IF LN /= 1 THEN + FAILED ("LINE NUMBER NOT SET CORRECTLY " & + "- GET STRING. LINE NUMBER IS" & + COUNT'IMAGE(LN)); + END IF; + IF PAGE (FILE1) /= POSITIVE_COUNT(IDENT_INT(2)) THEN + FAILED ("PAGE NUMBER NOT CORRECT - 2. PAGE IS" & + COUNT'IMAGE(PAGE(FILE1))); + END IF; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3602B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3602c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3602c.ada new file mode 100644 index 000000000..153fed7f8 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3602c.ada @@ -0,0 +1,202 @@ +-- CE3602C.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 GET RAISES MODE_ERROR FOR FILES OF MODE OUT_FILE. + +-- APPLICABILITY CRITEIRA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 08/31/82 +-- SPS 12/17/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/08/87 CORRECTED EXCEPTION HANDLING AND CHECKED FOR +-- USE_ERROR ON DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3602C IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3602C", "CHECK THAT MODE_ERROR IS RAISED BY GET FOR " & + "FILES OF MODE OUT_FILE"); + + DECLARE + FILE1, FILE2 : FILE_TYPE; + CH : CHARACTER; + ST : STRING (1 .. 5); + BEGIN + + BEGIN + CREATE (FILE1, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "FOR TEMPORARY FILE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "TEXT CREATE - 1"); + RAISE INCOMPLETE; + END; + + BEGIN + CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " & + "CREATE - 2"); + RAISE INCOMPLETE; + END; + + BEGIN + GET (FILE1, CH); + FAILED ("MODE_ERROR NOT RAISED - GET CHAR UN-NAMED " & + "FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET CHAR " & + "UN-NAMED FILE"); + END; + + BEGIN + GET (FILE2, CH); + FAILED ("MODE_ERROR NOT RAISED - GET CHAR NAMED FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET CHAR " & + "NAMED FILE"); + END; + + BEGIN + GET (STANDARD_OUTPUT, CH); + FAILED ("MODE_ERROR NOT RAISED - GET CHAR " & + "STANDARD_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET CHAR " & + "STANDARD_OUTPUT"); + END; + + BEGIN + GET (CURRENT_OUTPUT, CH); + FAILED ("MODE_ERROR NOT RAISED - GET CHAR " & + "CURRENT_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET CHAR " & + "CURRENT_OUTPUT"); + END; + + BEGIN + GET (FILE1, ST); + FAILED ("MODE_ERROR NOT RAISED - GET STRING UN-NAMED " & + "FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET STRING " & + "UN-NAMED FILE"); + END; + + BEGIN + GET (FILE2, ST); + FAILED ("MODE_ERROR NOT RAISED - GET STRING NAMED FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET STRING " & + "NAMED FILE"); + END; + + BEGIN + GET (STANDARD_OUTPUT, ST); + FAILED ("MODE_ERROR NOT RAISED - GET STRING " & + "STANDARD_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET STRING " & + "STANDARD_OUTPUT"); + END; + + BEGIN + GET (CURRENT_OUTPUT, ST); + FAILED ("MODE_ERROR NOT RAISED - GET STRING " & + "CURRENT_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET STRING " & + "CURRENT_OUTPUT"); + END; + + CLOSE (FILE1); + + BEGIN + DELETE (FILE2); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3602C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3602d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3602d.ada new file mode 100644 index 000000000..89b6a47ad --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3602d.ada @@ -0,0 +1,150 @@ +-- CE3602D.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 FILES ARE OF MODE IN_FILE AND THAT WHEN NO FILE IS +-- SPECIFIED THAT CURRENT DEFAULT INPUT FILE IS USED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 10/06/82 +-- SPS 12/17/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/08/87 REMOVED DEPENDENCE ON RESET AND CORRECTED +-- EXCEPTION HANDLING. + + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3602D IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3602D", "CHECK THAT GET FOR STRINGS AND CHARACTERS " & + "OPERATES ON IN_FILE FILES"); + + DECLARE + FT , FILE : FILE_TYPE; + X : CHARACTER; + ST: STRING (1 .. 3); + BEGIN + +-- CREATE AND INITIALIZE FILES + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " & + "CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FT, "ABCE"); + NEW_LINE (FT); + PUT (FT, "EFGHIJKLM"); + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH IN_FILE MODE - 1"); + RAISE INCOMPLETE; + END; + + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME(2)); + + PUT (FILE, "STRING"); + NEW_LINE (FILE); + PUT (FILE, "END OF OUTPUT"); + + CLOSE (FILE); + + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME(2)); + + SET_INPUT (FILE); + +-- BEGIN TEST + + GET (FT, X); + IF X /= IDENT_CHAR ('A') THEN + FAILED ("CHARACTER FROM FILE INCORRECT, WAS '" & + X & "'"); + END IF; + + GET (FT, ST); + IF ST /= "BCE" THEN + FAILED ("STRING FROM FILE INCORRECT; WAS """ & + ST & """"); + END IF; + + GET (X); + IF X /= IDENT_CHAR ('S') THEN + FAILED ("CHARACTER FROM DEFAULT INCORRECT; WAS '" & + X & "'"); + END IF; + + GET (ST); + IF ST /= "TRI" THEN + FAILED ("STRING FROM DEFAULT INCORRECT; WAS """ & + ST & """"); + END IF; + + BEGIN + DELETE (FT); + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3602D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3603a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3603a.ada new file mode 100644 index 000000000..d9d4f1e6d --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3603a.ada @@ -0,0 +1,217 @@ +-- CE3603A.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 END_ERROR IS NOT RAISED BY: +-- GET FOR CHARACTERS UNTIL ONLY LINE AND PAGE TERMINATORS REMAIN; +-- GET FROM STRING UNTIL FEWER CHARACTERS THAN NEEDED REMAIN; +-- GET_LINE UNTIL THE FINAL PAGE TERMINATOR HAS BEEN SKIPPED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 08/31/82 +-- JBG 12/23/82 +-- EG 05/22/85 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/08/87 CORRECTED EXCEPTION HANDLING AND REMOVED +-- DEPENDENCE ON RESET. + + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3603A IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3603A", "CHECK THAT END_ERROR IS RAISED BY GET AFTER " & + "THE LAST CHARACTER IN THE FILE HAS BEEN READ"); + + DECLARE + FILE1 : FILE_TYPE; + OLDCH, CH : CHARACTER; + ST : STRING (1..10) := (1..10 => '.'); + COUNT : NATURAL; + BEGIN + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT" & + "CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE1, "LINE ONE"); + NEW_LINE (FILE1); + PUT (FILE1, "LINE TWO"); + NEW_LINE (FILE1, 3); + NEW_PAGE (FILE1); + NEW_PAGE (FILE1); + CLOSE (FILE1); + + BEGIN + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + SKIP_LINE (FILE1); + GET (FILE1, ST(1..7)); + IF ST(1..7) /= "LINE TW" THEN + FAILED ("NOT POSITIONED RIGHT - GET CHAR"); + END IF; + +-- COUNT NUMBER OF CHARACTERS IN FIRST LINE (TO ALLOW FOR TRAILING +-- BLANKS) + + COUNT := 0; + WHILE NOT END_OF_LINE(FILE1) + LOOP + GET (FILE1, CH); + OLDCH := CH; + COUNT := COUNT + 1; + END LOOP; + + BEGIN + GET (FILE1, CH); + FAILED ("END_ERROR NOT RAISED - GET " & + "CHARACTER"); + EXCEPTION + WHEN END_ERROR => + IF CH /= OLDCH THEN + FAILED ("CH MODIFIED ON END_" & + "ERROR"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED " & + "- GET CHARACTER"); + END; + + CLOSE (FILE1); + + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + + SKIP_LINE (FILE1); + GET (FILE1, ST(1..7)); + IF ST(1..7) /= "LINE TW" THEN + FAILED ("WRONG LINE 2. ACTUALLY READ '" & ST(1..7) & + "'"); + END IF; + + BEGIN + GET (FILE1, ST(8..8+COUNT)); + FAILED ("END_ERROR NOT RAISED - GET " & + "STRING"); + EXCEPTION + WHEN END_ERROR => + IF ST(1..7) /= "LINE TW" THEN + FAILED ("ST MODIFIED ON END_ERROR"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED " & + "- GET STRING"); + END; + + CLOSE (FILE1); + + END; + + DECLARE + LAST : NATURAL; + BEGIN + + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + + SKIP_LINE (FILE1); + GET_LINE (FILE1, ST, LAST); + IF LAST < 8 THEN + FAILED ("LAST < 8. LAST IS" & INTEGER'IMAGE(LAST)); + ELSIF ST(1..8) /= "LINE TWO" THEN + FAILED ("GET_LINE FAILED. ACTUALLY READ '" & + ST(1..8) & "'"); + END IF; + + SKIP_PAGE (FILE1); + SKIP_PAGE (FILE1); + + BEGIN + GET_LINE (FILE1, ST(1..1), LAST); + FAILED ("END_ERROR NOT RAISED - GET_LINE - 1"); + EXCEPTION + WHEN END_ERROR => + IF LAST /= 8 THEN + FAILED ("LAST MODIFIED BY GET_LINE " & + "ON END_ERROR. LAST IS" & + INTEGER'IMAGE(LAST)); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION - GET_LINE - 1"); + END; + + BEGIN -- NULL ITEM ARGUMENT + GET_LINE (FILE1, ST(1..0), LAST); + EXCEPTION + WHEN END_ERROR => + FAILED ("GET_LINE ATTEMPTED TO READ INTO A " & + "NULL STRING"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION - GET_LINE - 2"); + END; + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3603A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3604a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3604a.ada new file mode 100644 index 000000000..380791f09 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3604a.ada @@ -0,0 +1,160 @@ +-- CE3604A.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 GET_LINE MAY BE CALLED TO RETURN AN ENTIRE LINE. ALSO +-- CHECK THAT GET_LINE MAY BE CALLED TO RETURN THE REMAINDER OF A +-- PARTLY READ LINE. ALSO CHECK THAT GET_LINE RETURNS IN THE +-- PARAMETER LAST, THE INDEX VALUE OF THE LAST CHARACTER READ. +-- WHEN NO CHARACTERS ARE READ, LAST IS ONE LESS THAN ITEM'S LOWER +-- BOUND. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JLH 09/25/87 COMPLETELY REVISED TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3604A IS + +BEGIN + + TEST ("CE3604A", "CHECK THAT GET_LINE READS LINES APPROPRIATELY " & + "AND CHECK THAT LAST RETURNS THE CORRECT INDEX " & + "VALUE"); + + DECLARE + FILE : FILE_TYPE; + STR : STRING (1 .. 25); + LAST : NATURAL; + ITEM1 : STRING (2 .. 6); + ITEM2 : STRING (3 .. 6); + CH : CHARACTER; + INCOMPLETE : EXCEPTION; + + BEGIN + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " & + "CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, "FIRST LINE OF INPUT"); + NEW_LINE (FILE); + PUT (FILE, "SECOND LINE OF INPUT"); + NEW_LINE (FILE); + PUT (FILE, "THIRD LINE OF INPUT"); + NEW_LINE (FILE); + NEW_LINE (FILE); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET_LINE (FILE, STR, LAST); + + BEGIN + IF STR(1..LAST) /= "FIRST LINE OF INPUT" THEN + FAILED ("GET_LINE - RETURN OF ENTIRE LINE"); + END IF; + EXCEPTION + WHEN CONSTRAINT_ERROR => + FAILED ("CONSTRAINT_ERROR RAISED AFTER " & + "GET_LINE - 1"); + END; + + GET (FILE, ITEM1); + GET_LINE (FILE, STR, LAST); + + BEGIN + IF STR(1..LAST) /= "D LINE OF INPUT" THEN + FAILED ("GET_LINE - REMAINDER OF PARTLY READ LINE"); + END IF; + EXCEPTION + WHEN CONSTRAINT_ERROR => + FAILED ("CONSTRAINT_ERROR RAISED AFTER " & + "GET_LINE - 2"); + END; + + GET_LINE (FILE, ITEM1, LAST); + IF LAST /= 6 THEN + FAILED ("INCORRECT VALUE FOR LAST PARAMETER - 1"); + END IF; + + WHILE NOT END_OF_LINE (FILE) LOOP + GET (FILE, CH); + END LOOP; + + GET_LINE (FILE, ITEM1, LAST); + IF LAST /= 1 THEN + FAILED ("INCORRECT VALUE FOR LAST PARAMETER - 2"); + END IF; + + IF NOT END_OF_LINE (FILE) THEN + FAILED ("END_OF_LINE NOT TRUE"); + END IF; + + GET_LINE (FILE, ITEM2, LAST); + IF LAST /= 2 THEN + FAILED ("INCORRECT VALUE FOR LAST PARAMETER - 3"); + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3604A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3604b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3604b.ada new file mode 100644 index 000000000..5684b8af6 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3604b.ada @@ -0,0 +1,137 @@ +-- CE3604B.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 GET_LINE DOES NOT DO A SKIP_LINE AND NO CHARACTERS ARE +-- READ WHEN THE INPUT IS AT THEN END OF A LINE AND THE STRING +-- PARAMETER IS A NULL STRING. ALSO CHECK THAT GET_LINE DOES NOT +-- SKIP THE LINE TERMINATOR AFTER READING ALL THE CHARACTERS INTO +-- A STRING WHICH IS EXACTLY EQUAL TO THE NUMBER OF CHARACTERS +-- REMAINING ON THAT LINE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JLH 10/13/87 CREATED ORIGINAL TEST. + + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3604B IS + +BEGIN + + TEST ("CE3604B", "CHECK THAT GET_LINE READS LINES APPROPRIATELY"); + + DECLARE + INCOMPLETE : EXCEPTION; + FILE : FILE_TYPE; + ITEM1 : STRING (1 .. 19); + ITEM2 : STRING (1 .. 20); + NULL_ITEM : STRING (2 .. 1); + LAST : NATURAL; + + BEGIN + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " & + "CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, "FIRST LINE OF INPUT"); + NEW_LINE (FILE); + PUT (FILE, "SECOND LINE OF INPUT"); + NEW_LINE (FILE); + PUT (FILE, "THIRD LINE OF INPUT"); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FILE, ITEM1); + IF ITEM1 /= "FIRST LINE OF INPUT" THEN + FAILED ("INCORRECT VALUE FOR GET"); + END IF; + + GET_LINE (FILE, NULL_ITEM, LAST); + + IF LINE (FILE) /= 1 THEN + FAILED ("INCORRECT LINE NUMBER AFTER GET_LINE - 1"); + END IF; + + IF COL (FILE) /= 20 THEN + FAILED ("INCORRECT COLUMN NUMBER AFTER GET_LINE - 1"); + END IF; + + SKIP_LINE (FILE); + GET_LINE (FILE, ITEM2, LAST); + IF ITEM2 /= "SECOND LINE OF INPUT" THEN + FAILED ("INCORRECT VALUE FOR GET_LINE"); + END IF; + + IF LINE (FILE) /= 2 THEN + FAILED ("INCORRECT LINE NUMBER AFTER GET_LINE - 2"); + END IF; + + IF COL (FILE) /= 21 THEN + FAILED ("INCORRECT COLUMN NUMBER AFTER GET_LINE - 2"); + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3604B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3605a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3605a.ada new file mode 100644 index 000000000..41d1eae91 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3605a.ada @@ -0,0 +1,118 @@ +-- CE3605A.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 PUT FOR CHARACTER AND STRING PARAMETERS DOES NOT +-- UPDATE THE LINE NUMBER WHEN THE LINE LENGTH IS UNBOUNDED, +-- ONLY THE COLUMN NUMBER. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE. + +-- HISTORY: +-- SPS 09/02/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/08/87 CORRECTED EXCEPTION HANDLING AND ADDED CHECKS +-- FOR COLUMN NUMBER. +-- RJW 03/28/90 REVISED NUMERIC LITERALS USED IN LOOPS. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3605A IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3605A", "CHECK THAT PUT FOR CHARACTER AND STRING " & + "PARAMETERS DOES NOT UPDATE THE LINE NUMBER " & + "WHEN THE LINE LENGTH IS UNBOUNDED, ONLY THE " & + "COLUMN NUMBER"); + + DECLARE + FILE1 : FILE_TYPE; + LN : POSITIVE_COUNT := 1; + BEGIN + + BEGIN + CREATE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "FOR TEMPORARY FILES WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + LN := LINE (FILE1); + + IF LN /= 1 THEN + FAILED ("CURRENT LINE NUMBER NOT INITIALLY ONE"); + END IF; + + IF COL (FILE1) /= 1 THEN + FAILED ("CURRENT COLUMN NUMBER NOT INITIALLY ONE"); + END IF; + + FOR I IN 1 .. IDENT_INT(240) LOOP + PUT(FILE1, 'A'); + END LOOP; + IF LINE (FILE1) /= LN THEN + FAILED ("PUT ALTERED LINE NUMBER - CHARACTER"); + END IF; + + IF COL(FILE1) /= 241 THEN + FAILED ("COLUMN NUMBER NOT UPDATED CORRECTLY - 1"); + END IF; + + NEW_LINE(FILE1); + LN := LINE (FILE1); + + FOR I IN 1 .. IDENT_INT(40) LOOP + PUT (FILE1, "STRING"); + END LOOP; + IF LN /= LINE (FILE1) THEN + FAILED ("PUT ALTERED LINE NUMBER - STRING"); + END IF; + + IF COL(FILE1) /= 241 THEN + FAILED ("COLUMN NUMBER NOT UPDATED CORRECTLY - 2"); + END IF; + + CLOSE (FILE1); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3605A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3605b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3605b.ada new file mode 100644 index 000000000..c0de3c571 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3605b.ada @@ -0,0 +1,142 @@ +-- CE3605B.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 PUT OUTPUTS A LINE TERMINATOR, RESETS THE COLUMN +-- NUMBER AND INCREMENTS THE LINE NUMBER WHEN THE LINE LENGTH IS +-- BOUNDED AND THE COLUMN NUMBER EQUALS THE LINE LENGTH WHEN PUT +-- IS CALLED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 09/02/82 +-- JBG 12/28/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/08/87 GAVE FILE A NAME AND REMOVED CODE WHICH RESETS +-- THE FILE. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; +PROCEDURE CE3605B IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3605B", "CHECK THAT PUT PROPERLY MAINTAINS THE " & + "LINE NUMBER AND COLUMN NUMBER WHEN THE " & + "LINE LENGTH IS BOUNDED"); + + DECLARE + FILE1 : FILE_TYPE; + LN_CNT : POSITIVE_COUNT; + BEGIN + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "TEXT CREATE"); + RAISE INCOMPLETE; + END; + + SET_LINE_LENGTH (FILE1, 5); + LN_CNT := LINE (FILE1); + + FOR I IN 1 .. 5 LOOP + PUT (FILE1, 'X'); + END LOOP; + + IF COL(FILE1) /= 6 THEN + FAILED ("COLUMN NUMBER NOT INCREMENTED - PUT; " & + "VALUE WAS" & COUNT'IMAGE(COL(FILE1))); + END IF; + + IF LINE(FILE1) /= LN_CNT THEN + FAILED ("LINE COUNT MODIFIED - PUT CHARACTER; " & + "VALUE WAS" & COUNT'IMAGE(LINE(FILE1))); + END IF; + + PUT (FILE1, 'X'); + IF COL(FILE1) /= 2 THEN + FAILED ("COLUMN NUMBER NOT RESET - PUT CHARACTER; " & + "VALUE WAS" & COUNT'IMAGE(COL(FILE1))); + END IF; + + IF LINE(FILE1) /= LN_CNT + 1 THEN + FAILED("LINE NUMBER NOT INCREMENTED - PUT CHARACTER; " & + "VALUE WAS" & COUNT'IMAGE(LINE(FILE1))); + END IF; + + NEW_LINE (FILE1); + + SET_LINE_LENGTH (FILE1, 4); + LN_CNT := LINE (FILE1); + + PUT (FILE1, "XXXX"); + + IF COL(FILE1) /= 5 THEN + FAILED ("COLUMN NUMBER NOT INCREMENTED - PUT STRING; " & + "VALUE WAS" & COUNT'IMAGE(COL(FILE1))); + END IF; + + IF LINE (FILE1) /= LN_CNT THEN + FAILED ("LINE NUMBER INCREMENTED - PUT STRING; " & + "VALUE WAS" & COUNT'IMAGE(LINE (FILE1))); + END IF; + + PUT (FILE1, "STR"); + + IF COL(FILE1) /= 4 THEN + FAILED ("COLUMN NUMBER NOT SET CORRECTLY - PUT" & + "STRING; VALUE WAS" & COUNT'IMAGE(COL(FILE1))); + END IF; + + IF LINE (FILE1) /= LN_CNT + 1 THEN + FAILED ("LINE NUMBER NOT INCREMENTED - PUT STRING; " & + "VALUE WAS" & COUNT'IMAGE(LINE (FILE1))); + END IF; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3605B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3605c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3605c.ada new file mode 100644 index 000000000..7dca9781f --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3605c.ada @@ -0,0 +1,159 @@ +-- CE3605C.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 PUT RAISES MODE_ERROR FOR FILES OF MODE IN_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 09/02/82 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/08/87 REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY +-- CODE, AND CHECKED FOR USE_ERROR ON DELETE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3605C IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3605C", "MODE_ERROR RAISED BY PUT FOR IN_FILES"); + + DECLARE + FILE1 : FILE_TYPE; + BEGIN + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "TEXT CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE1, 'A'); + CLOSE (FILE1); + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " & + "OPEN FOR IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + PUT (FILE1, 'A'); + FAILED ("MODE_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 1"); + END; + + BEGIN + PUT (STANDARD_INPUT, 'A'); + FAILED ("MODE_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + + BEGIN + PUT (CURRENT_INPUT, 'A'); + FAILED ("MODE_ERROR NOT RAISED - 3"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 3"); + END; + + BEGIN + PUT (FILE1, "STRING"); + FAILED ("MODE_ERROR NOT RAISED - 4"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 4"); + END; + + BEGIN + PUT (STANDARD_INPUT, "STRING"); + FAILED ("MODE_ERROR NOT RAISED - 5"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 5"); + END; + + BEGIN + PUT (CURRENT_INPUT, "STRING"); + FAILED ("MODE_ERROR NOT RAISED - 6"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 6"); + END; + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3605C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3605d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3605d.ada new file mode 100644 index 000000000..1d52eae79 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3605d.ada @@ -0,0 +1,192 @@ +-- CE3605D.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 PUT DOES NOT RAISE LAYOUT_ERROR WHEN THE NUMBER OF +-- CHARACTERS TO BE OUTPUT EXCEEDS THE LINE LENGTH. +-- CHECK THAT PUT HAS THE EFFECT OF NEW_LINE (AS WELL AS +-- OUTPUTTING THE ITEM) WHEN THE NUMBER OF CHARACTERS TO BE OUTPUT +-- OVERFLOWS A BOUNDED LINE LENGTH. +-- CHECK THAT PUT WITH A NULL STRING PERFORMS NO OPERATION. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 09/02/82 +-- JBG 12/28/82 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/08/87 CORRECTED EXCEPTION HANDLING. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; +WITH CHECK_FILE; +PROCEDURE CE3605D IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3605D", "CHECK THAT LAYOUT_ERROR IS NOT RAISED BY PUT " & + "FOR STRING"); + + DECLARE + FT : FILE_TYPE; + LC : POSITIVE_COUNT; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON " & + "TEXT CREATE"); + RAISE INCOMPLETE; + END; + + SET_LINE_LENGTH (FT, 5); + + BEGIN + PUT (FT, "STRING"); + + IF LINE(FT) /= 2 THEN + FAILED ("LINE COUNT WAS" & COUNT'IMAGE(LINE(FT)) & + " INSTEAD OF 2"); + END IF; + + IF COL(FT) /= 2 THEN + FAILED ("COLUMN COUNT WAS" & COUNT'IMAGE(COL(FT)) & + " INSTEAD OF 2"); + END IF; + + EXCEPTION + WHEN LAYOUT_ERROR => + FAILED ("LAYOUT_ERROR RAISED - 1"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED - 1"); + + END; + + PUT (FT, "NEW"); + + IF LINE(FT) /= 2 THEN + FAILED ("LINE COUNT WRONG - 2; WAS" & + COUNT'IMAGE(LINE(FT)) & + " INSTEAD OF 2"); + END IF; + + IF COL(FT) /= 5 THEN + FAILED ("COL COUNT WRONG - 2; WAS" & + COUNT'IMAGE(COL(FT)) & + " INSTEAD OF 5"); + END IF; + + BEGIN + PUT (FT, "STR"); + IF LINE (FT) /= 3 THEN + FAILED ("PUT STRING WHEN IN MIDDLE OF " & + "LINE DOES NOT HAVE EFFECT OF " & + "NEW_LINE; LINE COUNT IS" & + COUNT'IMAGE(LINE(FT))); + END IF; + + IF COL(FT) /= 3 THEN + FAILED ("COL COUNT WRONG - 3; WAS" & + COUNT'IMAGE(COL(FT)) & + " INSTEAD OF 3"); + END IF; + + EXCEPTION + WHEN LAYOUT_ERROR => + FAILED ("LAYOUT_ERROR RAISED - 2"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED - 2"); + END; + + PUT (FT, "ING"); + + IF LINE(FT) /= 3 THEN + FAILED ("LINE COUNT WRONG - 3; WAS" & + COUNT'IMAGE(LINE(FT)) & + " INSTEAD OF 3"); + END IF; + + IF COL(FT) /= 6 THEN + FAILED ("COL COUNT WRONG - 3; WAS" & + COUNT'IMAGE(COL(FT)) & + " INSTEAD OF 6"); + END IF; + + BEGIN + PUT (FT, ""); + + IF LINE(FT) /= 3 THEN + FAILED ("LINE COUNT WRONG - 3; WAS" & + COUNT'IMAGE(LINE(FT)) & + " INSTEAD OF 3"); + END IF; + + IF COL(FT) /= 6 THEN + FAILED ("COL COUNT WRONG - 3; WAS" & + COUNT'IMAGE(COL(FT)) & + " INSTEAD OF 6"); + END IF; + + EXCEPTION + WHEN LAYOUT_ERROR => + FAILED ("LAYOUT_ERROR RAISED - 3"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED - 3"); + END; + + CHECK_FILE (FT, + "STRIN#" & + "GNEWS#" & + "TRING#@%"); + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3605D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3605e.ada b/gcc/testsuite/ada/acats/tests/ce/ce3605e.ada new file mode 100644 index 000000000..5ea6f236d --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3605e.ada @@ -0,0 +1,103 @@ +-- CE3605E.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 PUT CAN BE CALLED WITH CHARACTER AND STRING +-- PARAMETERS. CHECK THAT FILES OF MODE OUT_FILE ARE USED AND +-- THAT WHEN NO FILE IS SPECIFIED THE CURRENT DEFAULT OUTPUT FILE +-- IS USED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE. + +-- HISTORY: +-- SPS 10/06/82 +-- JBG 12/28/82 +-- VKG 02/15/83 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/08/87 REMOVED UNNECESSARY CODE AND CHECKED FOR +-- USE_ERROR ON DELETE. + + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; +WITH CHECK_FILE; +PROCEDURE CE3605E IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3605E", "CHECK THAT PUT FOR STRINGS AND CHARACTERS " & + "OPERATES ON OUT_FILE FILES"); + + DECLARE + FT , FILE : FILE_TYPE; + X : CHARACTER; + BEGIN + + BEGIN + CREATE (FT); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "FOR TEMPORARY FILE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + CREATE (FILE); + + SET_OUTPUT (FILE); + + PUT (FT, 'O'); + + PUT (FT, "UTPUT STRING"); + + PUT ('X'); + + PUT ("UTPUT STRING"); + +-- CHECK OUTPUT + + SET_OUTPUT (STANDARD_OUTPUT); + COMMENT ("CHECKING FT"); + CHECK_FILE (FT, "OUTPUT STRING#@%"); + COMMENT ("CHECKING FILE"); + CHECK_FILE (FILE, "XUTPUT STRING#@%"); + + CLOSE (FT); + CLOSE (FILE); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3605E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3606a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3606a.ada new file mode 100644 index 000000000..18b2af8ca --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3606a.ada @@ -0,0 +1,91 @@ +-- CE3606A.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 PUT_LINE WILL OUTPUT A LINE TERMINATOR WHEN THE +-- STRING PARAMETER IS NULL. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH +-- SUPPORT TEMPORARY TEXT FILES. + +-- HISTORY: +-- SPS 09/02/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/09/87 REMOVED UNNECESSARY CODE AND CORRECTED +-- EXCEPTION HANDLING. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; +WITH CHECK_FILE; +PROCEDURE CE3606A IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3606A", "PUT_LINE PUTS LINE TERMINATOR WHEN STRING " & + "IS NULL"); + + DECLARE + FT : FILE_TYPE; + NS1 : STRING (1 .. 0); + NS2 : STRING (3 .. 1); + LC : POSITIVE_COUNT := 1; + BEGIN + + BEGIN + CREATE (FT); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "FOR TEMP FILES WITH OUT_FILE " & + "MODE"); + RAISE INCOMPLETE; + END; + + PUT_LINE (FT, NS1); + IF LINE (FT) /= LC + 1 THEN + FAILED ("PUT_LINE OF NULL STRING 1; LINE " & + "COUNT WAS" & COUNT'IMAGE(LINE(FT))); + END IF; + + PUT_LINE (FT, NS2); + IF LINE (FT) /= LC + 2 THEN + FAILED ("PUT_LINE OF NULL STRING 2; LINE " & + "COUNT WAS" & COUNT'IMAGE(LINE(FT))); + END IF; + + CHECK_FILE (FT, "##@%"); + + CLOSE (FT); + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3606A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3606b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3606b.ada new file mode 100644 index 000000000..728a256cd --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3606b.ada @@ -0,0 +1,97 @@ +-- CE3606B.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 PUT_LINE WILL OUTPUT A LINE ON MORE THAN ONE LINE +-- WHEN THE LINE LENGTH IS BOUNDED, IF THE STRING IS GREATER +-- THAN THE LINE LENGTH. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEMPORARY TEXT FILES. + +-- HISTORY: +-- SPS 09/02/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/09/87 REMOVED UNNECESSARY CODE AND CORRECTED +-- EXCEPTION HANDLING. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; +WITH CHECK_FILE; +PROCEDURE CE3606B IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3606B", "CHECK THAT PUT_LINE WILL OUTPUT A LINE " & + "ON MORE THAN ONE LINE WHEN THE LINE " & + "LENGTH IS BOUNDED, IF THE STRING IS " & + "GREATER THAN THE LINE LENGTH"); + + DECLARE + FT : FILE_TYPE; + LONG_LINE : CONSTANT STRING := "THIS LINE IS A LONG " & + "LINE WHICH WHEN OUTPUT SHOULD SPAN OVER SEVERAL " & + "LINES IN THE OUTPUT FILE"; + BEGIN + + BEGIN + CREATE (FT); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "FOR TEMP FILES WITH OUT_FILE " & + "MODE"); + RAISE INCOMPLETE; + END; + + SET_LINE_LENGTH (FT, 10); + + PUT_LINE (FT, LONG_LINE); + PUT_LINE (FT, "AA"); + + CHECK_FILE (FT, "THIS LINE #" & + "IS A LONG #" & + "LINE WHICH#" & + " WHEN OUTP#" & + "UT SHOULD #" & + "SPAN OVER #" & + "SEVERAL LI#" & + "NES IN THE#" & + " OUTPUT FI#" & + "LE#" & + "AA#@%"); + + CLOSE (FT); + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3606B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3701a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3701a.ada new file mode 100644 index 000000000..0f9c52f49 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3701a.ada @@ -0,0 +1,109 @@ +-- CE3701A.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 GET AND PUT OF INTEGER_IO RAISE STATUS_ERROR IF +-- THE FILE IS NOT OPEN. + +-- HISTORY: +-- ABW 08/27/82 +-- JBG 08/30/83 +-- DWC 09/09/87 REMOVED UNNECESSARY CODE, CORRECTED EXCEPTION +-- HANDLING, AND ATTEMPTED TO CREATE A FILE. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3701A IS + + PACKAGE INT_IO IS NEW INTEGER_IO (INTEGER); + USE INT_IO; + FILE : FILE_TYPE; + INT_ITEM : INTEGER := 7; + +BEGIN + + TEST ("CE3701A", "CHECK THAT GET AND PUT RAISE " & + "STATUS_ERROR IF THE FILE " & + "IS NOT OPEN"); + + BEGIN + PUT (FILE, IDENT_INT(8)); + FAILED ("STATUS_ERROR NOT RAISED WHEN PUT APPLIED " & + "TO A NON-EXISTENT FILE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHEN PUT " & + "APPLIED TO A NON-EXISTENT FILE"); + END; + + BEGIN + GET (FILE, INT_ITEM); + FAILED ("STATUS_ERROR NOT RAISED WHEN GET APPLIED " & + "TO A NON-EXISTENT FILE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHEN GET " & + "APPLIED TO A NON-EXISTENT FILE"); + END; + + BEGIN + CREATE (FILE); -- THIS IS JUST AN ATTEMPT TO CREATE + CLOSE (FILE); -- A FILE. WHETHER THIS IS SUCCESSFUL + EXCEPTION -- OR NOT HAS NO EFFECT ON TEST + WHEN USE_ERROR => -- OBJECTIVE. + NULL; + END; + + BEGIN + PUT (FILE, IDENT_INT(8)); + FAILED ("STATUS_ERROR NOT RAISED WHEN PUT APPLIED " & + "TO AN UNOPENED FILE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHEN PUT " & + "APPLIED TO AN UNOPENED FILE"); + END; + + BEGIN + GET (FILE, INT_ITEM); + FAILED ("STATUS_ERROR NOT RAISED WHEN GET APPLIED " & + "TO AN UNOPENED FILE"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED WHEN GET " & + "APPLIED TO AN UNOPENED FILE"); + END; + + RESULT; + +END CE3701A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3704a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3704a.ada new file mode 100644 index 000000000..f2325c04b --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3704a.ada @@ -0,0 +1,134 @@ +-- CE3704A.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. +--* +-- HISTORY: +-- CHECK THAT GET FOR INTEGER_IO CAN OPERATE ON ANY FILE OF MODE +-- IN_FILE AND THAT IF NO FILE IS SPECIFIED THE CURRENT DEFAULT +-- INPUT FILE IS USED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 10/01/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/09/87 REMOVED UNNECESSARY CODE, CORRECTED EXCEPTION +-- HANDLING, AND REMOVED DEPENDENCE ON RESET. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3704A IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3704A", "CHECK THAT GET FOR INTEGER_IO CAN OPERATE " & + "ON ANY FILE OF MODE IN_FILE AND THAT IF " & + "NO FILE IS SPECIFIED THE CURRENT DEFAULT " & + "INPUT FILE IS USED"); + + DECLARE + FT : FILE_TYPE; + FT2: FILE_TYPE; + TYPE NI IS NEW INTEGER RANGE 1 .. 700; + X : NI; + PACKAGE IIO IS NEW INTEGER_IO (NI); + USE IIO; + BEGIN + +-- CREATE AND INITIALIZE DATA FILES + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, '3'); + PUT (FT, '6'); + PUT (FT, '9'); + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2)); + + PUT (FT2, '6'); + PUT (FT2, '2'); + PUT (FT2, '4'); + + CLOSE (FT2); + OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2)); + + SET_INPUT (FT2); + + GET (FT, X); + + IF X /= 369 THEN + FAILED ("GET RETURNED WRONG VALUE; VALUE WAS" & + NI'IMAGE(X)); + END IF; + + GET (X); + + IF X /= 624 THEN + FAILED ("GET FOR DEFAULT WAS WRONG; VALUE WAS" & + NI'IMAGE(X)); + END IF; + + BEGIN + DELETE (FT); + DELETE (FT2); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3704A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3704b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3704b.ada new file mode 100644 index 000000000..59f60c4a5 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3704b.ada @@ -0,0 +1,107 @@ +-- CE3704B.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 INTEGER_IO GET RAISES MODE_ERROR FOR FILES OF MODE +-- OUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 10/04/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/09/87 CORRECTED EXCEPTION HANDLING. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3704B IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3704B", "CHECK THAT INTEGER_IO GET RAISES " & + "MODE_ERROR FOR FILES OF MODE OUT_FILE"); + + DECLARE + FT : FILE_TYPE; + TYPE INT IS NEW INTEGER RANGE 1 .. 10; + PACKAGE IIO IS NEW INTEGER_IO (INT); + USE IIO; + X : INT := 10; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE); + PUT (FT, '3'); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "FOR TEMP FILE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + GET (FT, X); + FAILED ("MODE_ERROR NOT RAISED - FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FILE"); + END; + + BEGIN + GET (STANDARD_OUTPUT, X); + FAILED ("MODE_ERROR NOT RAISED - STANDARD_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - STANDARD_OUTPUT"); + END; + + BEGIN + GET (CURRENT_OUTPUT, X); + FAILED ("MODE_ERROR NOT RAISED - CURRENT_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - CURRENT_OUTPUT"); + END; + + CLOSE (FT); + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3704B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3704c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3704c.ada new file mode 100644 index 000000000..b3567fae7 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3704c.ada @@ -0,0 +1,176 @@ +-- CE3704C.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 INTEGER_IO GET RAISES CONSTRAINT_ERROR IF THE +-- WIDTH PARAMETER IS NEGATIVE, IF THE WIDTH PARAMETER IS +-- GREATER THAN FIELD'LAST WHEN FIELD'LAST IS LESS THAN +-- INTEGER'LAST, OR THE VALUE READ IS OUT OF THE RANGE OF +-- THE ITEM PARAMETER BUT WITHIN THE RANGE OF INSTANTIATED +-- TYPE. + +-- HISTORY: +-- SPS 10/04/82 +-- DWC 09/09/87 ADDED CASES FOR WIDTH BEING GREATER THAN +-- FIELD'LAST AND THE VALUE BEING READ IS OUT +-- OF ITEM'S RANGE BUT WITHIN INSTANTIATED +-- RANGE. +-- JRL 06/07/96 Added call to Ident_Int in expressions involving +-- Field'Last, to make the expressions non-static and +-- prevent compile-time rejection. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3704C IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3704C", "CHECK THAT INTEGER_IO GET RAISES " & + "CONSTRAINT_ERROR IF THE WIDTH PARAMETER " & + "IS NEGATIVE, IF THE WIDTH PARAMETER IS " & + "GREATER THAN FIELD'LAST WHEN FIELD'LAST IS " & + "LESS THAN INTEGER'LAST, OR THE VALUE READ " & + "IS OUT OF THE RANGE OF THE ITEM PARAMETER " & + "BUT WITHIN THE RANGE OF INSTANTIATED TYPE"); + + DECLARE + FT : FILE_TYPE; + TYPE INT IS NEW INTEGER RANGE 1 .. 10; + PACKAGE IIO IS NEW INTEGER_IO (INT); + X : INT RANGE 1 .. 5; + USE IIO; + BEGIN + + BEGIN + GET (FT, X, IDENT_INT(-1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - FILE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("RAISED STATUS_ERROR"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FILE"); + END; + + BEGIN + GET (X, IDENT_INT(-6)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - DEFAULT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - DEFAULT"); + END; + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, 1); + NEW_LINE (FT); + PUT (FT, 8); + NEW_LINE (FT); + PUT (FT, 2); + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR FOR OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + GET (FT, X, IDENT_INT(-1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - " & + "NEGATIVE WIDTH WITH EXTERNAL FILE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "NEGATIVE WIDTH WITH EXTERNAL FILE"); + END; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("CONSTRAINT_ERROR NOT RAISED - " & + "OUT OF RANGE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "OUT OF RANGE"); + END; + + SKIP_LINE (FT); + + IF FIELD'LAST < INTEGER'LAST THEN + BEGIN + GET (FT, X, FIELD'LAST + Ident_Int(1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - " & + "FIELD'LAST + 1 WIDTH WITH " & + "EXTERNAL FILE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "FIELD'LAST + 1 WIDTH WITH " & + "EXTERNAL FILE"); + END; + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; +END CE3704C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3704d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3704d.ada new file mode 100644 index 000000000..233b8642a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3704d.ada @@ -0,0 +1,169 @@ +-- CE3704D.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 INTEGER_IO GET READS AT MOST WIDTH CHARACTERS +-- OR UP TO THE NEXT TERMINATOR; INCLUDING LEADING BLANKS +-- AND HORIZONTAL TABULATION CHARACTERS, WHEN WIDTH IS +-- NONZERO. + +-- CHECK THAT INPUT TERMINATES WHEN A LINE TERMINATOR IS +-- ENCOUNTERED AND THAT DATA_ERROR IS RAISED IF THE DATA +-- READ IS INVALID. + +-- APPLICABILITY CRITERIA: + +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 10/04/82 +-- VKG 01/12/83 +-- SPS 02/08/83 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/09/87 ADDED CASES FOR TABS, REMOVED UNNECESSARY +-- CODE, AND CHECKED FOR USE_ERROR ON DELETE. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3704D IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3704D", "CHECK THAT INTEGER_IO GET READS AT MOST " & + "WIDTH CHARACTERS OR UP TO THE NEXT " & + "TERMINATOR; INCLUDING LEADING BLANKS AND " & + "HORIZONTAL TABULATION CHARACTERS, WHEN WIDTH " & + "IS NONZERO"); + + DECLARE + FT : FILE_TYPE; + X : INTEGER; + PACKAGE IIO IS NEW INTEGER_IO (INTEGER); + USE IIO; + BEGIN + +-- CREATE AND INITIALIZE FILE + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, " 123"); + NEW_LINE (FT); + PUT (FT, "-5678"); + NEW_LINE (FT); + PUT (FT, " "); + NEW_PAGE (FT); + PUT (FT, ASCII.HT & "9"); + NEW_PAGE (FT); + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + +-- BEGIN TEST + + GET (FT, X, 5); + IF X /= IDENT_INT (123) THEN + FAILED ("WIDTH CHARACTERS NOT READ - 1"); + ELSE + BEGIN + GET (FT, X, 2); + FAILED ("DATA_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED -1"); + END; + SKIP_LINE (FT); + GET (FT, X, 6); + IF X /= IDENT_INT (-5678) THEN + FAILED ("GET WITH WIDTH " & + "INCORRECT - 2"); + ELSE + BEGIN + GET (FT, X, 2); + FAILED ("DATA_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + SKIP_LINE(FT); + BEGIN + GET (FT, X, 2); + FAILED ("DATA_ERROR NOT RAISED - 3"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 3"); + END; + SKIP_LINE(FT); + GET (FT, X, 2); + IF X /= IDENT_INT (9) THEN + FAILED ("GET WITH WIDTH " & + "INCORRECT - 3"); + END IF; + END IF; + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3704D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3704e.ada b/gcc/testsuite/ada/acats/tests/ce/ce3704e.ada new file mode 100644 index 000000000..6fb043079 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3704e.ada @@ -0,0 +1,143 @@ +-- CE3704E.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 INTEGER_IO GET RAISES DATA_ERROR WHEN THE LEXICAL +-- ELEMENT IS NOT OF THE INTEGER TYPE EXPECTED. CHECK THAT ITEM +-- IS UNAFFECTED AND READING CAN CONTINUE AFTER THE EXCEPTION +-- HAS BEEN HANDLED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 10/04/82 +-- VKG 01/14/83 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/10/87 REMOVED UNNECCESSARY CODE, CORRECTED EXCEPTION +-- HANDLING, AND CHECKED FOR USE_ERROR ON DELETE. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3704E IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3704E", "CHECK THAT INTEGER_IO GET RAISES DATA_ERROR " & + "WHEN THE LEXICAL ELEMENT IS NOT OF THE " & + "INTEGER TYPE EXPECTED. CHECK THAT ITEM " & + "IS UNAFFECTED AND READING CAN CONTINUE AFTER " & + "THE EXCEPTION HAS BEEN HANDLED"); + + DECLARE + FT : FILE_TYPE; + TYPE INT IS NEW INTEGER RANGE 10 .. 20; + PACKAGE IIO IS NEW INTEGER_IO (INT); + USE IIO; + X : INT := 16; + BEGIN + +-- CREATE AND INITIALIZE FILE + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, " 101 12"); + CLOSE(FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + GET (FT, X, 2); + FAILED ("DATA_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 16 THEN + FAILED ("ITEM AFFECTED BY GET WHEN DATA" & + "_ERROR IS RAISED"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 1"); + END; + + BEGIN + GET (FT, X, 3); + FAILED ("DATA_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 16 THEN + FAILED ("ITEM AFFECTED BY GET WHEN DATA" & + "_ERROR IS RAISED"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + + BEGIN + GET (FT, X, 2); + IF X /= 12 THEN + FAILED ("READING NOT CONTINUED CORRECTLY " & + "AFTER EXCEPTION"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("GET OF CORRECT DATA RAISED EXCEPTION"); + END; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3704E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3704f.ada b/gcc/testsuite/ada/acats/tests/ce/ce3704f.ada new file mode 100644 index 000000000..22f021712 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3704f.ada @@ -0,0 +1,365 @@ +-- CE3704F.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 INTEGER_IO GET DOES NOT ALLOW EMBEDDED BLANKS OR +-- CONSECUTIVE UNDERSCORES TO BE INPUT. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 10/04/82 +-- VKG 01/14/83 +-- CPP 07/30/84 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/10/87 REMOVED UNNECESSARY CODE, CORRECTED EXCEPTION +-- HANDLING, AND ADDED MORE CHECKS OF THE VALUES +-- OF CHARACTERS READ. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3704F IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3704F", "INTEGER_IO GET DOES NOT ALLOW EMBEDDED " & + "BLANKS OR CONSECUTIVE UNDERSCORES"); + + DECLARE + FT : FILE_TYPE; + X : INTEGER; + PACKAGE IIO IS NEW INTEGER_IO (INTEGER); + USE IIO; + CH : CHARACTER; + P : POSITIVE; + BEGIN + +-- CREATE AND INITIALIZE FILE + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, "12_345"); + NEW_LINE (FT); + PUT (FT, "12 345"); + NEW_LINE (FT); + PUT (FT, "1__345"); + NEW_LINE (FT); + PUT (FT, "-56"); + NEW_LINE (FT); + PUT (FT, "10E0"); + NEW_LINE (FT); + PUT (FT, "10E-2X"); + NEW_LINE (FT); + PUT (FT, "4E1__2"); + NEW_LINE (FT); + PUT (FT, "1 0#99#"); + NEW_LINE (FT); + PUT (FT, "1__0#99#"); + NEW_LINE (FT); + PUT (FT, "10#9_9#"); + NEW_LINE (FT); + PUT (FT, "10#9__9#"); + NEW_LINE (FT); + PUT (FT, "10#9 9#"); + NEW_LINE (FT); + PUT (FT, "16#E#E1"); + NEW_LINE (FT); + PUT (FT, "2#110#E1_1"); + NEW_LINE (FT); + PUT (FT, "2#110#E1__1"); + CLOSE(FT); + +-- BEGIN TEST + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; " & + "TEXT OPEN WITH IN_FILE " & + "MODE"); + RAISE INCOMPLETE; + END; + + GET (FT, X); + IF X /= 12345 THEN + FAILED ("GET WITH UNDERSCORE INCORRECT - (1)"); + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X, 6); + FAILED ("DATA_ERROR NOT RAISED - (2)"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - (2)"); + END; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - (3)"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - (3)"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - (3)"); + ELSE + GET (FT, CH); + IF CH /= '_' THEN + FAILED ("GET STOPPED AT WRONG POSITION - " & + "(3): CHAR IS " & CH); + END IF; + GET (FT, CH); + IF CH /= '3' THEN + FAILED ("GET STOPPED AT WRONG POSITION - " & + "(3.5): CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + GET (FT, X); + IF X /= (-56) THEN + FAILED ("GET WITH GOOD CASE INCORRECT - (4)"); + END IF; + + SKIP_LINE (FT); + GET (FT, X, 4); + IF X /= 10 THEN + FAILED ("GET WITH ZERO EXPONENT INCORRECT - (5)"); + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - (6)"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - (6)"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - (6)"); + ELSE + GET (FT, CH); + IF CH /= 'X' THEN + FAILED ("GET STOPPED AT WRONG POSITION - " & + "(6): CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - (7)"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - (7)"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - (7)"); + ELSE + GET (FT, CH); + IF CH /= '_' THEN + FAILED ("GET STOPPED AT WRONG POSITION - " & + "(7): CHAR IS " & CH); + END IF; + GET (FT, CH); + IF CH /= '2' THEN + FAILED ("GET STOPPED AT WRONG POSITION - " & + "(7.5): CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X, 7); + FAILED ("DATA_ERROR NOT RAISED - (8)"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - (8)"); + END; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - (9)"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - (9)"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - (9)"); + ELSE + GET (FT, CH); + IF CH /= '_' THEN + FAILED ("GET STOPPED AT WRONG POSITION " & + "- (9): CHAR IS " & CH); + END IF; + GET (FT, CH); + IF CH /= '0' THEN + FAILED ("GET STOPPED AT WRONG POSITION " & + "- (9.5): CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + GET (FT, X); + IF X /= 99 THEN + FAILED ("GET WITH UNDERSCORE IN " & + "BASED LITERAL INCORRECT - (10)"); + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - (11)"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - (11)"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - (11)"); + ELSE + GET (FT, CH); + IF CH /= '_' THEN + FAILED ("GET STOPPED AT WRONG POSITION - " & + "(11): CHAR IS " & CH); + END IF; + GET (FT, CH); + IF CH /= '9' THEN + FAILED ("GET STOPPED AT WRONG POSITION - " & + "(11.5): CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X, 6); + FAILED ("DATA_ERROR NOT RAISED - (12)"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - (12)"); + END; + + SKIP_LINE (FT); + GET (FT, X, 7); + IF X /= 224 THEN + FAILED ("GET WITH GOOD CASE OF " & + "BASED LITERAL INCORRECT - (13)"); + END IF; + + SKIP_LINE (FT); + GET (FT, X, 10); + IF X /= (6 * 2 ** 11) THEN + FAILED ("GET WITH UNDERSCORE IN EXPONENT" & + "OF BASED LITERAL INCORRECT - (14)"); + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - (15)"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - (15)"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - (15)"); + ELSE + GET (FT, CH); + IF CH /= '_' THEN + FAILED ("GET STOPPED AT WRONG POSITION - " & + "(15): CHAR IS " & CH); + END IF; + GET (FT, CH); + IF CH /= '1' THEN + FAILED ("GET STOPPED AT WRONG POSITION - " & + "(15.5): CHAR IS " & CH); + END IF; + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3704F; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3704m.ada b/gcc/testsuite/ada/acats/tests/ce/ce3704m.ada new file mode 100644 index 000000000..2d6d3d4be --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3704m.ada @@ -0,0 +1,198 @@ +-- CE3704M.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 GET FOR INTEGER_IO RAISES DATA_ERROR WHEN +-- THE INPUT CONTAINS +-- +-- (1) INTEGER_IO DECIMAL POINT +-- (2) INTEGER_IO LEADING OR TRAILING UNDERSCORES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- VKG 02/10/83 +-- CPP 07/30/84 +-- EG 05/22/85 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/11/87 REMOVED UNNECESSARY CODE, CORRECTED +-- EXCEPTION HANDLING, AND ADDED CASES WHICH +-- CHECK GET AT THE END_OF_FILE. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3704M IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3704M", "CHECK THAT DATA_ERROR IS RAISED FOR " & + "INTEGER_IO WHEN A DECIMAL POINT, OR " & + "LEADING OR TRAILING UNDERSCORES " & + "ARE DETECTED"); + + DECLARE + FT : FILE_TYPE; + CH : CHARACTER; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, "3.14152"); + NEW_LINE (FT); + PUT (FT, "2.15"); + NEW_LINE (FT); + PUT (FT, "_312"); + NEW_LINE (FT); + PUT (FT, "-312_"); + + CLOSE (FT); + + DECLARE + PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER); + USE INT_IO; + X : INTEGER := 402; + BEGIN + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + GET (FT, X, 3); + FAILED ("DATA_ERROR NOT RAISED - (1)"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED - (1)"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - (1)"); + ELSE + GET (FT, CH); + IF CH /= '4' THEN + FAILED ("GET STOPPED AT WRONG " & + "POSITION - (1): CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + IF X /= 2 THEN + FAILED ("WRONG VALUE READ - (2)"); + END IF; + EXCEPTION + WHEN DATA_ERROR => + FAILED ("DATA_ERROR RAISED - (2)"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED - (2)"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - (2)"); + ELSE + GET (FT, CH); + IF CH /= '.' THEN + FAILED ("GET STOPPED AT WRONG " & + "POSITION - (2): CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - (3)"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED - (3)"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - (3)"); + ELSE + GET (FT, CH); + IF CH /= '_' THEN + FAILED ("GET STOPPED AT WRONG POSITION " & + "- (3): CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - (4)"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED - (4)"); + END; + + IF NOT END_OF_LINE (FT) THEN + FAILED ("END_OF_LINE NOT TRUE AFTER (4)"); + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END; + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3704M; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3704n.ada b/gcc/testsuite/ada/acats/tests/ce/ce3704n.ada new file mode 100644 index 000000000..656b45a96 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3704n.ada @@ -0,0 +1,229 @@ +-- CE3704N.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 GET FOR INTEGER_IO RAISES DATA_ERROR WHEN: +-- (A) BASE LESS THAN 2 OR GREATER THAN 16 +-- (B) THE LETTERS IN BASE ARE OUT OF THE BASE RANGE +-- (C) THERE IS NO CLOSING '#' SIGN FOR A BASED LITERAL + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- VKG 02/10/83 +-- SPS 03/16/83 +-- CPP 07/30/84 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/11/87 REMOVED UNNECESSARY CODE, CORRECTED +-- EXCEPTION HANDLING, AND CHECKED FOR +-- USE_ERROR ON DELETE. + +WITH TEXT_IO; USE TEXT_IO; +WITH REPORT ; USE REPORT ; + +PROCEDURE CE3704N IS + INCOMPLETE : EXCEPTION; + +BEGIN + TEST ("CE3704N" ,"CHECK THAT DATA_ERROR IS RAISED WHEN " & + "A BASED LITERAL DOES NOT HAVE ITS BASE " & + "IN THE RANGE 2 .. 16, DIGIT IS OUTSIDE " & + "THE BASE RANGE, OR THERE IS NO CLOSING " & + "'#' SIGN"); + + DECLARE + FT : FILE_TYPE; + BEGIN + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, "1#0000#"); + NEW_LINE (FT); + PUT (FT, "A#234567#"); + NEW_LINE (FT); + PUT (FT, "17#123#1"); + NEW_LINE (FT); + PUT (FT, "5#1253#2"); + NEW_LINE (FT); + PUT (FT, "8#123"); + CLOSE (FT); + + DECLARE + PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER); + USE INT_IO; + X : INTEGER := 1003; + CH : CHARACTER; + BEGIN + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - (1)"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 1003 THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - (1)"); + END; + + IF NOT END_OF_LINE (FT) THEN + GET (FT, CH); + FAILED ("GET STOPPED AT WRONG POSITION - " & + "(1): CHAR IS " & CH); + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - (2)"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 1003 THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - (2)"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - (2)"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - (2)"); + ELSE + GET (FT, CH); + IF CH /= 'A' THEN + FAILED ("GET STOPPED AT WRONG POSITION " & + "- (2): CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - (2A)"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 1003 THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - (2A)"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - (2A)"); + END; + + IF NOT END_OF_LINE (FT) THEN + GET (FT, CH); + IF CH /= '1' THEN + FAILED ("GET STOPPED AT WRONG POSITION " & + "- (2A): CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - (3)"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 1003 THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - (3)"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - (3)"); + END; + + IF NOT END_OF_LINE (FT) THEN + GET (FT, CH); + IF CH /= '2' THEN + FAILED ("GET STOPPED AT WRONG POSITION - " & + "(3): CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - (4)"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 1003 THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - (4)"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - (4)"); + END; + + IF NOT END_OF_LINE (FT) THEN + GET (FT, CH); + IF CH /= ' ' THEN + FAILED ("GET STOPPED AT WRONG POSITION " & + "- (4): CHAR IS " & CH); + END IF; + END IF; + + END; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3704N; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3704o.ada b/gcc/testsuite/ada/acats/tests/ce/ce3704o.ada new file mode 100644 index 000000000..f38b1e9b7 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3704o.ada @@ -0,0 +1,161 @@ +-- CE3704O.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 GET WILL RAISE DATA_ERROR IF THE USE OF # AND : +-- IN BASED LITERALS IS MIXED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- VKG 02/10/83 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/11/87 REMOVED UNNECESSARY CODE AND CORRECTED +-- EXCEPTION HANDLING. + +WITH TEXT_IO; USE TEXT_IO; +WITH REPORT; USE REPORT; + +PROCEDURE CE3704O IS + + INCOMPLETE : EXCEPTION; + +BEGIN + TEST ("CE3704O", "CHECK THAT MIXED USE OF # AND : " & + "IN BASED LITERALS WILL RAISE DATA_ERROR"); + + DECLARE + FT : FILE_TYPE; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + + PUT_LINE (FT, "8#77#E+1"); + PUT_LINE (FT, "2:110:"); + PUT (FT, "2#11:"); + NEW_LINE (FT); + PUT (FT, "4:223#"); + NEW_LINE (FT); + CLOSE (FT); + + + DECLARE + PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER); + USE INT_IO; + X : INTEGER := 100; + CH : CHARACTER; + BEGIN + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FT, X); + IF X /= 8#77#E+1 THEN + FAILED ("INCORRECT VALUE - 1"); + END IF; + + GET (FT, X); + IF X /= 2#110# THEN + FAILED ("INCORRECT VALUE - 2"); + END IF; + + BEGIN + X := 100; + GET (FT,X); + FAILED ("DATA_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 100 THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - 1"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED"); + END; + + IF NOT END_OF_LINE (FT) THEN + GET (FT, CH); + IF CH /= ':' THEN + FAILED ("GET STOPPED AT WRONG POSITION - 1"); + END IF; + END IF; + + BEGIN + X := 100; + GET (FT,X); + FAILED ("DATA_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 100 THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - 2"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + + IF NOT END_OF_LINE (FT) THEN + GET (FT, CH); + IF CH /='#' THEN + FAILED ("GET STOPPED AT WRONG " & + "POSITION - 1"); + END IF; + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + RESULT; + +END CE3704O; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3705a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3705a.ada new file mode 100644 index 000000000..8cd848e4c --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3705a.ada @@ -0,0 +1,109 @@ +-- CE3705A.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: +-- FOR GET FROM A FILE, CHECK THAT IF ONLY THE FILE TERMINATOR +-- REMAINS TO BE READ, THEN ANY CALL TO GET FOR AN INTEGER (EVEN +-- WITH WIDTH = 0) RAISES END_ERROR. + +-- HISTORY: +-- BCB 10/28/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3705A IS + + FILE : FILE_TYPE; + + INCOMPLETE : EXCEPTION; + + I : INTEGER; + + PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER); USE INT_IO; + +BEGIN + TEST ("CE3705A", "FOR GET FROM A FILE, CHECK THAT IF ONLY THE " & + "FILE TERMINATOR REMAINS TO BE READ, THEN ANY " & + "CALL TO GET FOR AN INTEGER (EVEN WITH WIDTH = " & + "0) RAISES END_ERROR"); + + BEGIN + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, 3); + + CLOSE (FILE); + + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + + GET (FILE, I); + + BEGIN + GET (FILE, I); + FAILED ("END_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 1"); + END; + + BEGIN + GET (FILE, I, WIDTH => 0); + FAILED ("END_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("OTHER EXCEPTION RAISED - 2"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; +END CE3705A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3705b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3705b.ada new file mode 100644 index 000000000..a0357e366 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3705b.ada @@ -0,0 +1,144 @@ +-- CE3705B.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: +-- IF WIDTH IS ZERO, CHECK THAT END_ERROR IS RAISED IF THE ONLY +-- REMAINING CHARACTERS IN THE FILE CONSIST OF LINE TERMINATORS, +-- PAGE TERMINATORS, SPACES, AND HORIZONTAL TABULATION CHARACTERS. +-- AFTER END_ERROR IS RAISED, THE FILE SHOULD BE POSITIONED BEFORE +-- THE FILE TERMINATOR AND END_OF_FILE SHOULD BE TRUE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS THAT SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JLH 07/15/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3705B IS + + PACKAGE IIO IS NEW INTEGER_IO (INTEGER); + USE IIO; + + FILE : FILE_TYPE; + ITEM : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3705B", "IF WIDTH IS ZERO, CHECK THAT END_ERROR IS " & + "RAISED IF THE ONLY REMAINING CHARACTERS IN " & + "THE FILE CONSIST OF LINE TERMINATORS, PAGE " & + "TERMINATORS, SPACES, AND HORIZONTAL TAB " & + "CHARACTERS. AFTER END_ERROR IS RAISED, THE " & + "FILE SHOULD BE POSITIONED BEFORE THE FILE " & + "TERMINATOR AND END_OF_FILE SHOULD BE TRUE"); + + BEGIN + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, 2); + NEW_LINE (FILE); + PUT (FILE, 3); + NEW_LINE (FILE); + NEW_PAGE (FILE); + PUT (FILE, ASCII.HT); + NEW_LINE (FILE); + NEW_LINE (FILE); + NEW_PAGE (FILE); + PUT (FILE, ' '); + PUT (FILE, ASCII.HT); + PUT (FILE, ' '); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " & + "MODE IN_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + RAISE INCOMPLETE; + END; + + GET (FILE, ITEM); + IF ITEM /= 2 THEN + FAILED ("INCORRECT VALUE READ - 1"); + END IF; + + GET (FILE, ITEM); + IF ITEM /= 3 THEN + FAILED ("INCORRECT VALUE READ - 2"); + END IF; + + BEGIN + GET (FILE, ITEM, WIDTH => 0); + FAILED ("END_ERROR NOT RAISED FOR GET"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON GET"); + END; + + IF NOT END_OF_FILE(FILE) THEN + FAILED ("END_OF_FILE NOT TRUE AFTER RAISING EXCEPTION"); + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3705B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3705c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3705c.ada new file mode 100644 index 000000000..a9706da39 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3705c.ada @@ -0,0 +1,137 @@ +-- CE3705C.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 THE LAST CHARACTER IN A FILE MAY BE READ WITHOUT +-- RAISING END_ERROR, AND THAT AFTER THE LAST CHARACTER OF THE +-- FILE HAS BEEN READ, ANY ATTEMPT TO READ FURTHER CHARACTERS +-- WILL RAISE END_ERROR. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JLH 07/18/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3705C IS + + PACKAGE IIO IS NEW INTEGER_IO (INTEGER); + USE IIO; + + FILE : FILE_TYPE; + ITEM : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3705C", "CHECK THAT THE LAST CHARACTER IN A FILE MAY " & + "BE READ WITHOUT RAISING END_ERROR, AND THAT " & + "AFTER THE LAST CHARACTER OF THE FILE HAS BEEN " & + "READ, ANY ATTEMPT TO READ FURTHER CHARACTERS " & + "WILL RAISE END_ERROR"); + + BEGIN + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + + PUT (FILE, 2); + PUT (FILE, 3); + NEW_LINE (FILE); + NEW_PAGE (FILE); + PUT (FILE, 5); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " & + "MODE IN_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + RAISE INCOMPLETE; + END; + + GET (FILE, ITEM); + GET (FILE, ITEM); + + BEGIN + GET (FILE, ITEM); + IF ITEM /= 5 THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + BEGIN + GET (FILE, ITEM); + FAILED ("END_ERROR NOT RAISED AFTER LAST " & + "CHARACTER OF FILE HAS BEEN READ"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON GET"); + END; + EXCEPTION + WHEN END_ERROR => + FAILED ("END_ERROR RAISED WHEN READING LAST " & + "CHARACTER OF FILE"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON GET - 2"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3705C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3705d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3705d.ada new file mode 100644 index 000000000..b9af594df --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3705d.ada @@ -0,0 +1,124 @@ +-- CE3705D.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 DATA_ERROR, NOT END_ERROR, IS RAISED WHEN WIDTH > 0, +-- FEWER THAN WIDTH CHARACTERS REMAIN IN THE FILE, A BASED LITERAL +-- IS BEING READ, AND THE CLOSING # OR : HAS NOT YET BEEN FOUND. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JLH 07/19/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3705D IS + + PACKAGE IIO IS NEW INTEGER_IO (INTEGER); + USE IIO; + + FILE : FILE_TYPE; + ITEM : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3705D", "CHECK THAT DATA_ERROR, NOT END_ERROR, IS " & + "RAISED WHEN WIDTH > 0, FEWER THAN WIDTH " & + "CHARACTERS REMAIN IN THE FILE, A BASED " & + "LITERAL IS BEING READ, AND THE CLOSING # " & + "OR : HAS NOT YET BEEN FOUND"); + + BEGIN + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, "2#1111_1111#"); + NEW_LINE (FILE); + PUT (FILE, "16#FFF"); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN " & + "WITH MODE IN_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + RAISE INCOMPLETE; + END; + + GET (FILE, ITEM); + IF ITEM /= 255 THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + + BEGIN + GET (FILE, ITEM, WIDTH => 7); + FAILED ("DATA_ERROR NOT RAISED"); + EXCEPTION + WHEN END_ERROR => + FAILED ("END_ERROR INSTEAD OF DATA_ERROR RAISED"); + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON GET"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3705D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3705e.ada b/gcc/testsuite/ada/acats/tests/ce/ce3705e.ada new file mode 100644 index 000000000..22798b534 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3705e.ada @@ -0,0 +1,124 @@ +-- CE3705E.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 DATA_ERROR, NOT END_ERROR, IS RAISED WHEN FEWER THAN +-- WIDTH CHARACTERS REMAIN IN THE FILE, AND THE REMAINING CHARACTERS +-- SATISFY THE SYNTAX FOR A REAL LITERAL. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JLH 07/20/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3705E IS + + PACKAGE IIO IS NEW INTEGER_IO (INTEGER); + USE IIO; + + FILE : FILE_TYPE; + ITEM : INTEGER; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3705E", "CHECK THAT DATA_ERROR, NOT END_ERROR, IS " & + "RAISED WHEN FEWER THAN WIDTH CHARACTERS " & + "REMAIN IN THE FILE, AND THE REMAINING " & + "CHARACTERS SATISFY THE SYNTAX FOR A REAL " & + "LITERAL"); + + BEGIN + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, "16#FFF#"); + NEW_LINE (FILE); + PUT (FILE, "3.14159_26"); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN " & + "WITH MODE IN_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + RAISE INCOMPLETE; + END; + + GET (FILE, ITEM); + IF ITEM /= 4095 THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + + BEGIN + GET (FILE, ITEM, WIDTH => 11); + FAILED ("DATA_ERROR NOT RAISED"); + EXCEPTION + WHEN END_ERROR => + FAILED ("END_ERROR INSTEAD OF DATA_ERROR RAISED"); + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON GET"); + END; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3705E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3706c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3706c.ada new file mode 100644 index 000000000..b7cdd1626 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3706c.ada @@ -0,0 +1,164 @@ +-- CE3706C.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 INTEGER_IO PUT RAISES CONSTRAINT_ERROR IF: +-- A) THE BASE IS OUTSIDE THE RANGE 2..16. +-- B) THE VALUE OF WIDTH IS NEGATIVE OR GREATER THAN FIELD'LAST, +-- WHEN FIELD'LAST < INTEGER'LAST. +-- C) THE VALUE OF ITEM IS OUTSIDE THE RANGE OF THE INSTANTIATED +-- TYPE. + +-- HISTORY: +-- SPS 10/05/82 +-- JBG 08/30/83 +-- JLH 09/10/87 ADDED CASES FOR THE VALUE OF THE WIDTH BEING LESS +-- THAN ZERO AND GREATER THAN FIELD'LAST AND CASES FOR +-- THE VALUE OF ITEM OUTSIDE THE RANGE OF THE +-- INSTANTIATED TYPE. +-- JRL 06/07/96 Added call to Ident_Int in expressions involving +-- Field'Last, to make the expressions non-static and +-- prevent compile-time rejection. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3706C IS +BEGIN + + TEST ("CE3706C", "CHECK THAT INTEGER_IO PUT RAISES CONSTRAINT " & + "ERROR APPROPRIATELY"); + + DECLARE + FT : FILE_TYPE; + TYPE INT IS NEW INTEGER RANGE 1 .. 10; + PACKAGE IIO IS NEW INTEGER_IO (INT); + USE IIO; + ST : STRING (1 .. 10); + BEGIN + + BEGIN + PUT (FT, 2, 6, 1); + FAILED ("CONSTRAINT_ERROR NOT RAISED - FILE - 1"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FILE - 1"); + END; + + BEGIN + PUT (3, 4, 17); + FAILED ("CONSTRAINT_ERROR NOT RAISED - DEFAULT - 1"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - DEFAULT - 1"); + END; + + BEGIN + PUT (TO => ST, ITEM => 4, BASE => -3); + FAILED ("CONSTRAINT_ERROR NOT RAISED - STRING - 1"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - STRING - 1"); + END; + + BEGIN + PUT (ST, 5, 17); + FAILED ("CONSTRAINT_ERROR NOT RAISED - STRING - 2"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - STRING - 2"); + END; + + BEGIN + PUT (FT, 5, -1); + FAILED ("CONSTRAINT_ERROR NOT RAISED - FILE - 2"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FILE - 2"); + END; + + BEGIN + PUT (7, -3); + FAILED ("CONSTRAINT_ERROR NOT RAISED - DEFAULT - " & + "2"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - DEFAULT - 2"); + END; + + IF FIELD'LAST < INTEGER'LAST THEN + BEGIN + PUT (7, FIELD'LAST+Ident_Int(1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR WIDTH " & + "GREATER THAN FIELD'LAST"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR WIDTH " & + "GREATER THAN FIELD'LAST"); + END; + + END IF; + + BEGIN + PUT (FT, 11); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " & + "RANGE - FILE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " & + "RANGE - FILE"); + END; + + BEGIN + PUT (11); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " & + "RANGE - DEFAULT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " & + "RANGE - DEFAULT"); + END; + + END; + + RESULT; +END CE3706C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3706d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3706d.ada new file mode 100644 index 000000000..3696af3e7 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3706d.ada @@ -0,0 +1,127 @@ +-- CE3706D.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 INTEGER_IO PUT RAISES MODE_ERROR FOR FILES OF MODE +-- IN_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 10/05/82 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/10/87 REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY +-- CODE, AND CORRECTED EXCEPTION HANDLING. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3706D IS + +BEGIN + + TEST ("CE3706D", "CHECK THAT INTEGER_IO PUT RAISES MODE_ERROR " & + "FOR FILES OF MODE IN_FILE"); + + DECLARE + FT : FILE_TYPE; + TYPE INT IS NEW INTEGER RANGE 1 .. 30; + PACKAGE IIO IS NEW INTEGER_IO (INT); + USE IIO; + INCOMPLETE : EXCEPTION; + BEGIN + + BEGIN + PUT (STANDARD_INPUT, 26); + FAILED ("MODE_ERROR NOT RAISED - STANDARD_INPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - STANDARD_INPUT"); + END; + + BEGIN + PUT (CURRENT_INPUT, 26); + FAILED ("MODE_ERROR NOT RAISED - CURRENT_INPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - CURRENT_INPUT"); + END; + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, 'A'); + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + PUT (FT, 26); + FAILED ("MODE_ERROR NOT RAISED - FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FILE"); + END; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3706D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3706f.ada b/gcc/testsuite/ada/acats/tests/ce/ce3706f.ada new file mode 100644 index 000000000..833332e3a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3706f.ada @@ -0,0 +1,119 @@ +-- CE3706F.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 INTEGER_IO PUT RAISES LAYOUT_ERROR WHEN THE NUMBER OF +-- CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE LENGTH. CHECK +-- THAT IT IS NOT RAISED WHEN THE NUMBER OF CHARACTERS TO BE OUTPUT +-- ADDED TO THE CURRENT COLUMN NUMBER EXCEEDS THE MAXIMUM LINE +-- LENGTH. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE. + +-- HISTORY: +-- SPS 10/05/82 +-- VKG 01/14/83 +-- SPS 02/18/83 +-- JBG 08/30/83 +-- EG 05/22/85 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/10/87 REMOVED UNNECESSARY CODE, CORRECTED EXCEPTION +-- HANDLING, AND ADDED CASE USING WIDTH OF FIVE. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; +WITH CHECK_FILE; + +PROCEDURE CE3706F IS + +BEGIN + + TEST ("CE3706F", "CHECK THAT LAYOUT_ERROR IS RAISED CORRECTLY"); + + DECLARE + FT : FILE_TYPE; + PACKAGE IIO IS NEW INTEGER_IO (INTEGER); + USE IIO; + INCOMPLETE : EXCEPTION; + BEGIN + + BEGIN + CREATE (FT); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "FOR TEMPORARY FILE WITH " & + "OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + SET_LINE_LENGTH (FT, 4); + + BEGIN + PUT (FT, 32_000, WIDTH => 0); + FAILED ("LAYOUT_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 1"); + END; + + BEGIN + PUT (FT, 32_000, WIDTH => 5); + FAILED ("LAYOUT_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + + PUT (FT, 123, WIDTH => 0); -- "123" + + BEGIN + PUT (FT, 457, WIDTH => 0); -- "123#457" + IF LINE (FT) /= 2 THEN + FAILED ("OUTPUT INCORRECT"); + END IF; + EXCEPTION + WHEN LAYOUT_ERROR => + FAILED ("LAYOUT_ERROR RAISED INCORRECTLY"); + END; + + CHECK_FILE (FT, "123#457#@%"); + + CLOSE (FT); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3706F; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3706g.ada b/gcc/testsuite/ada/acats/tests/ce/ce3706g.ada new file mode 100644 index 000000000..705c215ec --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3706g.ada @@ -0,0 +1,111 @@ +-- CE3706G.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 INTEGER_IO PUT USES THE MINIMUM FIELD REQUIRED IF +-- WIDTH IS TOO SMALL AND THE LINE LENGTH IS SUFFICIENTLY LARGE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 10/05/82 +-- JLH 09/17/87 COMPLETELY REVISED TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3706G IS + +BEGIN + + TEST ("CE3706G", "CHECK THAT INTEGER_IO PUT USES THE MINIMUM " & + "FIELD REQUIRED IF WIDTH IS TOO SMALL AND THE " & + "LINE LENGTH IS SUFFICIENTLY LARGE"); + + DECLARE + FILE : FILE_TYPE; + PACKAGE IIO IS NEW INTEGER_IO (INTEGER); + USE IIO; + INCOMPLETE : EXCEPTION; + NUM : INTEGER := 12345; + CH : CHARACTER; + + BEGIN + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, NUM, WIDTH => 3); + TEXT_IO.PUT (FILE, ' '); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FILE, NUM); + GET (FILE, CH); + IF CH /= ' ' AND COL(FILE) /= 7 THEN + FAILED ("INTEGER_IO PUT DOES NOT USE MINIMUM FIELD " & + "REQUIRED WHEN WIDTH IS TOO SMALL"); + END IF; + + IF NUM /= 12345 THEN + FAILED ("INCORREC VALUE READ"); + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3706G; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3707a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3707a.ada new file mode 100644 index 000000000..a338fbf8d --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3707a.ada @@ -0,0 +1,130 @@ +-- CE3707A.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 INTEGER_IO GET CAN READ A VALUE FROM A STRING. CHECK +-- THAT IT TREATS THE END OF THE STRING AS A FILE TERMINATOR. CHECK +-- THAT LAST CONTAINS THE INDEX VALUE OF THE LAST CHARACTER READ +-- FROM THE STRING. + +-- HISTORY: +-- SPS 10/05/82 +-- VKG 01/13/83 +-- JLH 09/11/87 CORRECTED EXCEPTION HANDLING. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3707A IS + + PACKAGE IIO IS NEW INTEGER_IO (INTEGER); + USE IIO; + X : INTEGER; + L : POSITIVE; + STR : STRING(1..6) := "123456" ; + +BEGIN + + TEST ("CE3707A", "CHECK THAT INTEGER_IO GET OPERATES CORRECTLY " & + "ON STRINGS"); + +-- LEFT JUSTIFIED STRING NON NULL + + GET ("2362 ", X, L); + IF X /= 2362 THEN + FAILED ("VALUE FROM STRING INCORRECT - 1"); + END IF; + + IF L /= 4 THEN + FAILED ("VALUE OF LAST INCORRECT - 1"); + END IF; + +-- STRING LITERAL WITH BLANKS + + BEGIN + GET (" ", X, L); + FAILED ("END_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN END_ERROR => + IF L /= 4 THEN + FAILED ("AFTER END ERROR VALUE OF LAST " & + "INCORRECT - 2"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + +-- NULL STRING + + BEGIN + GET ("", X, L); + FAILED (" END_ERROR NOT RAISED - 3"); + EXCEPTION + WHEN END_ERROR => + IF L /= 4 THEN + FAILED ("AFTER END_ERROR VALUE OF LAST " & + "INCORRECT - 3"); + END IF; + WHEN OTHERS => + FAILED ("SOME EXCEPTION RAISED - 3"); + END; + +-- NULL SLICE + + BEGIN + GET(STR(5..IDENT_INT(2)), X, L); + FAILED ("END_ERROR NOT RAISED - 4"); + EXCEPTION + WHEN END_ERROR => + IF L /= 4 THEN + FAILED ("AFTER END_ERROR VALUE OF LAST " & + "INCORRECT - 4"); + END IF; + WHEN OTHERS => + FAILED ("SOME EXCEPTION RAISED - 4"); + END; + +-- NON-NULL SLICE + + GET (STR(2..3), X, L); + IF X /= 23 THEN + FAILED ("INTEGER VALUE INCORRECT - 5"); + END IF; + IF L /= 3 THEN + FAILED ("LAST INCORRECT FOR SLICE - 5"); + END IF; + +-- RIGHT JUSTIFIED NEGATIVE NUMBER + + GET(" -2345",X,L); + IF X /= -2345 THEN + FAILED ("INTEGER VALUE INCORRECT - 6"); + END IF; + IF L /= 8 THEN + FAILED ("LAST INCORRECT FOR NEGATIVE NUMBER - 6"); + END IF; + + RESULT; + +END CE3707A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3708a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3708a.ada new file mode 100644 index 000000000..104bc20c7 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3708a.ada @@ -0,0 +1,87 @@ +-- CE3708A.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 INTEGER_IO PUT RAISES LAYOUT_ERROR WHEN THE MINIMUM +-- WIDTH REQUIRED FOR THE OUTPUT VALUE IS GREATER THAN THE LENGTH +-- OF THE STRING. ALSO CHECK THAT INTEGER_IO PUT PADS THE OUTPUT +-- ON THE LEFT WITH SPACES IF THE LENGTH OF THE STRING IS GREATER +-- THAN THE MINIMUM WIDTH REQUIRED. + +-- HISTORY: +-- SPS 10/05/82 +-- CPP 07/30/84 +-- JLH 09/11/87 ADDED CASES FOR PADDING OF OUTPUT STRING. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3708A IS +BEGIN + + TEST ("CE3708A", "CHECK THAT INTEGER_IO PUT RAISES LAYOUT_ERROR " & + "WHEN THE MINIMUM WIDTH REQUIRED FOR THE " & + "OUTPUT VALUE IS GREATER THAN THE LENGTH OF " & + "THE STRING. ALSO CHECK THAT INTEGER_IO PUT " & + "PADS THE OUTPUT ON THE LEFT WITH SPACES IF " & + "THE LENGTH OF THE STRING IS GREATER THAN THE " & + "MINIMUM WIDTH REQUIRED."); + + DECLARE + PACKAGE IIO IS NEW INTEGER_IO (INTEGER); + USE IIO; + ST1 : STRING (1 .. 4); + ST2 : STRING (1 .. 4); + ST : STRING (1 .. 4) := "6382"; + BEGIN + PUT (ST1, IDENT_INT(6382)); + IF ST1 /= ST THEN + FAILED ("PUT TO STRING INCORRECT"); + END IF; + + BEGIN + PUT (ST2, IDENT_INT(12345)); + FAILED ("LAYOUT_ERROR NOT RAISED"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED"); + END; + + PUT (ST1, IDENT_INT(123)); + IF ST1 /= " 123" THEN + FAILED ("PUT DID NOT PAD WITH BLANKS - 1"); + END IF; + + PUT (ST2, IDENT_INT(-2)); + IF ST2 /= " -2" THEN + FAILED ("PUT DID NOT PAD WITH BLANKS - 2"); + END IF; + + END; + + RESULT; + +END CE3708A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3801a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3801a.ada new file mode 100644 index 000000000..027093632 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3801a.ada @@ -0,0 +1,112 @@ +-- CE3801A.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 EACH FLOAT_IO OPERATION RAISES STATUS_ERROR WHEN +-- CALLED WITH A FILE PARAMETER DESIGNATING AN UN-OPEN FILE. + +-- HISTORY: +-- SPS 09/07/82 +-- SPS 12/22/82 +-- DWC 09/11/87 CORRECTED EXCEPTION HANDLING AND REVISED IFS +-- TO CHECK FOR CASE WHEN VALUE IS NEGATIVE OF +-- WHAT IS EXPECTED. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3801A IS +BEGIN + + TEST ("CE3801A", "CHECK THAT EACH FLOAT_IO AND FIXED_IO " & + "OPERATION RAISES STATUS_ERROR WHEN CALLED " & + "WITH A FILE PARAMETER DESIGNATING AN " & + "UN-OPEN FILE"); + + DECLARE + TYPE FLT IS NEW FLOAT RANGE 1.0 .. 10.0; + PACKAGE FLT_IO IS NEW FLOAT_IO (FLT); + USE FLT_IO; + X : FLT := FLT'FIRST; + FT : FILE_TYPE; + BEGIN + + BEGIN + GET (FT, X); + FAILED ("STATUS_ERROR NOT RAISED - GET FLOAT_IO - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET " & + "FLOAT_IO - 1"); + END; + + BEGIN + PUT (FT, X); + FAILED ("STATUS_ERROR NOT RAISED - PUT FLOAT_IO - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - PUT " & + "FLOAT_IO - 1"); + END; + + BEGIN + CREATE (FT, OUT_FILE); -- THIS IS JUST AN ATTEMPT + CLOSE (FT); -- TO CREATE A FILE. + EXCEPTION -- OBJECTIVE MET EITHER WAY. + WHEN USE_ERROR => + NULL; + END; + + BEGIN + GET (FT, X); + FAILED ("STATUS_ERROR NOT RAISED - GET FLOAT_IO - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET " & + "FLOAT_IO - 2"); + END; + + BEGIN + PUT (FT, X); + FAILED ("STATUS_ERROR NOT RAISED - PUT FLOAT_IO - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - PUT " & + "FLOAT_IO - 2"); + END; + END; + + RESULT; + +END CE3801A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3801b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3801b.ada new file mode 100644 index 000000000..1eb3a8e7a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3801b.ada @@ -0,0 +1,108 @@ +-- CE3801B.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 EACH FIXED_IO OPERATION RAISES STATUS_ERROR +-- WHEN CALLED WITH A FILE PARAMETER DESIGNATING AN UN-OPEN FILE. + +-- HISTORY: +-- DWC 09/11/87 CREATED ORIGINAL TEST. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3801B IS +BEGIN + + TEST ("CE3801B", "CHECK THAT EACH FIXED_IO " & + "OPERATION RAISES STATUS_ERROR WHEN CALLED " & + "WITH A FILE PARAMETER DESIGNATING AN " & + "UN-OPEN FILE"); + + DECLARE + TYPE FIX IS DELTA 0.1 RANGE 1.0 .. 10.0; + PACKAGE FIX_IO IS NEW FIXED_IO (FIX); + USE FIX_IO; + X : FIX := FIX'LAST; + FT : FILE_TYPE; + + BEGIN + BEGIN + GET (FT, X); + FAILED ("STATUS_ERROR NOT RAISED - GET FIXED_IO - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET " & + "FIXED_IO - 1"); + END; + + BEGIN + PUT (FT, X); + FAILED ("STATUS_ERROR NOT RAISED - PUT FIXED_IO - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - PUT " & + "FIXED_IO - 1"); + END; + + BEGIN + CREATE (FT, OUT_FILE); -- THIS IS JUST AN ATTEMPT TO + CLOSE (FT); -- CREATE A FILE. OBJECTIVE + EXCEPTION -- IS MET EITHER WAY. + WHEN USE_ERROR => + NULL; + END; + + BEGIN + GET (FT, X); + FAILED ("STATUS_ERROR NOT RAISED - GET FIXED_IO - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET " & + "FIXED_IO - 2"); + END; + + BEGIN + PUT (FT, X); + FAILED ("STATUS_ERROR NOT RAISED - PUT FIXED_IO - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - PUT " & + "FIXED_IO - 2"); + END; + END; + + RESULT; + +END CE3801B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3804a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3804a.ada new file mode 100644 index 000000000..c05a1ff1a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3804a.ada @@ -0,0 +1,157 @@ +-- CE3804A.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 GET FOR FLOAT_IO READS A PLUS OR MINUS SIGN +-- IF PRESENT. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 09/07/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/11/87 CORRECTED EXCEPTION HANDLING AND REVISED IFS +-- TO CHECK FOR CASE WHEN VALUE IS NEGATIVE OF WHAT +-- IS EXPECTED. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3804A IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3804A", "CHECK THAT GET FOR FLOAT_IO READS A PLUS OR " & + "MINUS SIGN IF PRESENT"); + + DECLARE + FT : FILE_TYPE; + TYPE FL IS NEW FLOAT RANGE -3.0 .. 3.0; + X : FL; + ST1 : CONSTANT STRING := IDENT_STR ("-3.0"); + ST2 : CONSTANT STRING := IDENT_STR ("+2.0"); + ST3 : CONSTANT STRING := IDENT_STR ("1.0"); + BEGIN + +-- CREATE AND INITIALIZE DATA FILE + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, ST1); + NEW_LINE(FT); + PUT (FT, ST2); + NEW_LINE(FT); + PUT (FT, ST3); + NEW_LINE(FT); + CLOSE (FT); + +-- BEGIN TEST + + DECLARE + PACKAGE FL_IO IS NEW FLOAT_IO (FL); + USE FL_IO; + LST : POSITIVE; + BEGIN + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FT, X); + IF X = 3.0 THEN + FAILED ("MINUS SIGN NOT READ - 1"); + ELSIF X /= -3.0 THEN + FAILED ("INCORRECT VALUE READ - 1"); + END IF; + + GET (FT, X); + IF X = -2.0 THEN + FAILED ("PLUS SIGN NOT READ - 2"); + ELSIF X /= +2.0 THEN + FAILED ("INCORRECT VALUE READ - 2"); + END IF; + + GET (FT, X); + IF X /= 1.0 THEN + FAILED ("INCORRECT VALUE READ - 3"); + END IF; + + GET (ST1, X, LST); + IF X = 3.0 THEN + FAILED ("MINUS SIGN NOT READ - 4"); + ELSIF X /= -3.0 THEN + FAILED ("INCORRECT VALUE READ - 4"); + END IF; + + GET (ST2, X, LST); + IF X = -2.0 THEN + FAILED ("PLUS SIGN NOT READ - 5"); + ELSIF X /= +2.0 THEN + FAILED ("INCORRECT VALUE READ - 5"); + END IF; + + GET (ST3, X, LST); + IF X /= 1.0 THEN + FAILED ("INCORRECT VALUE READ - 6"); + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3804A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3804b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3804b.ada new file mode 100644 index 000000000..c677d7ea3 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3804b.ada @@ -0,0 +1,147 @@ +-- CE3804B.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 GET FOR FIXED_IO READS A PLUS OR MINUS SIGN IF +-- PRESENT. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 09/07/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/11/87 CORRECTED EXCEPTION HANDLING AND REVISED IFS +-- TO CHECK FOR CASE WHEN VALUE IS NEGATIVE OF +-- WHAT IS EXPECTED. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3804B IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3804B", "CHECK THAT GET FOR FIXED_IO READS A PLUS OR " & + "MINUS SIGN IF PRESENT"); + + DECLARE + FT : FILE_TYPE; + TYPE FIX IS DELTA 0.01 RANGE -3.0 .. 3.0; + X : FIX; + ST1 : CONSTANT STRING := IDENT_STR("-3.0"); + ST2 : CONSTANT STRING := IDENT_STR("+2.0"); + ST3 : CONSTANT STRING := IDENT_STR("1.0"); + BEGIN + +-- CREATE AND INITIALIZE DATA FILE + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, ST1); + NEW_LINE(FT); + PUT (FT, ST2); + NEW_LINE(FT); + PUT (FT, ST3); + NEW_LINE(FT); + CLOSE (FT); + + DECLARE + PACKAGE FIX_IO IS NEW FIXED_IO (FIX); + USE FIX_IO; + LST : POSITIVE; + BEGIN + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FT, X); + IF X /= -3.0 THEN + FAILED ("MINUS SIGN NOT READ - 1"); + END IF; + + GET (FT, X); + IF X /= +2.0 THEN + FAILED ("PLUS SIGN NOT READ - 2"); + END IF; + + GET (FT, X); + IF X /= 1.0 THEN + FAILED ("INCORRECT VALUE READ - 3"); + END IF; + + GET (ST1, X, LST); + IF X /= -3.0 THEN + FAILED ("MINUS SIGN NOT READ - 4"); + END IF; + + GET (ST2, X, LST); + IF X /= +2.0 THEN + FAILED ("PLUS SIGN NOT READ - 5"); + END IF; + + GET (ST3, X, LST); + IF X /= 1.0 THEN + FAILED ("INCORRECT VALUE READ - 6"); + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3804B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3804c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3804c.ada new file mode 100644 index 000000000..b2be751cc --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3804c.ada @@ -0,0 +1,121 @@ +-- CE3804C.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. +--* +-- HISTORY: +-- CHECK THAT GET FOR FLOAT_IO RAISES MODE_ERROR WHEN THE +-- MODE IS NOT IN_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 09/07/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/11/87 SPLIT CASE FOR FIXED_IO INTO CE3804O.ADA +-- AND CORRECTED EXCEPTION HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3804C IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3804C", "CHECK THAT GET FOR FLOAT_IO RAISES " & + "MODE_ERROR WHEN THE MODE IS NOT IN_FILE"); + + DECLARE + FT2 : FILE_TYPE; + BEGIN + + BEGIN + CREATE (FT2, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "FOR TEMP FILES WITH OUT_FILE " & + "MODE - 1"); + RAISE INCOMPLETE; + END; + + DECLARE + PACKAGE FL_IO IS NEW FLOAT_IO (FLOAT); + USE FL_IO; + X : FLOAT; + BEGIN + + BEGIN + GET (FT2, X); + FAILED ("MODE_ERROR NOT RAISED - FLOAT " & + "UN-NAMED FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "FLOAT UN-NAMED FILE"); + END; + + BEGIN + GET (STANDARD_OUTPUT, X); + FAILED ("MODE_ERROR NOT RAISED - FLOAT " & + "STANDARD_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "FLOAT STANDARD_OUTPUT"); + END; + + BEGIN + GET (CURRENT_OUTPUT, X); + FAILED ("MODE_ERROR NOT RAISED - FLOAT " & + "CURRENT_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "FLOAT CURRENT_OUTPUT"); + END; + + END; + + CLOSE (FT2); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3804C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3804d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3804d.ada new file mode 100644 index 000000000..5187f8ff7 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3804d.ada @@ -0,0 +1,153 @@ +-- CE3804D.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 FLOAT_IO GET RAISES DATA_ERROR WHEN THE DATA +-- READ IS OUT-OF-RANGE. CHECK THAT ITEM IS LEFT UNAFFECTED +-- AND THAT READING MAY CONTINUE AFTER THE EXCEPTION HAS +-- BEEN HANDLED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 09/07/82 +-- SPS 02/10/83 +-- JBG 08/30/83 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/11/87 REMOVED UNNECESSARY CODE AND CORRECTED +-- EXCEPTION HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3804D IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3804D", "FLOAT_IO GET RAISES DATA_ERROR FOR " & + "OUT-OF-RANGE DATA"); + + DECLARE + FT : FILE_TYPE; + BEGIN + +-- CREATE AND INITIALIZE TEST FILE + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, "1.25"); + NEW_LINE (FT); + PUT (FT, "-7.5"); + NEW_LINE (FT); + PUT (FT, "3.5"); + NEW_LINE (FT); + PUT (FT, "2.5"); + NEW_LINE (FT); + CLOSE (FT); + +-- BEGIN TEST + + DECLARE + TYPE FL IS NEW FLOAT RANGE 1.0 .. 3.0; + PACKAGE FL_IO IS NEW FLOAT_IO (FL); + X : FL; + USE FL_IO; + BEGIN + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FT, X); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 1.25 THEN + FAILED ("ITEM ALTERED WHEN DATA_ERROR " & + "IS RAISED - 1"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 1"); + END; + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 1.25 THEN + FAILED ("ITEM ALTERED WHEN DATA_ERROR " & + "IS RAISED - 2"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + + GET (FT, X); + IF X /= 2.5 THEN + FAILED ("READING NOT CONTINUED CORRECTLY " & + "AFTER DATA_ERROR"); + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3804D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3804e.ada b/gcc/testsuite/ada/acats/tests/ce/ce3804e.ada new file mode 100644 index 000000000..021baba2d --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3804e.ada @@ -0,0 +1,154 @@ +-- CE3804E.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 FIXED_IO GET RAISES DATA_ERROR WHEN THE DATA READ IS +-- OUT-OF-RANGE CHECK THAT ITEM IS LEFT UNAFFECTED AND THAT +-- READING MAY CONTINUE AFTER THE EXCEPTION HAS BEEN HANDLED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 09/07/82 +-- SPS 02/10/83 +-- JBG 08/30/83 +-- EG 11/02/84 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/11/87 REMOVED UNNECESSARY CODE AND CORRECTED +-- EXCEPTION HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3804E IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3804E", "FIXED_IO GET RAISES DATA_ERROR FOR " & + "OUT-OF-RANGE DATA"); + + DECLARE + FT : FILE_TYPE; + BEGIN + +-- CREATE AND INITIALIZE TEST FILE + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, "1.25"); + NEW_LINE (FT); + PUT (FT, "-7.5"); + NEW_LINE (FT); + PUT (FT, "3.5"); + NEW_LINE (FT); + PUT (FT, "2.5"); + NEW_LINE (FT); + CLOSE (FT); + +-- BEGIN TEST + + DECLARE + TYPE FX IS DELTA 0.001 RANGE 1.0 .. 3.0; + PACKAGE FX_IO IS NEW FIXED_IO (FX); + X : FX; + USE FX_IO; + BEGIN + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FT, X, 0); + + BEGIN + GET (FT, X, 0); + FAILED ("DATA_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 1.25 THEN + FAILED ("ITEM ALTERED WHEN DATA_ERROR " & + "IS RAISED - 1"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 1"); + END; + + BEGIN + GET (FT, X, 0); + FAILED ("DATA_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 1.25 THEN + FAILED ("ITEM ALTERED WHEN DATA_ERROR " & + "IS RAISED - 2"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + + GET (FT, X, 0); + IF X /= 2.5 THEN + FAILED ("READING NOT CONTINUED CORRECTLY " & + "AFTER DATA_ERROR"); + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3804E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3804f.ada b/gcc/testsuite/ada/acats/tests/ce/ce3804f.ada new file mode 100644 index 000000000..96a48d858 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3804f.ada @@ -0,0 +1,206 @@ +-- CE3804F.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 FLOAT_IO GET RAISES CONSTRAINT_ERROR WHEN THE VALUE +-- SUPPLIED BY WIDTH IS NEGATIVE, WIDTH IS GREATER THAN FIELD'LAST +-- WHEN FIELD'LAST IS LESS THAN INTEGER'LAST, OR THE VALUE READ IS +-- OUT OF RANGE OF THE ITEM PARAMETER, BUT WITHIN THE RANGE OF THE +-- SUBTYPE USED TO INSTANTIATE FLOAT_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 09/07/82 +-- JBG 08/30/83 +-- DWC 09/11/87 SPLIT CASE FOR FIXED_IO INTO CE3804P.ADA AND +-- CORRECTED EXCEPTION HANDLING. +-- JRL 06/07/96 Added call to Ident_Int in expressions involving +-- Field'Last, to make the expressions non-static and +-- prevent compile-time rejection. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3804F IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3804F", "CHECK THAT FLOAT_IO GET RAISES " & + "CONSTRAINT_ERROR WHEN THE VALUE SUPPLIED " & + "BY WIDTH IS NEGATIVE, WIDTH IS GREATER THAN " & + "FIELD'LAST WHEN FIELD'LAST IS LESS THAN " & + "INTEGER'LAST, OR THE VALUE READ IS OUT OF " & + "RANGE OF THE ITEM PARAMETER, BUT WITHIN THE " & + "RANGE OF THE SUBTYPE USED TO INSTANTIATE " & + "FLOAT_IO."); + + DECLARE + FT : FILE_TYPE; + TYPE FLT IS NEW FLOAT RANGE 1.0 .. 10.0; + PACKAGE FL_IO IS NEW FLOAT_IO (FLT); + USE FL_IO; + X : FLT RANGE 1.0 .. 5.0; + + BEGIN + BEGIN + GET (FT, X, IDENT_INT(-3)); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE " & + "WIDTH"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR FOR NEGATIVE WIDTH"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR NEGATIVE " & + "WIDTH"); + END; + + IF FIELD'LAST < INTEGER'LAST THEN + BEGIN + GET (X, FIELD'LAST + Ident_Int(1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - " & + "FIELD'LAST + 1 WIDTH - DEFAULT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "FIELD'LAST + 1 WIDTH - DEFAULT"); + END; + END IF; + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, "1.0"); + NEW_LINE (FT); + PUT (FT, "8.0"); + NEW_LINE (FT); + PUT (FT, "2.0"); + NEW_LINE (FT); + PUT (FT, "3.0"); + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & + "FOR IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FT, X); + IF X /= 1.0 THEN + FAILED ("WRONG VALUE READ WITH EXTERNAL FILE"); + END IF; + + BEGIN + GET (FT, X); + FAILED ("CONSTRAINT_ERROR NOT RAISED - " & + "VALUE OUT OF RANGE WITH EXTERNAL FILE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "VALUE OUT OF RANGE WITH EXTERNAL FILE"); + END; + + BEGIN + GET (FT, X, IDENT_INT(-1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - " & + "NEGATIVE WIDTH WITH EXTERNAL FILE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "NEGATIVE WIDTH WITH EXTERNAL FILE"); + END; + + SKIP_LINE (FT); + + IF FIELD'LAST < INTEGER'LAST THEN + BEGIN + GET (FT, X, FIELD'LAST + Ident_Int(1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - " & + "FIELD'LAST + 1 WIDTH WITH " & + "EXTERNAL FILE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "FIELD'LAST + 1 WIDTH WITH " & + "EXTERNAL FILE"); + END; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X, 3); + EXCEPTION + WHEN CONSTRAINT_ERROR => + FAILED ("CONSTRAINT_ERROR RAISED - " & + "OUT OF RANGE WITH EXTERNAL FILE"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "OUT OF RANGE WITH EXTERNAL FILE"); + END; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; +END CE3804F; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3804g.ada b/gcc/testsuite/ada/acats/tests/ce/ce3804g.ada new file mode 100644 index 000000000..e88e9dc2f --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3804g.ada @@ -0,0 +1,167 @@ +-- CE3804G.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 FLOAT_IO GET WHEN SUPPLIED WITH A WIDTH PARAMETER +-- GREATER THAN ZERO READS ONLY THAT MANY CHARACTERS. ALSO CHECK +-- THAT INPUT TERMINATES WHEN A LINE TERMINATOR IS ENCOUNTERED AND +-- THAT DATA_ERROR IS RAISED WHEN THE DATA IS INVALID. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 09/08/82 +-- SPS 12/14/82 +-- VKG 01/13/83 +-- SPS 02/08/83 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/14/87 SPLIT CASE FOR FIXED_IO INTO CE3804H.ADA AND +-- CORRECTED EXCEPTION HANDLING. +-- LDC 06/01/88 CHANGED TEST VALUE FROM "3.525" TO "3.625". + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3804G IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3804G", "CHECK THAT FLOAT_IO GET WHEN SUPPLIED WITH " & + "A WIDTH PARAMETER GREATER THAN ZERO READS " & + "ONLY THAT MANY CHARACTERS. ALSO CHECK THAT " & + "INPUT TERMINATES WHEN A LINE TERMINATOR IS " & + "ENCOUNTERED AND THAT DATA_ERROR IS RAISED " & + "WHEN THE DATA IS INVALID."); + + DECLARE + FT : FILE_TYPE; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT(FT, "3.259.5 8.52"); + NEW_LINE (FT); + PUT (FT, " "); + NEW_LINE (FT); + PUT (FT, ASCII.HT & "9.0"); + NEW_LINE (FT); + PUT (FT, "-3.625"); + NEW_LINE (FT); + CLOSE (FT); + +-- BEGIN TEST + + DECLARE + TYPE FL IS DIGITS 4; + PACKAGE FL_IO IS NEW FLOAT_IO (FL); + USE FL_IO; + X : FL; + BEGIN + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT" & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FT, X, 4); + IF X /= 3.25 THEN + FAILED ("WIDTH CHARACTERS NOT READ - FLOAT"); + ELSE + GET (FT, X, 3); + IF X /= 9.5 THEN + FAILED ("WIDTH CHARACTERS NOT READ - " & + "FLOAT 2"); + ELSE + GET (FT, X, 4); + IF X /= 8.5 THEN + FAILED ("DIDN'T COUNT LEADING BLANKS " & + "- FLOAT"); + ELSE + SKIP_LINE(FT); + BEGIN + GET (FT, X, 2); + FAILED ("DATA_ERROR NOT RAISED - " & + "FLOAT"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED" + & " - FLOAT"); + END; + SKIP_LINE(FT); + GET (FT, X, 4); + IF X /= 9.0 THEN + FAILED ("GET WITH WIDTH " & + "INCORRECT - 3"); + END IF; + + SKIP_LINE (FT); + GET (FT, X, 7); + IF X /= -3.625 THEN + FAILED ("WIDTH CHARACTERS NOT " & + "READ - FLOAT 3"); + END IF; + END IF; + END IF; + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3804G; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3804h.ada b/gcc/testsuite/ada/acats/tests/ce/ce3804h.ada new file mode 100644 index 000000000..6f7d87cb2 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3804h.ada @@ -0,0 +1,161 @@ +-- CE3804H.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 FIXED_IO GET WHEN SUPPLIED WITH A WIDTH PARAMETER +-- GREATER THAN ZERO READS ONLY THAT MANY CHARACTERS. ALSO CHECK +-- THAT INPUT TERMINATES WHEN A LINE TERMINATOR IS ENCOUNTERED AND +-- THAT DATA_ERROR IS RAISED WHEN THE DATA IS INVALID. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- DWC 09/14/87 CREATED ORIGINAL TEST. +-- RJW 08/17/89 CHANGED THE VALUE '-3.525' TO '-3.625'. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3804H IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3804H", "CHECK THAT FIXED_IO GET WHEN SUPPLIED WITH " & + "A WIDTH PARAMETER GREATER THAN ZERO READS " & + "ONLY THAT MANY CHARACTERS. ALSO CHECK THAT " & + "INPUT TERMINATES WHEN A LINE TERMINATOR IS " & + "ENCOUNTERED AND THAT DATA_ERROR IS RAISED " & + "WHEN THE DATA IS INVALID"); + + DECLARE + FT : FILE_TYPE; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT(FT, "3.259.5 8.52"); + NEW_LINE (FT); + PUT (FT, " "); + NEW_LINE (FT); + PUT (FT, ASCII.HT & "9.0"); + NEW_LINE (FT); + PUT (FT, "-3.625"); + NEW_LINE (FT); + + CLOSE (FT); + +-- BEGIN TEST + + DECLARE + TYPE FIXED IS DELTA 0.001 RANGE -100.0 .. 100.0; + PACKAGE FX_IO IS NEW FIXED_IO (FIXED); + USE FX_IO; + X : FIXED; + + BEGIN + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT" & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FT, X, 4); + IF X /= 3.25 THEN + FAILED ("WIDTH CHARACTERS NOT READ - FIXED - 1"); + ELSE + GET (FT, X, 3); + IF X /= 9.5 THEN + FAILED ("WIDTH CHARACTERS NOT READ - " & + "FIXED 2"); + ELSE + GET (FT, X, 4); + IF X /= 8.5 THEN + FAILED ("DIDN'T COUNT LEADING BLANKS " & + "- FIXED"); + ELSE + SKIP_LINE(FT); + BEGIN + GET (FT, X, 2); + FAILED ("DATA_ERROR NOT RAISED - " & + "FIXED"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED" + & " - FIXED"); + END; + + SKIP_LINE(FT); + GET (FT, X, 4); + IF X /= 9.0 THEN + FAILED ("GET WITH WIDTH " & + "INCORRECT"); + END IF; + + SKIP_LINE (FT); + GET (FT, X, 7); + IF X /= -3.625 THEN + FAILED ("WIDTH CHARACTERS NOT " & + "READ"); + END IF; + END IF; + END IF; + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3804H; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3804i.ada b/gcc/testsuite/ada/acats/tests/ce/ce3804i.ada new file mode 100644 index 000000000..19e292fd3 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3804i.ada @@ -0,0 +1,141 @@ +-- CE3804I.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 FLOAT_IO GET OPERATES ON IN_FILE FILE AND WHEN +-- NO FILE IS SPECIFIED THE CURRENT DEFAULT INPUT FILE IS USED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 10/06/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/14/87 SPLIT CASE FOR FIXED_IO INTO CE3804J.ADA AND +-- CORRECTED EXCEPTION HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3804I IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3804I", "CHECK THAT FLOAT_IO GET OPERATES ON " & + "IN_FILE FILE AND WHEN NO FILE IS " & + "SPECIFIED THE CURRENT DEFAULT INPUT " & + "FILE IS USED."); + + DECLARE + FT1, FT2 : FILE_TYPE; + BEGIN + +-- CREATE AND INITIALIZE FILES + + BEGIN + CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "CREATE WITH OUT_FILE MODE - 1"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT " & + "CREATE WITH OUT_FILE MODE - 1"); + RAISE INCOMPLETE; + END; + + CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2)); + + PUT (FT1, "1.0"); + NEW_LINE (FT1); + + CLOSE (FT1); + + BEGIN + OPEN (FT1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & + "FOR IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT2, "2.0"); + NEW_LINE (FT2); + + CLOSE (FT2); + OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2)); + + SET_INPUT (FT2); + + DECLARE + TYPE FL IS NEW FLOAT; + PACKAGE FLIO IS NEW FLOAT_IO (FL); + USE FLIO; + X : FL; + BEGIN + BEGIN + GET (FT1, X); + IF X /= 1.0 THEN + FAILED ("FLOAT FILE VALUE INCORRECT"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED - FILE FLOAT"); + END; + + BEGIN + GET (X); + IF X /= 2.0 THEN + FAILED ("FLOAT DEFAULT VALUE INCORRECT"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED - DEFAULT FLOAT"); + END; + END; + + BEGIN + DELETE (FT1); + DELETE (FT2); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3804I; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3804j.ada b/gcc/testsuite/ada/acats/tests/ce/ce3804j.ada new file mode 100644 index 000000000..a7d4c841a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3804j.ada @@ -0,0 +1,137 @@ +-- CE3804J.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 FIXED_IO GET OPERATES ON IN_FILE FILE AND WHEN +-- NO FILE IS SPECIFIED THE CURRENT DEFAULT INPUT FILE IS USED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- DWC 09/14/87 CREATED ORIGINAL TEST. +-- JRL 02/28/96 Changed upper bound of type FX from 1000.0 to 250.0. +-- Corrected TEST string. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3804J IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3804J", "CHECK THAT FIXED_IO GET OPERATES ON " & + "IN_FILE FILE AND WHEN NO FILE IS " & + "SPECIFIED THE CURRENT DEFAULT INPUT " & + "FILE IS USED"); + + DECLARE + FT1, FT2 : FILE_TYPE; + BEGIN + +-- CREATE AND INITIALIZE FILES + + BEGIN + CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "CREATE WITH OUT_FILE MODE - 1"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT " & + "CREATE WITH OUT_FILE MODE - 1"); + RAISE INCOMPLETE; + END; + + CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2)); + + PUT (FT1, "1.0"); + NEW_LINE (FT1); + + CLOSE (FT1); + + BEGIN + OPEN (FT1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & + "FOR IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT2, "2.0"); + NEW_LINE (FT2); + + CLOSE (FT2); + OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2)); + + SET_INPUT (FT2); + + DECLARE + TYPE FX IS DELTA 0.0001 RANGE 1.0 .. 250.0; + PACKAGE FXIO IS NEW FIXED_IO (FX); + USE FXIO; + X : FX; + BEGIN + BEGIN + GET (FT1, X); + IF X /= 1.0 THEN + FAILED ("FIXED FILE VALUE INCORRECT"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED - FILE FIXED"); + END; + + BEGIN + GET (X); + IF X /= 2.0 THEN + FAILED ("FIXED DEFAULT VALUE INCORRECT"); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED - DEFAULT FIXED"); + END; + END; + + BEGIN + DELETE (FT1); + DELETE (FT2); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3804J; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3804m.ada b/gcc/testsuite/ada/acats/tests/ce/ce3804m.ada new file mode 100644 index 000000000..d71d2fccc --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3804m.ada @@ -0,0 +1,157 @@ +-- CE3804M.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 GET WILL RAISE DATA_ERROR IF THE USE OF # AND : +-- IN BASED LITERALS IS MIXED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- VKG 02/07/83 +-- JBG 03/30/84 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/14/87 SPLIT CASE FOR FIXED_IO INTO CE3804N.ADA AND +-- CORRECTED EXCEPTION HANDLING. + +WITH TEXT_IO; USE TEXT_IO; +WITH REPORT; USE REPORT; + +PROCEDURE CE3804M IS + + INCOMPLETE : EXCEPTION; + +BEGIN + TEST ("CE3804M", "CHECK THAT FLOAT_IO GET WILL RAISE " & + "DATA_ERROR IF THE USE OF # AND : IN " & + "BASED LITERALS IS MIXED"); + + DECLARE + FT : FILE_TYPE; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + + PUT_LINE (FT, "2#1.1#E+2"); -- 2#1.1#E+2 + PUT_LINE (FT, "8:1.1:E-2"); -- 8:1.1:E-2 + PUT (FT, "2#1.1:E+1"); -- 2#1.1:E+1 + NEW_LINE (FT); + PUT (FT, "4:2.23#E+2"); -- 4:2.23#E+2 + NEW_LINE (FT); + PUT (FT, "2#1.0#E+1"); -- 2#1.0#E+1 + NEW_LINE (FT); + CLOSE (FT); + + DECLARE + PACKAGE FL_IO IS NEW FLOAT_IO(FLOAT); + USE FL_IO; + X : FLOAT := 1.00E+10; + BEGIN + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FT, X); + IF X /= 2#1.1#E+2 THEN + FAILED ("DID NOT GET RIGHT VALUE - 1"); + END IF; + + GET (FT, X); + IF X /= 8#1.1#E-2 THEN + FAILED ("DID NOT GET RIGHT VALUE - 2"); + END IF; + + BEGIN + X := 1.0E+10; + GET (FT,X); + FAILED ("DATA_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 1.00E+10 THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - 1"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 1"); + END; + + SKIP_LINE (FT); + + BEGIN + GET (FT,X); + FAILED ("DATA_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= 1.00E+10 THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - 2"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + + SKIP_LINE (FT); + + GET (FT, X); + IF X /= 2#1.0#E+1 THEN + FAILED ("DID NOT GET RIGHT VALUE - 3"); + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3804M; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3804o.ada b/gcc/testsuite/ada/acats/tests/ce/ce3804o.ada new file mode 100644 index 000000000..a08e2c972 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3804o.ada @@ -0,0 +1,121 @@ +-- CE3804O.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. +--* +-- HISTORY: +-- CHECK THAT GET FOR FIXED_IO RAISES MODE_ERROR WHEN THE +-- MODE IS NOT IN_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- DWC 09/14/87 CREATED ORIGINAL TEST. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3804O IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3804O", "CHECK THAT GET FOR FIXED_IO RAISES " & + "MODE_ERROR WHEN THE MODE IS NOT IN_FILE"); + + DECLARE + FT: FILE_TYPE; + BEGIN + BEGIN + CREATE (FT, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "CREATE FOR TEMP FILES " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + DECLARE + TYPE FIXED IS DELTA 0.25 RANGE 1.0 .. 3.0; + PACKAGE FX_IO IS NEW FIXED_IO (FIXED); + USE FX_IO; + X : FIXED; + BEGIN + + BEGIN + GET (FT, X); + FAILED ("MODE_ERROR NOT RAISED - FIXED " & + "UN-NAMED FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "FIXED UN-NAMED FILE"); + END; + + BEGIN + GET (STANDARD_OUTPUT, X); + FAILED ("MODE_ERROR NOT RAISED - FIXED " & + "STANDARD_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "FIXED STANDARD_OUTPUT"); + END; + + BEGIN + GET (CURRENT_OUTPUT, X); + FAILED ("MODE_ERROR NOT RAISED - FIXED " & + "CURRENT_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "FIXED CURRENT_OUTPUT"); + END; + + END; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3804O; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3804p.ada b/gcc/testsuite/ada/acats/tests/ce/ce3804p.ada new file mode 100644 index 000000000..d4afd2a49 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3804p.ada @@ -0,0 +1,206 @@ +-- CE3804P.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 FIXED_IO GET RAISES CONSTRAINT_ERROR WHEN THE VALUE +-- SUPPLIED BY WIDTH IS NEGATIVE, WIDTH IS GREATER THAN FIELD'LAST +-- WHEN FIELD'LAST IS LESS THAN INTEGER'LAST, OR THE VALUE READ IS +-- OUT OF RANGE OF THE ITEM PARAMETER, BUT WITHIN THE RANGE OF THE +-- SUBTYPE USED TO INSTANTIATE FIXED_IO. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- DWC 09/15/87 CREATED ORIGINAL TEST. +-- JRL 06/07/96 Added call to Ident_Int in expressions involving +-- Field'Last, to make the expressions non-static and +-- prevent compile-time rejection. Corrected typo. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3804P IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3804P", "CHECK THAT FLOAT_IO GET RAISES " & + "CONSTRAINT_ERROR WHEN THE VALUE SUPPLIED " & + "BY WIDTH IS NEGATIVE, WIDTH IS GREATER THAN " & + "FIELD'LAST WHEN FIELD'LAST IS LESS THAN " & + "INTEGER'LAST, OR THE VALUE READ IS OUT OF " & + "RANGE OF THE ITEM PARAMETER, BUT WITHIN THE " & + "RANGE OF THE SUBTYPE USED TO INSTANTIATE " & + "FLOAT_IO."); + + DECLARE + TYPE FIXED IS DELTA 0.25 RANGE 0.0 .. 10.0; + FT : FILE_TYPE; + PACKAGE FX_IO IS NEW FIXED_IO (FIXED); + USE FX_IO; + X : FIXED RANGE 0.0 .. 5.0; + + BEGIN + BEGIN + GET (FT, X, IDENT_INT(-3)); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE " & + "WIDTH"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR FOR NEGATIVE WIDTH"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR NEGATIVE " & + "WIDTH"); + END; + + IF FIELD'LAST < INTEGER'LAST THEN + BEGIN + GET (X, FIELD'LAST + Ident_Int(1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - " & + "FIELD'LAST + 1 WIDTH - DEFAULT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "FIELD'LAST + 1 WIDTH - DEFAULT"); + END; + END IF; + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, "1.0"); + NEW_LINE (FT); + PUT (FT, "8.0"); + NEW_LINE (FT); + PUT (FT, "2.0"); + NEW_LINE (FT); + PUT (FT, "3.0"); + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FT, X); + IF X /= 1.0 THEN + FAILED ("WRONG VALUE READ WITH EXTERNAL FILE"); + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X, 3); + FAILED ("CONSTRAINT_ERROR NOT RAISED - " & + "OUT OF RANGE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "OUT OF RANGE"); + END; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X, IDENT_INT(-1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - " & + "NEGATIVE WIDTH WITH EXTERNAL FILE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "NEGATIVE WIDTH WITH EXTERNAL FILE"); + END; + + IF FIELD'LAST < INTEGER'LAST THEN + BEGIN + GET (FT, X, FIELD'LAST + Ident_Int(1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - " & + "FIELD'LAST + 1 WIDTH WITH " & + "EXTERNAL FILE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - " & + "FIELD'LAST + 1 WIDTH WITH " & + "EXTERNAL FILE"); + END; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X, 3); + EXCEPTION + WHEN CONSTRAINT_ERROR => + FAILED ("CONSTRAINT_ERROR RAISED; VALID WIDTH " & + "WITH EXTERNAL FILE"); + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED; VALID WIDTH " & + "WITH EXTERNAL FILE"); + END; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3804P; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3805a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3805a.ada new file mode 100644 index 000000000..74c8aff09 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3805a.ada @@ -0,0 +1,162 @@ +-- CE3805A.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 FLOAT_IO GET MAY READ THE LAST CHARACTER IN THE FILE +-- WITHOUT RAISNG END_ERROR AND THAT SUBSEQUENT READING WILL RAISE +-- END_ERROR. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATAIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 09/08/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/15/87 REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION +-- HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3805A IS + +BEGIN + + TEST ("CE3805A", "CHECK THAT FLOAT_IO GET MAY READ THE LAST " & + "CHARACTER IN THE FILE WITHOUT RAISING " & + "END_ERROR AND THAT SUBSEQUENT READING WILL " & + "RAISE END_ERROR"); + + DECLARE + FT1, FT2 : FILE_TYPE; + PACKAGE FL_IO IS NEW FLOAT_IO (FLOAT); + X : FLOAT; + USE FL_IO; + INCOMPLETE : EXCEPTION; + + BEGIN + +-- CREATE AND INITIALIZE TEST FILES + + BEGIN + CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2)); + + PUT (FT1, "2.25"); + CLOSE (FT1); + + PUT (FT2, "2.50"); + NEW_LINE (FT2, 3); + NEW_PAGE (FT2); + NEW_LINE (FT2, 3); + CLOSE (FT2); + +-- BEGIN TEST + + BEGIN + OPEN (FT1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2)); + + BEGIN + GET (FT1, X); + IF X /= 2.25 THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + BEGIN + GET (FT1, X); + FAILED ("END_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 1"); + END; + EXCEPTION + WHEN END_ERROR => + FAILED ("END_ERROR RAISED PREMATURELY - 1"); + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED - 1"); + END; + + BEGIN + GET (FT2, X); + IF X /= 2.50 THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + BEGIN + GET (FT2, X); + FAILED ("END_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + EXCEPTION + WHEN END_ERROR => + FAILED ("END_ERROR RAISED PREMATURELY - 2"); + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED - 2"); + END; + + BEGIN + DELETE (FT1); + DELETE (FT2); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3805A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3805b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3805b.ada new file mode 100644 index 000000000..80919630e --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3805b.ada @@ -0,0 +1,163 @@ +-- CE3805B.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 FIXED_IO GET MAY READ THE LAST CHARACTER IN THE FILE +-- WITHOUT RAISING END_ERROR AND THAT SUBSEQUENT READING WILL RAISE +-- END_ERROR. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 09/08/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/15/87 REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION +-- HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3805B IS + +BEGIN + + TEST ("CE3805B", "CHECK THAT FIXED_IO GET MAY READ THE LAST "& + "CHARACTER IN THE FILE WITHOUT RAISING " & + "END_ERROR AND THAT SUBSEQUENT READING WILL " & + "RAISE END_ERROR"); + + DECLARE + FT1, FT2 : FILE_TYPE; + TYPE FIXED IS DELTA 0.02 RANGE 0.0 .. 50.0; + PACKAGE FX_IO IS NEW FIXED_IO (FIXED); + X : FIXED; + USE FX_IO; + INCOMPLETE : EXCEPTION; + + BEGIN + +-- CREATE AND INITIALIZE TEST FILES + + BEGIN + CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2)); + + PUT (FT1, "2.25"); + CLOSE (FT1); + + PUT (FT2, "2.50"); + NEW_LINE (FT2, 3); + NEW_PAGE (FT2); + NEW_LINE (FT2, 3); + CLOSE (FT2); + +-- BEGIN TEST + + BEGIN + OPEN (FT1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "FOR IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2)); + + BEGIN + GET (FT1, X); + IF X /= 2.25 THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + BEGIN + GET (FT1, X); + FAILED ("END_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 1"); + END; + EXCEPTION + WHEN END_ERROR => + FAILED ("END_ERROR RAISED PREMATURELY - 1"); + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED - 1"); + END; + + BEGIN + GET (FT2, X); + IF X /= 2.50 THEN + FAILED ("INCORRECT VALUE READ"); + END IF; + BEGIN + GET (FT2, X); + FAILED ("END_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + EXCEPTION + WHEN END_ERROR => + FAILED ("END_ERROR RAISED PREMATURELY - 2"); + WHEN OTHERS => + FAILED ("UNEXPECTED ERROR RAISED - 2"); + END; + + BEGIN + DELETE (FT1); + DELETE (FT2); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3805B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3806a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3806a.ada new file mode 100644 index 000000000..09762f319 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3806a.ada @@ -0,0 +1,132 @@ +-- CE3806A.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 PUT FOR FLOAT_IO RAISES MODE_ERROR FOR FILES OF +-- MODE IN_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 09/10/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/11/87 REMOVED DEPENDENCE ON RESET AND CORRECTED +-- EXCEPTION HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3806A IS + +BEGIN + + TEST ("CE3806A", "CHECK THAT PUT FOR FLOAT_IO RAISES MODE_ERROR " & + "FOR FILES OF MODE IN_FILE"); + + DECLARE + FT1 : FILE_TYPE; + PACKAGE FL_IO IS NEW FLOAT_IO (FLOAT); + USE FL_IO; + INCOMPLETE : EXCEPTION; + X : FLOAT := -34.267/19.2; + + BEGIN + + BEGIN + CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT1, 'A'); + CLOSE (FT1); + + BEGIN + OPEN (FT1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + PUT (FT1, X); + FAILED ("MODE_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 1"); + END; + + BEGIN + PUT (STANDARD_INPUT, X); + FAILED ("MODE_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + + BEGIN + PUT (CURRENT_INPUT, X); + FAILED ("MODE_ERROR NOT RAISED - 3"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 3"); + END; + + BEGIN + DELETE (FT1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3806A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3806b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3806b.ada new file mode 100644 index 000000000..194f1a971 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3806b.ada @@ -0,0 +1,124 @@ +-- CE3806B.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 PUT FOR FIXED_IO RAISES MODE_ERROR FOR FILES OF +-- MODE IN_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JLH 09/11/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3806B IS + +BEGIN + TEST ("CE3806B", "CHECK THAT PUT FOR FIXED_IO RAISES MODE_ERROR " & + "FOR FILES OF MODE IN_FILE"); + + DECLARE + FT1 : FILE_TYPE; + TYPE FIXED IS DELTA 0.01 RANGE 0.0 .. 1.0; + PACKAGE FX_IO IS NEW FIXED_IO (FIXED); + USE FX_IO; + INCOMPLETE : EXCEPTION; + X : FIXED := 0.2; + + BEGIN + + BEGIN + CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT1, 'A'); + CLOSE (FT1); + + BEGIN + OPEN (FT1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + PUT (FT1, X); + FAILED ("MODE_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 1"); + END; + + BEGIN + PUT (STANDARD_INPUT, X); + FAILED ("MODE_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + + BEGIN + PUT (CURRENT_INPUT, X); + FAILED ("MODE_ERROR NOT RAISED - 3"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 3"); + END; + + BEGIN + DELETE (FT1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3806B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3806c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3806c.ada new file mode 100644 index 000000000..6a7a79338 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3806c.ada @@ -0,0 +1,197 @@ +-- CE3806C.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 PUT FOR FLOAT_IO RAISES CONSTRAINT_ERROR WHEN THE +-- VALUES SUPPLIED BY FORE, AFT, OR EXP ARE NEGATIVE OR GREATER +-- THAN FIELD'LAST WHEN FIELD'LAST < FIELD'BASE'LAST. ALSO CHECK +-- THAT PUT FOR FLOAT_IO RAISES CONSTRAINT_ERROR WHEN THE VALUE OF +-- ITEM IS OUTSIDE THE RANGE OF THE TYPE USED TO INSTANTIATE +-- FLOAT_IO. + +-- HISTORY: +-- SPS 09/10/82 +-- JBG 08/30/83 +-- JLH 09/14/87 ADDED CASES FOR COMPLETE OBJECTIVE. +-- KAS 11/24/95 DELETED DIGITS CONSTRAINT FROM SUBTYPE +-- CHANGED STATIC EXPRESSIONS INVOLVING 'LAST + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3806C IS + + FIELD_LAST : TEXT_IO.FIELD := TEXT_IO.FIELD'LAST; + +BEGIN + + TEST ("CE3806C", "CHECK THAT PUT FOR FLOAT_IO RAISES " & + "CONSTRAINT_ERROR APPROPRIATELY"); + + DECLARE + TYPE FLOAT IS DIGITS 5 RANGE 0.0 .. 2.0; + SUBTYPE MY_FLOAT IS FLOAT RANGE 0.0 .. 1.0; + PACKAGE NFL_IO IS NEW FLOAT_IO (MY_FLOAT); + USE NFL_IO; + FT : FILE_TYPE; + Y : FLOAT := 1.8; + X : MY_FLOAT := 26.3 / 26.792; + + BEGIN + BEGIN + PUT (FT, X, FORE => IDENT_INT(-6)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE FORE " & + "FLOAT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 1"); + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 1"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - NEGATIVE FORE " & + "FLOAT"); + END; + + BEGIN + PUT (FT, X, AFT => IDENT_INT(-2)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE AFT " & + "FLOAT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 2"); + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 2"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - NEGATIVE AFT " & + "FLOAT"); + END; + + BEGIN + PUT (FT, X, EXP => IDENT_INT(-1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE EXP " & + "FLOAT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 3"); + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 3"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - NEGATIVE EXP " & + "FLOAT"); + END; + + IF FIELD_LAST < FIELD'BASE'LAST THEN + + BEGIN + PUT (FT, X, FORE => IDENT_INT(FIELD_LAST+1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - FORE FLOAT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 4"); + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 4"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FORE FLOAT"); + END; + + BEGIN + PUT (FT, X, AFT => IDENT_INT(FIELD_LAST+1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - AFT FLOAT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 5"); + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 5"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - AFT FLOAT"); + END; + + BEGIN + PUT (FT, X, EXP => IDENT_INT(FIELD_LAST+1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - EXP FLOAT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 6"); + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 6"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - EXP FLOAT"); + END; + END IF; + + BEGIN + PUT (FT, Y); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " & + "RANGE - FILE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " & + "RANGE - FILE"); + END; + + BEGIN + PUT (Y); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " & + "RANGE - DEFAULT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " & + "RANGE - DEFAULT"); + END; + + END; + + RESULT; + +END CE3806C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3806d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3806d.ada new file mode 100644 index 000000000..6189ef14f --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3806d.ada @@ -0,0 +1,129 @@ +-- CE3806D.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 FLOAT_IO PUT OPERATES ON FILES OF MODE OUT_FILE AND +-- IF NO FILE IS SPECIFIED THE CURRENT DEFAULT OUTPUT FILE IS USED. + +--- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 10/06/82 +-- VKG 02/15/83 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/14/87 REMOVED DEPENDENCE ON RESET AND CORRECT EXCEPTION +-- HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3806D IS + +BEGIN + + TEST ("CE3806D", "CHECK THAT FLOAT_IO OPERATES ON FILES OF MODE " & + "OUT_FILE AND IF NO FILE IS SPECIFIED THE " & + "CURRENT DEFAULT OUTPUT FILE IS USED"); + + DECLARE + FT1, FT2 : FILE_TYPE; + TYPE FL IS DIGITS 3; + PACKAGE FLIO IS NEW FLOAT_IO (FL); + USE FLIO; + INCOMPLETE : EXCEPTION; + X : FL := -1.5; + + BEGIN + + BEGIN + CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2)); + + SET_OUTPUT (FT2); + + BEGIN + PUT (FT1, X); + PUT (X + 1.0); + CLOSE (FT1); + + BEGIN + OPEN (FT1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + SET_OUTPUT (STANDARD_OUTPUT); + + CLOSE (FT2); + OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2)); + + X := 0.0; + GET (FT1, X); + IF X /= -1.5 THEN + FAILED ("VALUE INCORRECT - FLOAT FROM FILE"); + END IF; + X := 0.0; + GET (FT2, X); + IF X /= -0.5 THEN + FAILED (" VVALUE INCORRECT - FLOAT FROM DEFAULT"); + END IF; + END; + + BEGIN + DELETE (FT1); + DELETE (FT2); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3806D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3806e.ada b/gcc/testsuite/ada/acats/tests/ce/ce3806e.ada new file mode 100644 index 000000000..4865020f7 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3806e.ada @@ -0,0 +1,159 @@ +-- CE3806E.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 FLOAT_IO PUT RAISE LAYOUT_ERROR WHEN THE NUMBER +-- OF CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE LENGTH. +-- CHECK THAT IT IS NOT RAISED, BUT RATHER NEW_LINE IS CALLED, +-- WHEN THE NUMBER DOES NOT EXCEED THE MAX, BUT WHEN ADDED TO +-- THE CURRENT COLUMN NUMBER, THE TOTAL EXCEEDS THE MAX. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 10/07/82 +-- SPS 12/14/82 +-- VKG 01/13/83 +-- SPS 02/18/83 +-- JBG 08/30/83 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- JLH 09/14/87 REMOVED DEPENDENCE ON RESET AND CORRECTED +-- EXCEPTION HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; +WITH CHECK_FILE; + +PROCEDURE CE3806E IS + +BEGIN + + TEST ("CE3806E", "CHECK THAT FLOAT_IO PUT RAISES " & + "LAYOUT_ERROR CORRECTLY"); + + DECLARE + TYPE FL IS DIGITS 3 RANGE 100.0 .. 200.0; + PACKAGE FLIO IS NEW FLOAT_IO (FL); + USE FLIO; + X : FL := 126.0; + Y : FL := 134.0; + Z : FL := 120.0; + INCOMPLETE : EXCEPTION; + FT : FILE_TYPE; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + SET_LINE_LENGTH (FT, 8); + + BEGIN + PUT (FT, X); -- " 1.26E+02" + FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FLOAT"); + + END; + + BEGIN + PUT (FT, Y, FORE => 1); -- "1.34E+02" + EXCEPTION + WHEN LAYOUT_ERROR => + FAILED ("LAYOUT_ERROR RAISED SECOND PUT " & + "- FLOAT"); + WHEN OTHERS => + FAILED ("EXCEPTION RAISED SECOND PUT - FLOAT"); + END; + + BEGIN + PUT (FT,Z, FORE => 1, AFT => 0); -- "1.2E+02" + IF LINE (FT) /= 2 THEN + FAILED ("NEW_LINE NOT CALLED - FLOAT"); + END IF; + EXCEPTION + WHEN LAYOUT_ERROR => + FAILED ("LAYOUT_ERROR RAISED THIRD " & + "PUT - FLOAT"); + WHEN OTHERS => + FAILED ("EXCEPTION RAISED THIRD PUT - FLOAT"); + END; + + SET_LINE_LENGTH ( FT,7); + + BEGIN + PUT (FT, "X"); + PUT (FT, Y, FORE => 1, AFT => 2, + EXP => 1); -- 1.34E+2 + EXCEPTION + WHEN LAYOUT_ERROR => + FAILED ("LAYOUT_ERROR RAISED - 3 FLOAT"); + END; + + BEGIN + PUT (FT, "Z"); + PUT (FT, Z, FORE => 1); + FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT 2"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("SOME EXCEPTION RAISED - 3 FLOAT"); + END; + + CHECK_FILE (FT, "1.34E+02#1.2E+02#X#1.34E+2#Z#@%"); + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3806E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3806f.ada b/gcc/testsuite/ada/acats/tests/ce/ce3806f.ada new file mode 100644 index 000000000..e013bbb5e --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3806f.ada @@ -0,0 +1,194 @@ +-- CE3806F.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 PUT FOR FIXED_IO RAISES CONSTRAINT_ERROR WHEN THE +-- VALUES SUPPLIED BY FORE, AFT, OR EXP ARE NEGATIVE OR GREATER +-- THAN FIELD'LAST WHEN FIELD'LAST < FIELD'BASE'LAST. ALSO CHECK +-- THAT PUT FOR FIXED_IO RAISES CONSTRAINT_ERROR WHEN THE VALUE +-- OF ITEM IS OUTSIDE THE RANGE OF THE TYPE USED TO INSTANTIATE +-- FIXED_IO. + +-- HISTORY: +-- JLH 09/15/87 CREATED ORIGINAL TEST. +-- JRL 06/07/96 Added call to Ident_Int in expressions involving +-- Field'Last, to make the expressions non-static and +-- prevent compile-time rejection. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3806F IS + +BEGIN + + TEST ("CE3806F", "CHECK THAT PUT FOR FIXED_IO RAISES " & + "CONSTRAINT_ERROR APPROPRIATELY"); + + DECLARE + TYPE FIXED IS DELTA 0.01 RANGE 1.0 .. 2.0; + SUBTYPE MY_FIXED IS FIXED DELTA 0.01 RANGE 1.0 .. 1.5; + PACKAGE NFX_IO IS NEW FIXED_IO (MY_FIXED); + USE NFX_IO; + FT : FILE_TYPE; + Y : FIXED := 1.8; + X : MY_FIXED := 1.3; + + BEGIN + + BEGIN + PUT (FT, X, FORE => IDENT_INT(-6)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE FORE " & + "FIXED"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 1"); + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 1"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - NEGATIVE FORE " & + "FIXED"); + END; + + BEGIN + PUT (FT, X, AFT => IDENT_INT(-2)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE AFT " & + "FIXED"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 2"); + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 2"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - NEGATIVE AFT " & + "FIXED"); + END; + + BEGIN + PUT (FT, X, EXP => IDENT_INT(-1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE EXP " & + "FIXED"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 3"); + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 3"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - NEGATIVE EXP " & + "FIXED"); + END; + + IF FIELD'LAST < FIELD'BASE'LAST THEN + + BEGIN + PUT (FT, X, FORE => IDENT_INT(FIELD'LAST+Ident_Int(1))); + FAILED ("CONSTRAINT_ERROR NOT RAISED - FORE FIXED"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 4"); + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 4"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FORE FIXED"); + END; + + BEGIN + PUT (FT, X, AFT => IDENT_INT(FIELD'LAST+Ident_Int(1))); + FAILED ("CONSTRAINT_ERROR NOT RAISED - AFT FIXED"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 5"); + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 5"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - AFT FIXED"); + END; + + BEGIN + PUT (FT, X, EXP => IDENT_INT(FIELD'LAST+Ident_Int(1))); + FAILED ("CONSTRAINT_ERROR NOT RAISED - EXP FIXED"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("STATUS_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 6"); + WHEN USE_ERROR => + FAILED ("USE_ERROR RAISED INSTEAD OF " & + "CONSTRAINT_ERROR - 6"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - EXP FIXED"); + END; + + END IF; + + BEGIN + PUT (FT, Y); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " & + "RANGE - FILE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " & + "RANGE - FILE"); + END; + + BEGIN + PUT (Y); + FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " & + "RANGE - DEFAULT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " & + "RANGE - DEFAULT"); + END; + + END; + + RESULT; + +END CE3806F; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3806g.ada b/gcc/testsuite/ada/acats/tests/ce/ce3806g.ada new file mode 100644 index 000000000..edfcf6a4b --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3806g.ada @@ -0,0 +1,125 @@ +-- CE3806G.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 FIXED_IO PUT OPERATES ON FILES OF MODE OUT_FILE AND +-- IF NO FILE IS SPECIFIED THE CURRENT DEFAULT OUTPUT FILE IS USED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JLH 09/13/87 CREATED ORIGINAL TEST. +-- BCB 10/03/90 ADDED THE STATEMENT "RAISE INCOMPLETE;" TO +-- NAME_ERROR EXCEPTION HANDLER. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3806G IS + +BEGIN + + TEST ("CE3806G", "CHECK THAT FIXED_IO PUT OPERATES ON FILES " & + "OF MODE OUT_FILE AND IF NO FILE IS SPECIFIED " & + "THE CURRENT DEFAULT OUTPUT FILE IS USED"); + + DECLARE + FT1, FT2 : FILE_TYPE; + TYPE FX IS DELTA 0.5 RANGE -10.0 .. 10.0; + PACKAGE FXIO IS NEW FIXED_IO (FX); + USE FXIO; + INCOMPLETE : EXCEPTION; + X : FX := -1.5; + + BEGIN + + BEGIN + CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2)); + + SET_OUTPUT (FT2); + + BEGIN + PUT (FT1, X); + PUT (X + 1.0); + + CLOSE (FT1); + + BEGIN + OPEN (FT1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + SET_OUTPUT (STANDARD_OUTPUT); + + CLOSE (FT2); + + OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2)); + + X := 0.0; + GET (FT1, X); + IF X /= -1.5 THEN + FAILED ("VALUE INCORRECT - FIXED FROM FILE"); + END IF; + X := 0.0; + GET (FT2, X); + IF X /= -0.5 THEN + FAILED ("VALUE INCORRECT - FIXED FROM DEFAULT"); + END IF; + END; + + BEGIN + DELETE (FT1); + DELETE (FT2); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3806G; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3806h.ada b/gcc/testsuite/ada/acats/tests/ce/ce3806h.ada new file mode 100644 index 000000000..daaef6a9e --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3806h.ada @@ -0,0 +1,144 @@ +-- CE3806H.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 FIXED_IO PUT RAISES LAYOUT_ERROR WHEN THE NUMBER OF +-- CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE LENGTH. CHECK +-- THAT IT IS NOT RAISED, BUT RATHER NEW_LINE IS CALLED, WHEN THE +-- NUMBER DOES NOT EXCEED THE MAX, BUT WHEN ADDED TO THE CURRENT +-- COLUMN NUMBER, THE TOTAL EXCEEDS THE MAX. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JLH 09/15/87 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; +WITH CHECK_FILE; + +PROCEDURE CE3806H IS + +BEGIN + + TEST ("CE3806H", "CHECK THAT FIXED_IO PUT RAISES " & + "LAYOUT_ERROR CORRECTLY"); + + DECLARE + FT : FILE_TYPE; + TYPE FX IS DELTA 0.01 RANGE -200.0 .. 200.0; + PACKAGE FXIO IS NEW FIXED_IO (FX); + USE FXIO; + INCOMPLETE : EXCEPTION; + X : FX := 126.5; + Y : FX := -134.0; + Z : FX := 120.0; + + BEGIN + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & + "CREATE WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + SET_LINE_LENGTH (FT, 4); + + BEGIN + PUT (FT, X, FORE => 3, AFT => 1); + FAILED ("LAYOUT_ERROR NOT RAISED - FIXED"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FIXED"); + END; + + SET_LINE_LENGTH (FT,7); + + BEGIN + PUT (FT, Y, FORE => 3, AFT => 2); + EXCEPTION + WHEN LAYOUT_ERROR => + FAILED ("LAYOUT_ERROR RAISED SECOND PUT - " & + "FIXED"); + WHEN OTHERS => + FAILED ("SOME EXCEPTION RAISED SECOND PUT - " & + "FIXED"); + END; + + BEGIN + PUT (FT,Z, FORE => 4, AFT => 2); + IF LINE (FT) /= 2 THEN + FAILED ("NEW_LINE NOT CALLED - FIXED"); + END IF; + EXCEPTION + WHEN LAYOUT_ERROR => + FAILED ("LAYOUT_ERROR RAISED THIRD PUT - " & + "FIXED"); + WHEN OTHERS => + FAILED ("EXCEPTION RAISED THIRD PUT - FIXED"); + END; + + BEGIN + PUT (FT, "Y"); + PUT (FT, Z, FORE => 3, AFT => 0); + NEW_LINE (FT); + PUT (FT, "Z"); + PUT (FT, Y, FORE => 3, AFT => 2); + EXCEPTION + WHEN LAYOUT_ERROR => + FAILED ("LAYOUT_ERROR RAISED LAST PUT - " & + "FIXED"); + WHEN OTHERS => + FAILED ("EXCEPTION RAISED LAST PUT - FIXED "); + END; + + CHECK_FILE (FT, "-134.00# 120.00#Y120.0#Z#-134.00#@%"); + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + + END; + + RESULT; + +END CE3806H; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3809a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3809a.ada new file mode 100644 index 000000000..f854553fd --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3809a.ada @@ -0,0 +1,239 @@ +-- CE3809A.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 FLOAT I/O GET CAN READ A VALUE FROM A STRING. +-- CHECK THAT END_ERROR IS RAISED WHEN CALLED WITH A NULL STRING +-- OR A STRING CONTAINING SPACES AND/OR HORIZONTAL TABULATION +-- CHARACTERS. CHECK THAT LAST CONTAINS THE INDEX OF THE LAST +-- CHARACTER READ FROM THE STRING. + +-- HISTORY: +-- SPS 10/07/82 +-- SPS 12/14/82 +-- JBG 12/21/82 +-- DWC 09/15/87 ADDED CASE TO INCLUDE ONLY TABS IN STRING AND +-- CHECKED THAT END_ERROR IS RAISED. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3809A IS +BEGIN + + TEST ("CE3809A", "CHECK THAT FLOAT_IO GET " & + "OPERATES CORRECTLY ON STRINGS"); + + DECLARE + TYPE FL IS DIGITS 4; + PACKAGE FLIO IS NEW FLOAT_IO (FL); + USE FLIO; + X : FL; + STR : STRING (1..10) := " 10.25 "; + L : POSITIVE; + BEGIN + +-- LEFT-JUSTIFIED IN STRING, POSITIVE, NO EXPONENT + BEGIN + GET ("896.5 ", X, L); + IF X /= 896.5 THEN + FAILED ("FLOAT VALUE FROM STRING INCORRECT"); + END IF; + EXCEPTION + WHEN DATA_ERROR => + FAILED ("DATA_ERROR RAISED - FLOAT - 1"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED - FLOAT - 1"); + END; + + IF L /= IDENT_INT (5) THEN + FAILED ("VALUE OF LAST INCORRECT - FLOAT - 1. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + +-- STRING LITERAL WITH BLANKS + BEGIN + GET (" ", X, L); + FAILED ("END_ERROR NOT RAISED - FLOAT - 2"); + EXCEPTION + WHEN END_ERROR => + IF L /= 5 THEN + FAILED ("AFTER END_ERROR, VALUE OF LAST " & + "INCORRECT - 2. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + WHEN DATA_ERROR => + FAILED ("DATA_ERROR RAISED - FLOAT - 2"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FLOAT - 2"); + END; + +-- NULL STRING LITERAL + BEGIN + GET ("", X, L); + FAILED ("END_ERROR NOT RAISED - FLOAT - 3"); + EXCEPTION + WHEN END_ERROR => + IF L /= 5 THEN + FAILED ("AFTER END_ERROR, VALUE OF LAST " & + "INCORRECT - 3. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + WHEN DATA_ERROR => + FAILED ("DATA_ERROR RAISED - FLOAT - 3"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FLOAT - 3"); + END; + +-- NULL SLICE + BEGIN + GET (STR(5..IDENT_INT(2)), X, L); + FAILED ("END_ERROR NOT RAISED - FLOAT - 4"); + EXCEPTION + WHEN END_ERROR => + IF L /= 5 THEN + FAILED ("AFTER END_ERROR, VALUE OF LAST " & + "INCORRECT - 4. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + WHEN DATA_ERROR => + FAILED ("DATA_ERROR RAISED - FLOAT - 4"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FLOAT - 4"); + END; + +-- SLICE WITH BLANKS + BEGIN + GET (STR(IDENT_INT(9)..10), X, L); + FAILED ("END_ERROR NOT RAISED - FLOAT - 5"); + EXCEPTION + WHEN END_ERROR => + IF L /= IDENT_INT(5) THEN + FAILED ("AFTER END_ERROR, VALUE OF LAST " & + "INCORRECT - 5. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + WHEN DATA_ERROR => + FAILED ("DATA_ERROR RAISED - FLOAT - 5"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FLOAT - 5"); + END; + +-- NON-NULL SLICE + BEGIN + GET (STR(2..IDENT_INT(8)), X, L); + IF X /= 10.25 THEN + FAILED ("FLOAT VALUE INCORRECT - 6"); + END IF; + IF L /= 8 THEN + FAILED ("LAST INCORRECT FOR SLICE - 6. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED - 6"); + END; + +-- LEFT-JUSTIFIED, POSITIVE EXPONENT + BEGIN + GET ("1.34E+02", X, L); + IF X /= 134.0 THEN + FAILED ("FLOAT WITH EXP FROM STRING INCORRECT - 7"); + END IF; + + IF L /= 8 THEN + FAILED ("VALUE OF LAST INCORRECT - FLOAT - 7. " & + "LAST IS" & INTEGER'IMAGE(L)); + END IF; + EXCEPTION + WHEN DATA_ERROR => + FAILED ("DATA_EROR RAISED - FLOAT - 7"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED - FLOAT - 7"); + END; + +-- RIGHT-JUSTIFIED, NEGATIVE EXPONENT + BEGIN + GET (" 25.0E-2", X, L); + IF X /= 0.25 THEN + FAILED ("NEG EXPONENT INCORRECT - 8"); + END IF; + IF L /= 8 THEN + FAILED ("LAST INCORRECT - 8. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED - 8"); + END; + +-- RIGHT-JUSTIFIED, NEGATIVE + GET (" -1.50", X, L); + IF X /= -1.5 THEN + FAILED ("FLOAT IN RIGHT JUSTIFIED STRING INCORRECT - 9"); + END IF; + IF L /= 7 THEN + FAILED ("LAST INCORRECT - 9. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + +-- HORIZONTAL TAB WITH BLANKS + BEGIN + GET (" " & ASCII.HT & "2.3E+2", X, L); + IF X /= 230.0 THEN + FAILED ("FLOAT WITH TAB IN STRING INCORRECT - 10"); + END IF; + IF L /= 8 THEN + FAILED ("LAST INCORRECT FOR TAB - 10. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + EXCEPTION + WHEN DATA_ERROR => + FAILED ("DATA_ERROR FOR STRING WITH TAB - 10"); + WHEN OTHERS => + FAILED ("SOME EXCEPTION RAISED FOR STRING WITH " & + "TAB - 10"); + END; + +-- HORIZONTAL TABS ONLY + BEGIN + GET (ASCII.HT & ASCII.HT, X, L); + FAILED ("END_ERROR NOT RAISED - FLOAT - 11"); + EXCEPTION + WHEN END_ERROR => + IF L /= IDENT_INT(8) THEN + FAILED ("AFTER END_ERROR, VALUE OF LAST " & + "INCORRECT - 11. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + WHEN DATA_ERROR => + FAILED ("DATA_ERROR RAISED - FLOAT - 11"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FLOAT - 11"); + END; + END; + + RESULT; + +END CE3809A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3809b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3809b.ada new file mode 100644 index 000000000..45aca867e --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3809b.ada @@ -0,0 +1,239 @@ +-- CE3809B.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. +--* +-- HISTORY: +-- CHECK THAT FIXED I/O GET CAN READ A VALUE FROM A STRING. +-- CHECK THAT END_ERROR IS RAISED WHEN CALLED WITH A NULL STRING +-- OR A STRING CONTAINING SPACES AND/OR HORIZONTAL TABULATION +-- CHARACTERS. CHECK THAT LAST CONTAINS THE INDEX OF THE LAST +-- CHARACTER READ FROM THE STRING. + +-- HISTORY: +-- SPS 10/07/82 +-- SPS 12/14/82 +-- JBG 12/21/82 +-- DWC 09/15/87 ADDED CASE TO INCLUDE ONLY TABS IN STRING AND +-- CHECKED THAT END_ERROR IS RAISED. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3809B IS +BEGIN + + TEST ("CE3809B", "CHECK THAT FIXED_IO GET " & + "OPERATES CORRECTLY ON STRINGS"); + + DECLARE + TYPE FX IS DELTA 0.001 RANGE -2.0 .. 1000.0; + PACKAGE FXIO IS NEW FIXED_IO (FX); + USE FXIO; + X : FX; + L : POSITIVE; + STR : STRING (1..10) := " 10.25 "; + BEGIN + +-- LEFT-JUSTIFIED IN STRING, POSITIVE, NO EXPONENT + BEGIN + GET ("896.5 ", X, L); + IF X /= 896.5 THEN + FAILED ("FIXED VALUE FROM STRING INCORRECT"); + END IF; + EXCEPTION + WHEN DATA_ERROR => + FAILED ("DATA_ERROR RAISED - FIXED - 1"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED - FIXED - 1"); + END; + + IF L /= IDENT_INT (5) THEN + FAILED ("VALUE OF LAST INCORRECT - FIXED - 1. " & + "LAST IS" & INTEGER'IMAGE(L)); + END IF; + +-- STRING LITERAL WITH BLANKS + BEGIN + GET (" ", X, L); + FAILED ("END_ERROR NOT RAISED - FIXED - 2"); + EXCEPTION + WHEN END_ERROR => + IF L /= 5 THEN + FAILED ("AFTER END_ERROR, VALUE OF LAST " & + "INCORRECT - 2. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + WHEN DATA_ERROR => + FAILED ("DATA_ERROR RAISED - FIXED - 2"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FIXED - 2"); + END; + +-- NULL STRING LITERAL + BEGIN + GET ("", X, L); + FAILED ("END_ERROR NOT RAISED - FIXED - 3"); + EXCEPTION + WHEN END_ERROR => + IF L /= 5 THEN + FAILED ("AFTER END_ERROR, VALUE OF LAST " & + "INCORRECT - 3. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + WHEN DATA_ERROR => + FAILED ("DATA_ERROR RAISED - FIXED - 3"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FIXED - 3"); + END; + +-- NULL SLICE + BEGIN + GET (STR(5..IDENT_INT(2)), X, L); + FAILED ("END_ERROR NOT RAISED - FIXED - 4"); + EXCEPTION + WHEN END_ERROR => + IF L /= 5 THEN + FAILED ("AFTER END_ERROR, VALUE OF LAST " & + "INCORRECT - 4. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + WHEN DATA_ERROR => + FAILED ("DATA_ERROR RAISED - FIXED - 4"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FIXED - 4"); + END; + +-- SLICE WITH BLANKS + BEGIN + GET (STR(IDENT_INT(9)..10), X, L); + FAILED ("END_ERROR NOT RAISED - FIXED - 5"); + EXCEPTION + WHEN END_ERROR => + IF L /= IDENT_INT(5) THEN + FAILED ("AFTER END_ERROR, VALUE OF LAST " & + "INCORRECT - 5. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + WHEN DATA_ERROR => + FAILED ("DATA_ERROR RAISED - FIXED - 5"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FIXED - 5"); + END; + +-- NON-NULL SLICE + BEGIN + GET (STR(2..IDENT_INT(8)), X, L); + IF X /= 10.25 THEN + FAILED ("FIXED VALUE INCORRECT - 6"); + END IF; + IF L /= 8 THEN + FAILED ("LAST INCORRECT FOR SLICE - 6. " & + "LAST IS" & INTEGER'IMAGE(L)); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED - 6"); + END; + +-- LEFT-JUSTIFIED, POSITIVE EXPONENT + BEGIN + GET ("1.34E+02", X, L); + IF X /= 134.0 THEN + FAILED ("FIXED WITH EXP FROM STRING INCORRECT - 7"); + END IF; + + IF L /= 8 THEN + FAILED ("VALUE OF LAST INCORRECT - FIXED - 7. " & + "LAST IS" & INTEGER'IMAGE(L)); + END IF; + EXCEPTION + WHEN DATA_ERROR => + FAILED ("DATA_EROR RAISED - FIXED - 7"); + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED - FIXED - 7"); + END; + +-- RIGHT-JUSTIFIED, NEGATIVE EXPONENT + BEGIN + GET (" 25.0E-2", X, L); + IF X /= 0.25 THEN + FAILED ("NEG EXPONENT INCORRECT - 8"); + END IF; + IF L /= 8 THEN + FAILED ("LAST INCORRECT - 8. " & + "LAST IS" & INTEGER'IMAGE(L)); + END IF; + EXCEPTION + WHEN OTHERS => + FAILED ("EXCEPTION RAISED - 8"); + END; + +-- RIGHT-JUSTIFIED, NEGATIVE + GET (" -1.50", X, L); + IF X /= -1.5 THEN + FAILED ("FIXED IN RIGHT JUSTIFIED STRING INCORRECT - 9"); + END IF; + IF L /= 7 THEN + FAILED ("LAST INCORRECT - 9. " & + "LAST IS" & INTEGER'IMAGE(L)); + END IF; + +-- HORIZONTAL TAB WITH BLANK + BEGIN + GET (" " & ASCII.HT & "2.3E+2", X, L); + IF X /= 230.0 THEN + FAILED ("FIXED WITH TAB IN STRING INCORRECT - 10"); + END IF; + IF L /= 8 THEN + FAILED ("LAST INCORRECT FOR TAB - 10. " & + "LAST IS" & INTEGER'IMAGE(L)); + END IF; + EXCEPTION + WHEN DATA_ERROR => + FAILED ("DATA_ERROR FOR STRING WITH TAB - 10"); + WHEN OTHERS => + FAILED ("EXCEPTION FOR STRING WITH TAB - 10"); + END; + +-- HORIZONTAL TABS ONLY + + BEGIN + GET (ASCII.HT & ASCII.HT, X, L); + FAILED ("END_ERROR NOT RAISED - FIXED - 11"); + EXCEPTION + WHEN END_ERROR => + IF L /= IDENT_INT(8) THEN + FAILED ("AFTER END_ERROR, VALUE OF LAST " & + "INCORRECT - 11. LAST IS" & + INTEGER'IMAGE(L)); + END IF; + WHEN DATA_ERROR => + FAILED ("DATA_ERROR RAISED - FIXED - 11"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FIXED - 11"); + END; + END; + + RESULT; + +END CE3809B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3810a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3810a.ada new file mode 100644 index 000000000..f51728c43 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3810a.ada @@ -0,0 +1,114 @@ +-- CE3810A.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 FLOAT_IO PUT CAN OPERATE ON STRINGS. ALSO CHECK THAT +-- LAYOUT_ERROR IS RAISED WHEN THE STRING IS INSUFFICIENTLY LONG. + +-- HISTORY: +-- SPS 10/07/82 +-- VKG 01/20/83 +-- SPS 02/18/83 +-- DWC 09/15/87 SPLIT CASE FOR FIXED_IO INTO CE3810B.ADA AND +-- ADDED CASED FOR AFT AND EXP TO RAISE LAYOUT_ERROR. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3810A IS +BEGIN + + TEST ("CE3810A", "CHECK THAT FLOAT_IO PUT " & + "OPERATES ON STRINGS CORRECTLY"); + + DECLARE + TYPE FL IS DIGITS 4; + PACKAGE FLIO IS NEW FLOAT_IO (FL); + USE FLIO; + ST : STRING (1 .. 2 + (FL'DIGITS-1) + 3 + 2); + ST1 : STRING (1 .. 10) := " 2.345E+02"; + ST2 : STRING (1 .. 2); + BEGIN + PUT (ST, 234.5); + IF ST /= ST1 THEN + FAILED ("PUT FLOAT TO STRING INCORRECT; OUTPUT WAS """ & + ST & """"); + END IF; + + BEGIN + PUT (ST(1 .. 8), 234.5); + FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 1"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FLOAT - 1"); + END; + + BEGIN + PUT (ST, 2.3, 9, 0); + FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 2"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FLOAT - 2"); + END; + + BEGIN + PUT (ST2, 2.0, 0, 0); + FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 3"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FLOAT - 3"); + END; + + BEGIN + PUT (ST, 2.345, 6, 2); + FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 4"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FLOAT - 4"); + END; + + BEGIN + PUT (ST, 2.0, 0, 7); + FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 5"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FLOAT - 5"); + END; + END; + + RESULT; + +END CE3810A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3810b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3810b.ada new file mode 100644 index 000000000..dfdbd56c0 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3810b.ada @@ -0,0 +1,122 @@ +-- CE3810B.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 FIXED_IO PUT CAN OPERATE ON STRINGS. ALSO CHECK THAT +-- LAYOUT_ERROR IS RAISED WHEN THE STRING IS INSUFFICIENTLY LONG. + +-- HISTORY: +-- DWC 09/15/87 CREATE ORIGINAL TEST. +-- JRL 02/28/96 Changed upper bound of type FX from 1000.0 to 250.0. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3810B IS +BEGIN + + TEST ("CE3810B", "CHECK THAT FIXED_IO PUT CAN OPERATE ON " & + "STRINGS. ALSO CHECK THAT LAYOUT_ERROR IS " & + "RAISED WHEN THE STRING IS INSUFFICIENTLY LONG"); + + DECLARE + TYPE FX IS DELTA 0.0001 RANGE 0.0 .. 250.0; + PACKAGE FXIO IS NEW FIXED_IO (FX); + USE FXIO; + ST1 : CONSTANT STRING := " 234.5000"; + ST : STRING (ST1'RANGE); + ST2 : STRING (1 .. 2); + + BEGIN + BEGIN + PUT (ST, 234.5); + EXCEPTION + WHEN LAYOUT_ERROR => + FAILED ("LAYOUT_ERROR RAISED ON PUT" & + "TO STRING - FIXED"); + WHEN OTHERS => + FAILED ("SOME EXCEPTION RAISED ON PUT" & + "TO STRING -FIXED"); + END; + + IF ST /= ST1 THEN + FAILED ("PUT FIXED TO STRING INCORRECT; OUTPUT " & + "WAS """ & ST & """"); + END IF; + + BEGIN + PUT (ST (1..7), 234.5000); + FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 1"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FIXED - 1"); + END; + + BEGIN + PUT (ST, 2.3, 9, 0); + FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 2"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FIXED - 2"); + END; + + BEGIN + PUT (ST2, 2.0, 0, 0); + FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 3"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FIXED - 3"); + END; + + BEGIN + PUT (ST, 2.345, 6, 2); + FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 4"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FIXED - 4"); + END; + + BEGIN + PUT (ST, 2.0, 0, 7); + FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 5"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FIXED - 5"); + END; + END; + + RESULT; +END CE3810B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3815a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3815a.ada new file mode 100644 index 000000000..196ff86cc --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3815a.ada @@ -0,0 +1,103 @@ +-- CE3815A.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 THE OPERATIONS IN GENERIC PACKAGE FLOAT_IO ALL HAVE +-- THE CORRECT PARAMETER NAMES. + +-- HISTORY: +-- JET 10/28/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; +PROCEDURE CE3815A IS + + STR : STRING(1..20) := (OTHERS => ' '); + FIN, FOUT : FILE_TYPE; + F : FLOAT; + L : POSITIVE; + FILE_OK : BOOLEAN := FALSE; + + PACKAGE FIO IS NEW FLOAT_IO(FLOAT); + USE FIO; + +BEGIN + TEST ("CE3815A", "CHECK THAT THE OPERATIONS IN GENERIC PACKAGE " & + "FLOAT_IO ALL HAVE THE CORRECT PARAMETER NAMES"); + + PUT (TO => STR, ITEM => 1.0, AFT => 3, EXP => 3); + GET (FROM => STR, ITEM => F, LAST => L); + + BEGIN + CREATE(FOUT, OUT_FILE, LEGAL_FILE_NAME); + FILE_OK := TRUE; + EXCEPTION + WHEN OTHERS => + COMMENT("OUTPUT FILE COULD NOT BE CREATED"); + END; + + IF FILE_OK THEN + BEGIN + PUT (FILE => FOUT, ITEM => 1.0, FORE => 3, AFT => 3, + EXP => 3); + NEW_LINE(FOUT); + + CLOSE(FOUT); + EXCEPTION + WHEN OTHERS => + FAILED("OUTPUT FILE COULD NOT BE WRITTEN"); + FILE_OK := FALSE; + END; + END IF; + + IF FILE_OK THEN + BEGIN + OPEN(FIN, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN OTHERS => + FAILED("INPUT FILE COULD NOT BE OPENED"); + FILE_OK := FALSE; + END; + END IF; + + IF FILE_OK THEN + BEGIN + GET (FILE => FIN, ITEM => F, WIDTH => 10); + EXCEPTION + WHEN OTHERS => + FAILED ("DATA COULD NOT BE READ FROM FILE"); + END; + + BEGIN + DELETE(FIN); + EXCEPTION + WHEN USE_ERROR => + COMMENT("FILE COULD NOT BE DELETED"); + WHEN OTHERS => + FAILED("UNEXPECTED ERROR AT DELETION"); + END; + END IF; + + RESULT; +END CE3815A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3901a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3901a.ada new file mode 100644 index 000000000..1760dd976 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3901a.ada @@ -0,0 +1,106 @@ +-- CE3901A.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 GET AND PUT FOR ENUMERATED TYPES RAISE STATUS ERROR +-- IF THE FILE IS NOT OPEN. + +-- HISTORY: +-- SPS 10/07/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- DWC 09/16/87 ADDED AN ATTEMPT TO CREATE A FILE AND THEN +-- RETESTED OBJECTIVE. +-- BCB 10/03/90 ADDED NAME_ERROR AS A CHOICE TO THE EXCEPTION +-- HANDLER FOR CREATE. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3901A IS +BEGIN + + TEST ("CE3901A", "CHECK THAT GET AND PUT FOR ENUMERATED TYPES " & + "RAISE STATUS ERROR IF THE FILE IS NOT OPEN."); + + DECLARE + TYPE COLOR IS (RED, BLUE, GREEN, ORANGE, YELLOW); + FT : FILE_TYPE; + PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR); + USE COLOR_IO; + X : COLOR; + BEGIN + BEGIN + PUT (FT, RED); + FAILED ("STATUS_ERROR NOT RAISED - PUT - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - PUT - 1"); + END; + + BEGIN + GET (FT, X); + FAILED ("STATUS_ERROR NOT RAISED - GET - 1"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET - 1"); + END; + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); -- THIS IS JUST + CLOSE (FT); -- AN ATTEMPT TO CREATE A + EXCEPTION -- FILE. OBJECTIVE IS MET + WHEN USE_ERROR -- EITHER WAY. + | NAME_ERROR => NULL; + END; + + BEGIN + PUT (FT, RED); + FAILED ("STATUS_ERROR NOT RAISED - PUT - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - PUT - 2"); + END; + + BEGIN + GET (FT, X); + FAILED ("STATUS_ERROR NOT RAISED - GET - 2"); + EXCEPTION + WHEN STATUS_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - GET - 2"); + END; + END; + + RESULT; + +END CE3901A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3902b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3902b.ada new file mode 100644 index 000000000..9f5359949 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3902b.ada @@ -0,0 +1,117 @@ +-- CE3902B.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 THE OPERATIONS IN GENERIC PACKAGE ENUMERATION_IO +-- ALL HAVE THE CORRECT PARAMETER NAMES. + +-- HISTORY: +-- JLH 08/25/88 CREATED ORIGINAL TEST. +-- RJW 02/28/90 ADDED CODE TO PREVENT MODE_ERROR FROM BEING RAISED. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3902B IS + + TYPE COLOR IS (RED, BLUE, GREEN); + PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR); + USE COLOR_IO; + + FILE1 : FILE_TYPE; + CRAYON : COLOR := RED; + INDEX : POSITIVE; + NUM : FIELD := 5; + COLOR_STRING : STRING (1..5); + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3902B", "CHECK THAT THE OPERATIONS IN GENERIC PACKAGE " & + "ENUMERATION_IO ALL HAVE THE CORRECT PARAMETER " & + "NAMES"); + + BEGIN + + BEGIN + CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + SET_OUTPUT (FILE1); + + PUT (FILE => FILE1, ITEM => CRAYON, WIDTH => NUM, + SET => UPPER_CASE); + + PUT (ITEM => GREEN, WIDTH => 5, SET => LOWER_CASE); + + PUT (TO => COLOR_STRING, ITEM => BLUE, SET => UPPER_CASE); + + CLOSE (FILE1); + + SET_OUTPUT (STANDARD_OUTPUT); + + BEGIN + OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " & + "MODE IN_FILE"); + RAISE INCOMPLETE; + END; + + SET_INPUT (FILE1); + + GET (FILE => FILE1, ITEM => CRAYON); + + GET (ITEM => CRAYON); + + GET (FROM => COLOR_STRING, ITEM => CRAYON, LAST => INDEX); + + BEGIN + DELETE (FILE1); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3902B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3904a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3904a.ada new file mode 100644 index 000000000..7fe900b6d --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3904a.ada @@ -0,0 +1,117 @@ +-- CE3904A.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 THE LAST NONBLANK CHARACTER IN A FILE MAY BE READ BY +-- 'GET' IN ENUMERATION_IO WITHOUT RAISING END_ERROR, AND THAT AFTER +-- THE LAST CHARACTER OF THE FILE HAS BEEN READ, ANY ATTEMPT TO READ +-- FURTHER CHARACTERS WILL RAISE END_ERROR. + +-- HISTORY: +-- JET 08/19/88 CREATED ORIGINAL TEST. + +WITH REPORT, TEXT_IO; USE REPORT, TEXT_IO; +PROCEDURE CE3904A IS + + TYPE ENUM IS (THE, QUICK, BROWN, X); + E : ENUM; + + PACKAGE EIO IS NEW ENUMERATION_IO(ENUM); + USE EIO; + + F : FILE_TYPE; + + FILE_OK : BOOLEAN := FALSE; + +BEGIN + TEST ("CE3904A", "CHECK THAT THE LAST NONBLANK CHARACTER IN A " & + "FILE MAY BE READ BY 'GET' IN ENUMERATION_IO " & + "WITHOUT RAISING END_ERROR, AND THAT AFTER THE " & + "LAST CHARACTER OF THE FILE HAS BEEN READ, ANY " & + "ATTEMPT TO READ FURTHER CHARACTERS WILL RAISE " & + "END_ERROR"); + + BEGIN + CREATE(F, OUT_FILE, LEGAL_FILE_NAME); + FILE_OK := TRUE; + EXCEPTION + WHEN OTHERS => + NOT_APPLICABLE("DATA FILE COULD NOT BE OPENED FOR " & + "WRITING"); + END; + + IF FILE_OK THEN + BEGIN + PUT(F, THE); NEW_LINE(F); + PUT(F, QUICK); NEW_LINE(F); + PUT(F, BROWN); NEW_LINE(F); + PUT(F, X); NEW_LINE(F); + CLOSE(F); + EXCEPTION + WHEN OTHERS => + NOT_APPLICABLE("DATA FILE COULD NOT BE WRITTEN"); + FILE_OK := FALSE; + END; + END IF; + + IF FILE_OK THEN + BEGIN + OPEN(F, IN_FILE, LEGAL_FILE_NAME); + FOR I IN 0..3 LOOP + GET(F, E); + IF E /= ENUM'VAL(I) THEN + FAILED("INCORRECT VALUE READ -" & + INTEGER'IMAGE(I)); + END IF; + END LOOP; + EXCEPTION + WHEN OTHERS => + FAILED("UNEXPECTED EXCEPTION RAISED BEFORE END " & + "OF FILE"); + FILE_OK := FALSE; + END; + END IF; + + IF FILE_OK THEN + BEGIN + GET(F, E); + FAILED("NO EXCEPTION RAISED AFTER END OF FILE"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED("INCORRECT EXCEPTION RAISED AFTER END OF " & + "FILE"); + END; + + BEGIN + DELETE(F); + EXCEPTION + WHEN OTHERS => + COMMENT("DATA FILE COULD NOT BE DELETED"); + END; + END IF; + + RESULT; +END CE3904A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3904b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3904b.ada new file mode 100644 index 000000000..408e5909c --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3904b.ada @@ -0,0 +1,142 @@ +-- CE3904B.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 END_ERROR IS RAISED BY GET WITH AN ENUMERATION TYPE +-- WHEN THE ONLY REMAINING CHARACTERS IN THE FILE ARE SPACES, +-- HORIZONTAL TABULATION CHARACTERS, LINE TERMINATORS, AND PAGE +-- TERMINATORS. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS THAT SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- JLH 07/15/88 CREATED ORIGINAL TEST. + +WITH REPORT; USE REPORT; +WITH TEXT_IO; USE TEXT_IO; + +PROCEDURE CE3904B IS + + TYPE COLOR IS (RED, BLUE, GREEN); + PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR); + USE COLOR_IO; + + FILE : FILE_TYPE; + ITEM : COLOR; + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3904B", "CHECK THAT END_ERROR IS RAISED BY GET WITH " & + "AN ENUMERATION TYPE WHEN THE ONLY REMAINING " & + "CHARACTERS IN THE FILE ARE SPACES, HORIZONTAL " & + "TABULATION CHARACTERS, LINE TERMINATORS, AND " & + "PAGE TERMINATORS"); + + BEGIN + + BEGIN + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " & + "WITH MODE OUT_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE"); + RAISE INCOMPLETE; + END; + + PUT (FILE, RED); + NEW_LINE (FILE); + NEW_LINE (FILE); + NEW_PAGE (FILE); + PUT (FILE, ASCII.HT); + PUT (FILE, GREEN); + NEW_LINE (FILE); + NEW_LINE (FILE); + NEW_PAGE (FILE); + PUT (FILE, ' '); + PUT (FILE, ASCII.HT); + PUT (FILE, ' '); + + CLOSE (FILE); + + BEGIN + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " & + "MODE IN_FILE"); + RAISE INCOMPLETE; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN"); + RAISE INCOMPLETE; + END; + + GET (FILE, ITEM); + IF ITEM /= RED THEN + FAILED ("INCORRECT VALUE READ - 1"); + END IF; + + GET (FILE, ITEM); + IF ITEM /= GREEN THEN + FAILED ("INCORRECT VALUE READ - 2"); + END IF; + + BEGIN + GET (FILE, ITEM); + FAILED ("END_ERROR NOT RAISED FOR GET"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("UNEXPECTED EXCEPTION RAISED ON GET"); + END; + + IF NOT END_OF_FILE (FILE) THEN + FAILED ("END_OF_FILE NOT TRUE AFTER RAISING EXCEPTION"); + END IF; + + BEGIN + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3904B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3905a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3905a.ada new file mode 100644 index 000000000..4fa69ef61 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3905a.ada @@ -0,0 +1,145 @@ +-- CE3905A.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 GET FOR ENUMERATION TYPES OPERATES ON FILE OF MODE +-- IN_FILE AND THAT WHEN NO FILE IS SPECIFIED IT OPERATES ON THE +-- CURRENT DEFAULT INPUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 10/07/82 +-- SPS 12/22/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST. +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/16/87 REMOVED DEPENDENCE ON RESET AND CORRECTED +-- EXCEPTION HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3905A IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3905A", "CHECK THAT GET FOR ENUMERATION TYPES " & + "OPERATES ON FILE OF MODE IN_FILE AND THAT " & + "WHEN NO FILE IS SPECIFIED IT OPERATES ON " & + "THE CURRENT DEFAULT INPUT_FILE"); + + DECLARE + TYPE DAY IS (MONDAY, TUESDAY, WEDNESDAY, THURSDAY, FRIDAY); + PACKAGE DAY_IO IS NEW ENUMERATION_IO (DAY); + FT : FILE_TYPE; + FILE : FILE_TYPE; + USE DAY_IO; + X : DAY; + BEGIN + +-- CREATE AND INITIALIZE DATA FILES. + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE - 1"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE - 1"); + RAISE INCOMPLETE; + END; + + PUT (FT, "WEDNESDAY"); + NEW_LINE (FT); + PUT (FT, "FRIDAY"); + + CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME(2)); + + PUT (FILE, "TUESDAY"); + NEW_LINE (FILE); + PUT (FILE, "THURSDAY"); + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & + "FOR IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + CLOSE (FILE); + OPEN (FILE, IN_FILE, LEGAL_FILE_NAME(2)); + + SET_INPUT (FILE); + +-- BEGIN TEST + + GET (FT, X); + IF X /= WEDNESDAY THEN + FAILED ("VALUE FROM FILE INCORRECT"); + END IF; + + GET (X); + IF X /= TUESDAY THEN + FAILED ("VALUE FROM DEFAULT INCORRECT"); + END IF; + + GET (FT, X); + IF X /= FRIDAY THEN + FAILED ("VALUE FROM FILE INCORRECT"); + END IF; + + GET (FILE, X); + IF X /= THURSDAY THEN + FAILED ("VALUE FROM DEFAULT INCORRECT"); + END IF; + + BEGIN + DELETE (FT); + DELETE (FILE); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3905A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3905b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3905b.ada new file mode 100644 index 000000000..5823f2962 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3905b.ada @@ -0,0 +1,111 @@ +-- CE3905B.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 GET FOR ENUMERATION TYPES RAISE MODE_ERROR WHEN THE +-- MODE OF THE FILE SPECIFIED IS OUT_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT CREATE FOR TEMP FILES WITH OUT_FILE. + +-- HISTORY: +-- SPS 10/07/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST. +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/16/87 CORRECTED EXCEPTION HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3905B IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3905B", "CHECK THAT ENUMERATION_IO GET RAISES " & + "MODE_ERROR WHEN THE MODE OF THE FILE IS " & + "OUT_FILE"); + + DECLARE + FT : FILE_TYPE; + TYPE COLOR IS (RED, BLUE, GREEN, YELLOW); + X : COLOR; + PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR); + USE COLOR_IO; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "FOR TEMP FILES WITH OUT_FILE " & + "MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + GET (FT, X); + FAILED ("MODE_ERROR NOT RAISED - FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FILE"); + END; + + BEGIN + GET (STANDARD_OUTPUT, X); + FAILED ("MODE_ERROR NOT RAISED - STANDARD_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - STANDARD_OUTPUT"); + END; + + BEGIN + GET (CURRENT_OUTPUT, X); + FAILED ("MODE_ERROR NOT RAISED - CURRENT_OUTPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - CURRENT_OUTPUT"); + END; + + CLOSE (FT); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3905B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3905c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3905c.ada new file mode 100644 index 000000000..226abb9bc --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3905c.ada @@ -0,0 +1,202 @@ +-- CE3905C.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 GET FOR ENUMERATION TYPES RAISES DATA_ERROR WHEN THE +-- ELEMENT RETRIEVED IS NOT OF THE TYPE EXPECTED OR IS OUT OF THE +-- RANGE OF A SUBTYPE. ALSO CHECK THAT CONSTRAINT_ERROR IS RAISED +-- IF THE VALUE READ IS OUT OF RANGE OF THE ITEM PARAMETER, BUT +-- WITHIN THE RANGE OF THE INSTANTIATED TYPE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 10/08/82 +-- SPS 12/14/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST. +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/16/87 REMOVED DEPENDENCE ON RESET AND CORRECTED +-- EXCEPTION HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3905C IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3905C", "CHECK THAT GET FOR ENUMERATION TYPES RAISES " & + "DATA_ERROR WHEN THE ELEMENT RETRIEVED IS NOT " & + "OF THE TYPE EXPECTED OR IS OUT OF THE RANGE " & + "OF A SUBTYPE. ALSO CHECK THAT " & + "CONSTRAINT_ERROR IS RAISED IF THE VALUE READ " & + "IS OUT OF RANGE OF THE ITEM PARAMETER, BUT " & + "WITHIN THE RANGE OF THE INSTANTIATED TYPE"); + + DECLARE + FT : FILE_TYPE; + TYPE COLOR IS (RED, BLUE, YELLOW, WHITE, ORANGE, GREEN, + PURPLE, BLACK); + SUBTYPE P_COLOR IS COLOR RANGE RED .. YELLOW; + CRAYON : COLOR := BLACK; + PAINT : P_COLOR := BLUE; + ST : STRING (1 .. 2); + PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR); + USE COLOR_IO; + BEGIN + +-- CREATE AND INITIALIZE DATA FILE + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, "BROWN"); + NEW_LINE (FT); + PUT (FT, "ORANGE"); + NEW_LINE (FT); + PUT (FT, "GREEN"); + NEW_LINE (FT); + PUT (FT, "WHITE"); + NEW_LINE (FT); + PUT (FT, "WHI"); + NEW_LINE (FT); + PUT (FT, "TE"); + NEW_LINE (FT); + PUT (FT, "RED"); + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; OPEN WITH " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + +-- START TEST + + BEGIN + GET (FT, CRAYON); -- BROWN + FAILED ("DATA_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN DATA_ERROR => + IF CRAYON /= BLACK THEN + FAILED ("ITEM CRAYON AFFECTED - 1"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 1"); + END; + + BEGIN + GET (FT, PAINT); -- ORANGE + FAILED ("CONSTRAINT_ERROR NOT RAISED"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + IF PAINT /= BLUE THEN + FAILED ("ITEM PAINT AFFECTED - 2"); + END IF; + WHEN DATA_ERROR => + FAILED ("DATA_ERROR RAISED FOR ITEM SUBTYPE"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + + DECLARE + PACKAGE P_COLOR_IO IS NEW ENUMERATION_IO (P_COLOR); + USE P_COLOR_IO; + BEGIN + BEGIN + P_COLOR_IO.GET (FT, PAINT); -- GREEN + FAILED ("DATA_ERROR NOT RAISED - 3"); + EXCEPTION + WHEN DATA_ERROR => + IF PAINT /= BLUE THEN + FAILED ("ITEM PAINT AFFECTED - 3"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 3"); + END; + + BEGIN + P_COLOR_IO.GET (FT, PAINT); -- WHITE + FAILED ("DATA_ERROR NOT RAISED - 3A"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 3A"); + END; + END; + + BEGIN + GET (FT, CRAYON); -- WHI + FAILED ("DATA_ERROR NOT RAISED - 4"); + EXCEPTION + WHEN DATA_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 4"); + END; + + GET (FT, ST); -- TE + + GET (FT, CRAYON); -- RED + IF CRAYON /= RED THEN + FAILED ("READING NOT CONTINUED CORRECTLY AFTER" & + "DATA_ERROR EXCEPTION"); + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3905C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3905l.ada b/gcc/testsuite/ada/acats/tests/ce/ce3905l.ada new file mode 100644 index 000000000..759c7de6f --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3905l.ada @@ -0,0 +1,311 @@ +-- CE3905L.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 DATA_ERROR IS RAISED, BY GET, WHEN THE INPUT CONTAINS +-- +-- 1. EMBEDDED BLANKS. +-- 2. SINGLY QUOTED CHARACTER LITERALS. +-- 3. IDENTIFIERS BEGINNING WITH NON LETTERS. +-- 4. IDENTIFIERS CONTAINING SPECIAL CHARACTERS. +-- 5. CONSECUTIVE UNDERSCORES. +-- 6. LEADING OR TRAILING UNDERSCORES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- VKG 02/14/83 +-- SPS 03/16/83 +-- CPP 07/30/84 +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/16/87 REMOVED UNNECESSARY CODE AND CORRECTED +-- EXCEPTION HANDLING. + +WITH TEXT_IO; USE TEXT_IO; +WITH REPORT; USE REPORT; + +PROCEDURE CE3905L IS + + INCOMPLETE : EXCEPTION; + +BEGIN + TEST ("CE3905L", "CHECK GET FOR ENUMERATION_IO " & + "WITH LEXICAL ERRORS"); + DECLARE + FT : FILE_TYPE; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, "RED ISH"); + NEW_LINE (FT); + PUT (FT, "'A "); + NEW_LINE (FT); + PUT (FT, "2REDISH"); + NEW_LINE (FT); + PUT (FT, "BLUE$%ISH"); + NEW_LINE (FT); + PUT (FT, "RED__ISH"); + NEW_LINE (FT); + PUT (FT, "_YELLOWISH"); + NEW_LINE (FT); + PUT (FT, "GREENISH_"); + NEW_LINE (FT); + + CLOSE (FT); + + DECLARE + TYPE COLOUR IS + ( GREYISH, + REDISH , + BLUEISH, + YELLOWISH, + GREENISH, 'A'); + PACKAGE COLOUR_IO IS NEW ENUMERATION_IO(COLOUR); + USE COLOUR_IO; + X : COLOUR := GREYISH; + CH : CHARACTER; + BEGIN + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "OPEN WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - 1"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= GREYISH THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - 1"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 1"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - 1"); + ELSE + GET (FT, CH); + IF CH /= ' ' THEN + FAILED ("GET STOPPED AT WRONG POSITION " & + "- 1: CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - 2"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= GREYISH THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - 2"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 2"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - 2"); + ELSE + GET (FT, CH); + IF CH /= ' ' THEN + FAILED ("GET STOPPED AT WRONG POSITION " & + "- 2: CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - 3"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= GREYISH THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - 3"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 3"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - 3"); + ELSE + GET (FT, CH); + IF CH /= '2' THEN + FAILED ("GET STOPPED AT WRONG POSITION " & + "- 3: CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - 4"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= GREYISH THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - 4"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 4"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - 4"); + ELSE + GET (FT, CH); + IF CH /= '$' THEN + FAILED ("GET STOPPED AT WRONG POSITION " & + "- 4: CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - 5"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= GREYISH THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - 5"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 5"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - 5"); + ELSE + GET (FT, CH); + IF CH /= '_' THEN + FAILED ("GET STOPPED AT WRONG POSITION " & + "- 5: CHAR IS " & CH); + ELSE + GET (FT, CH); + IF CH /= 'I' THEN + FAILED ("ERROR READING DATA - 5"); + END IF; + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - 6"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= GREYISH THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - 6"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 6"); + END; + + IF END_OF_LINE (FT) THEN + FAILED ("GET STOPPED AT END OF LINE - 6"); + ELSE + GET (FT, CH); + IF CH /= '_' THEN + FAILED ("GET STOPPED AT WRONG POSITION " & + "- 6: CHAR IS " & CH); + END IF; + END IF; + + SKIP_LINE (FT); + + BEGIN + GET (FT, X); + FAILED ("DATA_ERROR NOT RAISED - 7"); + EXCEPTION + WHEN DATA_ERROR => + IF X /= GREYISH THEN + FAILED ("ACTUAL PARAMETER TO GET " & + "AFFECTED ON DATA_ERROR - 7"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 7"); + END; + + IF NOT END_OF_LINE (FT) THEN + BEGIN + GET (FT, X); + FAILED ("GET STOPPED AT WRONG POSITION " & + "- 7"); + EXCEPTION + WHEN END_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR " & + "EMPTY FILE - 7"); + END; + END IF; + END; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3905L; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3906a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3906a.ada new file mode 100644 index 000000000..a2dc87925 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3906a.ada @@ -0,0 +1,110 @@ +-- CE3906A.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 PUT FOR ENUMERATION TYPES CAN OPERATE ON FILES OF +-- MODE OUT_FILE AND THAT WHEN NO FILE PARAMETER IS SPECIFIED +-- THE CURRENT DEFAULT OUTPUT FILE IS USED. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEMPORARY TEXT FILES. + +-- HISTORY: +-- SPS 10/08/82 +-- SPS 01/03/83 +-- SPS 02/18/83 +-- JBG 02/22/84 CHANGED TO .ADA TEST. +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/17/87 REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION +-- HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; +WITH CHECK_FILE; + +PROCEDURE CE3906A IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3906A", "CHECK THAT PUT FOR ENUMERATION TYPES CAN " & + "OPERATE ON FILES OF MODE OUT_FILE AND THAT " & + "WHEN NO FILE PARAMETER IS SPECIFIED THE " & + "CURRENT DEFAULT OUTPUT FILE IS USED. CHECK " & + "THAT ENUMERATION_IO PUT OPERATES ON OUT_FILE " & + "FILES"); + + DECLARE + FT1, FT2 : FILE_TYPE; + TYPE COLOR IS (ROSE, VANILLA, CHARCOAL, CHOCOLATE); + CRAYON : COLOR := ROSE; + PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR); + USE COLOR_IO; + BEGIN + + BEGIN + CREATE (FT1, OUT_FILE); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "FOR TEMP FILES WITH OUT_FILE " & + "MODE - 1"); + RAISE INCOMPLETE; + END; + + CREATE (FT2, OUT_FILE); + + SET_OUTPUT (FT2); + + PUT (FT1, CRAYON); + NEW_LINE (FT1); + PUT (FT1, CHOCOLATE); + + CRAYON := CHARCOAL; + + PUT (CRAYON); + NEW_LINE; + PUT (VANILLA); + +-- CHECK OUTPUT + + SET_OUTPUT (STANDARD_OUTPUT); + COMMENT ("CHECKING FT1"); + CHECK_FILE (FT1, "ROSE#CHOCOLATE#@%"); + + COMMENT ("CHECKING FT2"); + CHECK_FILE (FT2, "CHARCOAL#VANILLA#@%"); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3906A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3906b.ada b/gcc/testsuite/ada/acats/tests/ce/ce3906b.ada new file mode 100644 index 000000000..3e0234084 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3906b.ada @@ -0,0 +1,133 @@ +-- CE3906B.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 PUT FOR ENUMERATION TYPES RAISES MODE_ERROR WHEN +-- APPLIED TO FILES OF MODE IN_FILE. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 10/08/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST. +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/17/87 REMOVED DEPENDENCY ON RESET AND CORRECTED +-- EXCEPTION HANDLERS. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3906B IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3906B", "CHECK THAT PUT FOR ENUMERATION TYPES RAISES " & + "MODE_ERROR WHEN APPLIED TO FILES OF MODE " & + "IN_FILE"); + + DECLARE + FT : FILE_TYPE; + TYPE FLOWER IS (ROSE, DAISY, SNAPDRAGON, VIOLET, CARNATION); + PACKAGE FLOWER_IO IS NEW ENUMERATION_IO (FLOWER); + USE FLOWER_IO; + X : FLOWER := DAISY; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + PUT (FT, X); + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & + "WITH IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + BEGIN + PUT (FT, X); + FAILED ("MODE_ERROR NOT RAISED - FILE"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - FILE"); + END; + + BEGIN + PUT (STANDARD_INPUT, X); + FAILED ("MODE_ERROR NOT RAISED - STANDARD_INPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - STANDARD_INPUT"); + END; + + BEGIN + PUT (CURRENT_INPUT, X); + FAILED ("MODE_ERROR NOT RAISED - CURRENT_INPUT"); + EXCEPTION + WHEN MODE_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - CURRENT_INPUT"); + END; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3906B; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3906c.ada b/gcc/testsuite/ada/acats/tests/ce/ce3906c.ada new file mode 100644 index 000000000..0cf93a451 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3906c.ada @@ -0,0 +1,177 @@ +-- CE3906C.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 PUT FOR ENUMERATION TYPES OUTPUTS THE ENUMERATION +-- LITERAL WITH NO TRAILING OR PRECEDING BLANKS WHEN WIDTH IS +-- NOT SPECIFIED OR IS SPECIFIED TO BE LESS THAN OR EQUAL TO THE +-- LENGTH OF THE STRING. CHECK THAT WHEN WIDTH IS SPECIFIED TO +-- BE GREATER THAN THE LENGTH OF THE STRING, TRAILING BLANKS ARE +-- OUTPUT. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT +-- TEXT FILES. + +-- HISTORY: +-- SPS 10/08/82 +-- SPS 01/03/83 +-- VKG 01/07/83 +-- JBG 02/22/84 CHANGED TO .ADA TEST. +-- TBN 11/10/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/18/87 REMOVED CALL TO CHECKFILE. CLOSED AND REOPENED +-- FILE AND CHECKED CONTENTS OF FILE USING +-- ENUMERATION_IO GETS. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3906C IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3906C", "CHECK THAT ENUMERATION_IO PUT OUTPUTS " & + "ENUMERATION LITERALS CORRECTLY WITH AND " & + "WITHOUT WIDTH PARAMETERS"); + + DECLARE + FT : FILE_TYPE; + TYPE MOOD IS (ANGRY, HAPPY, BORED, SAD); + X : MOOD := BORED; + PACKAGE MOOD_IO IS NEW ENUMERATION_IO (MOOD); + CH : CHARACTER; + USE MOOD_IO; + BEGIN + + BEGIN + CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + WHEN NAME_ERROR => + NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & + "WITH OUT_FILE MODE"); + RAISE INCOMPLETE; + END; + + DEFAULT_WIDTH := FIELD(IDENT_INT(5)); + + IF DEFAULT_WIDTH /= FIELD(IDENT_INT(5)) THEN + FAILED ("DEFAULT_WIDTH NOT SET CORRECTLY"); + END IF; + + PUT (FT, X, 3); -- BORED + X := HAPPY; + NEW_LINE(FT); + PUT (FILE => FT, ITEM => X, WIDTH => 5); -- HAPPY + NEW_LINE (FT); + PUT (FT, SAD, 5); -- SAD + DEFAULT_WIDTH := FIELD(IDENT_INT(6)); + PUT (FT, X); -- HAPPY + PUT (FT, SAD, 3); -- SAD + NEW_LINE(FT); + DEFAULT_WIDTH := FIELD(IDENT_INT(2)); + PUT (FT, SAD); -- SAD + + CLOSE (FT); + + BEGIN + OPEN (FT, IN_FILE, LEGAL_FILE_NAME); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN FOR " & + "IN_FILE MODE"); + RAISE INCOMPLETE; + END; + + GET (FT, X); + IF X /= BORED THEN + FAILED ("BORED NOT READ CORRECTLY"); + END IF; + + GET (FT, X); + IF X /= HAPPY THEN + FAILED ("HAPPY NOT READ CORRECTLY - 1"); + END IF; + + SKIP_LINE (FT); + + GET (FT, X); + IF X /= SAD THEN + FAILED ("SAD NOT READ CORRECTLY - 1"); + END IF; + + GET (FT, CH); + IF CH /= ' ' THEN + FAILED ("BLANKS NOT POSITIONED CORRECTLY - 1"); + END IF; + + GET (FT, CH); + IF CH /= ' ' THEN + FAILED ("BLANKS NOT POSITIONED CORRECTLY - 2"); + END IF; + + GET (FT, X); + IF X /= HAPPY THEN + FAILED ("HAPPY NOT READ CORRECTLY - 2"); + END IF; + + GET (FT, CH); + IF CH /= ' ' THEN + FAILED ("BLANKS NOT POSITIONED CORRECTLY - 3"); + END IF; + + GET (FT, X); + IF X /= SAD THEN + FAILED ("SAD NOT READ CORRECTLY - 2"); + END IF; + + SKIP_LINE (FT); + + GET (FT, X); + IF X /= SAD THEN + FAILED ("SAD NOT READ CORRECTLY - 3"); + END IF; + + BEGIN + DELETE (FT); + EXCEPTION + WHEN USE_ERROR => + NULL; + END; + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3906C; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3906d.ada b/gcc/testsuite/ada/acats/tests/ce/ce3906d.ada new file mode 100644 index 000000000..954b4f8df --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3906d.ada @@ -0,0 +1,152 @@ +-- CE3906D.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 CONSTRAINT_ERROR IS RAISED BY PUT FOR ENUMERATION +-- TYPES WHEN THE VALUE OF WIDTH IS NEGATIVE, WHEN WIDTH IS +-- GREATER THAN FIELD'LAST, OR WHEN THE VALUE OF ITEM IS OUTSIDE +-- THE RANGE OF THE SUBTYPE USED TO INSTANTIATE ENUMERATION_IO. + +-- HISTORY: +-- SPS 10/08/82 +-- DWC 09/17/87 ADDED CASES FOR CONSTRAINT_ERROR. +-- JRL 06/07/96 Added call to Ident_Int in expressions involving +-- Field'Last, to make the expressions non-static and +-- prevent compile-time rejection. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3906D IS +BEGIN + + TEST ("CE3906D", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY PUT " & + "FOR ENUMERATION TYPES WHEN THE VALUE OF " & + "WIDTH IS NEGATIVE, WHEN WIDTH IS GREATER " & + "THAN FIELD'LAST, OR WHEN THE VALUE OF ITEM " & + "IS OUTSIDE THE RANGE OF THE SUBTYPE USED TO " & + "INSTANTIATE ENUMERATION_IO"); + + DECLARE + FT : FILE_TYPE; + TYPE DAY IS (SUNDAY, MONDAY, TUESDAY, WEDNESDAY, + THURSDAY, FRIDAY, SATURDAY); + TODAY : DAY := FRIDAY; + SUBTYPE WEEKDAY IS DAY RANGE MONDAY .. FRIDAY; + PACKAGE DAY_IO IS NEW ENUMERATION_IO (WEEKDAY); + USE DAY_IO; + BEGIN + + BEGIN + PUT (FT, TODAY, -1); + FAILED ("CONSTRAINT_ERROR NOT RAISED; NEGATIVE " & + "WIDTH - FILE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("RAISED STATUS_ERROR"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED; NEGATIVE " & + "WIDTH - FILE"); + END; + + IF FIELD'LAST < INTEGER'LAST THEN + BEGIN + PUT (FT, TODAY, FIELD'LAST + Ident_Int(1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED; WIDTH " & + "GREATER THAN FIELD'LAST + 1- FILE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED; WIDTH " & + "GREATER THAN FIELD'LAST + 1 - FILE"); + END; + + BEGIN + PUT (TODAY, FIELD'LAST + Ident_Int(1)); + FAILED ("CONSTRAINT_ERROR NOT RAISED; WIDTH " & + "GREATER THAN FIELD'LAST + 1 - DEFAULT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED; WIDTH " & + "GREATER THAN FIELD'LAST + 1 " & + "- DEFAULT"); + END; + + END IF; + + TODAY := SATURDAY; + + BEGIN + PUT (FT, TODAY); + FAILED ("CONSTRAINT_ERROR NOT RAISED; ITEM VALUE " & + "OUT OF RANGE - FILE"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED; ITEM VALUE " & + "OUT OF RANGE - FILE"); + END; + + TODAY := FRIDAY; + + BEGIN + PUT (TODAY, -3); + FAILED ("CONSTRAINT_ERROR NOT RAISED; NEGATIVE " & + "WIDTH - DEFAULT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN STATUS_ERROR => + FAILED ("RAISED STATUS_ERROR"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED; NEGATIVE " & + "WIDTH - DEFAULT"); + END; + + TODAY := SATURDAY; + + BEGIN + PUT (TODAY); + FAILED ("CONSTRAINT_ERROR NOT RAISED; ITEM VALUE " & + "OUT OF RANGE - DEFAULT"); + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED; ITEM VALUE " & + "OUT OF RANGE - DEFAULT"); + END; + END; + + RESULT; + +END CE3906D; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3906e.ada b/gcc/testsuite/ada/acats/tests/ce/ce3906e.ada new file mode 100644 index 000000000..29ac3ea7b --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3906e.ada @@ -0,0 +1,109 @@ +-- CE3906E.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. +--* +-- HISTORY: +-- CHECK THAT PUT FOR ENUMERATION TYPES RAISES LAYOUT_ERROR WHEN +-- THE NUMBER OF CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE +-- LENGTH. CHECK THAT LAYOUT_ERROR IS NOT RAISED WHEN THE NUMBER +-- OF CHARACTERS TO BE OUTPUT DOES NOT EXCEED THE MAXIMUM LINE +-- LENGTH, BUT WHEN ADDED TO THE CURRENT COLUMN NUMBER, THE TOTAL +-- EXCEEDS THE MAXIMUM LINE LENGTH. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMETATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- SPS 10/11/82 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/18/87 CORRECTED EXCEPTION HANDLING. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; +WITH CHECK_FILE; + +PROCEDURE CE3906E IS + INCOMPLETE : EXCEPTION; + +BEGIN + + TEST ("CE3906E", "CHECK THAT ENUMERATION_IO PUT RAISES " & + "LAYOUT_ERROR CORRECTLY"); + + DECLARE + FT : FILE_TYPE; + TYPE COLOR IS (RED, BLU, YELLOW, ORANGE, RD); + PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR); + USE COLOR_IO; + CRAYON : COLOR := ORANGE; + BEGIN + + BEGIN + CREATE (FT); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "CREATE FOR TEMP FILES WITH " & + "OUT_FILE MODE - 1"); + RAISE INCOMPLETE; + END; + + SET_LINE_LENGTH (FT, 5); + + BEGIN + PUT (FT, CRAYON); + FAILED("LAYOUT_ERROR NOT RAISED"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED"); + END; + + PUT (FT, RED); + + PUT (FT, BLU); + IF LINE (FT) /= 2 THEN + FAILED ("PUT DID NOT CAUSE NEW_LINE EFFECT"); + END IF; + + PUT (FT, RD); + + CHECK_FILE (FT, "RED#" & + "BLURD#@%"); + + CLOSE (FT); + + EXCEPTION + WHEN INCOMPLETE => + NULL; + END; + + RESULT; + +END CE3906E; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3906f.ada b/gcc/testsuite/ada/acats/tests/ce/ce3906f.ada new file mode 100644 index 000000000..484514b73 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3906f.ada @@ -0,0 +1,102 @@ +-- CE3906F.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 THE SET PARAMETER AFFECTS THE CASE OF IDENTIFIERS, +-- BUT NOT CHARACTER LITERALS. CHECK THAT CHARACTER LITERALS ARE +-- ENCLOSED IN APOSTROPHES. + +-- APPLICABILITY CRITERIA: +-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH +-- SUPPORT TEXT FILES. + +-- HISTORY: +-- JBG 12/30/82 +-- VKG 01/12/83 +-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE +-- RESULT WHEN FILES ARE NOT SUPPORTED. +-- DWC 09/18/87 CORRECTED EXCEPTION HANDLING. + +WITH TEXT_IO; USE TEXT_IO; +WITH REPORT; USE REPORT; +WITH CHECK_FILE; + +PROCEDURE CE3906F IS + + TYPE ENUM IS (REDISH,GREENISH,YELLOWISH); + PACKAGE ENUM_IO IS NEW ENUMERATION_IO(ENUM); + PACKAGE CHAR_IO IS NEW ENUMERATION_IO(CHARACTER); + USE ENUM_IO; USE CHAR_IO; + INCOMPLETE : EXCEPTION; + FT : FILE_TYPE; + +BEGIN + + TEST ("CE3906F", "CHECK THE CASE OF ENUMERATION IO OUTPUT"); + + BEGIN + CREATE (FT); + EXCEPTION + WHEN USE_ERROR => + NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & + "CREATE FOR TEMP FILE WITH " & + "OUT_FILE MODE - 1"); + RAISE INCOMPLETE; + END; + + IF ENUM_IO.DEFAULT_WIDTH /= 0 THEN + FAILED ("INITIAL DEFAULT WIDTH INCORRECT"); + END IF; + + IF CHAR_IO.DEFAULT_SETTING /= UPPER_CASE THEN + FAILED ("INITIAL DEFAULT_SETTING INCORRECT"); + END IF; + + PUT (FT, 'A', SET => LOWER_CASE); + NEW_LINE (FT); + PUT (FT, 'a', SET => LOWER_CASE); + NEW_LINE (FT); + PUT (FT, REDISH, SET => LOWER_CASE); + NEW_LINE (FT); + ENUM_IO.DEFAULT_SETTING := LOWER_CASE; + CHAR_IO.PUT (FT, 'C'); + NEW_LINE (FT); + CHAR_IO.PUT (FT, 'b'); + NEW_LINE (FT); + PUT (FT, REDISH); + NEW_LINE (FT); + PUT (FT, GREENISH, SET => LOWER_CASE); + NEW_LINE (FT); + PUT (FT, YELLOWISH, SET => UPPER_CASE); + + CHECK_FILE (FT, "'A'#'a'#redish#'C'#'b'#redish#greenish#" + & "YELLOWISH#@%"); + + RESULT; + +EXCEPTION + WHEN INCOMPLETE => + RESULT; + +END CE3906F; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3907a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3907a.ada new file mode 100644 index 000000000..0765c4277 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3907a.ada @@ -0,0 +1,75 @@ +-- CE3907A.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 PUT FOR ENUMERATION TYPES CAN BE APPLIED TO A STRING. +-- CHECK THAT IT RAISES LAYOUT_ERROR WHEN THE ENUMERATION LITERAL TO BE +-- PLACED IN THE STRING IS LONGER THAN THE STRING. + +-- SPS 10/11/82 +-- JBG 2/22/84 CHANGED TO .ADA TEST + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3907A IS +BEGIN + + TEST ("CE3907A", "CHECK THAT ENUMERATION_IO PUT OPERATES ON " & + "STRINGS CORRECTLY"); + + DECLARE + TYPE COLOR IS (RED, BLUE, GREEN); + ST : STRING (1..4); + PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR); + USE COLOR_IO; + CRAYON : COLOR := GREEN; + BEGIN + PUT (ST, RED); + IF ST /= "RED " THEN + FAILED ("PUT TO STRING, LENGTH LESS THAN STRING " & + "INCORRECT"); + END IF; + + PUT (ST, BLUE); + IF ST /= "BLUE" THEN + FAILED ("PUT TO STRING, LENGTH EQUAL TO STRING " & + "INCORRECT"); + END IF; + + BEGIN + PUT (ST, CRAYON); + FAILED ("LAYOUT_ERROR NOT RAISED"); + EXCEPTION + WHEN LAYOUT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED"); + END; + + END; + + RESULT; +END CE3907A; diff --git a/gcc/testsuite/ada/acats/tests/ce/ce3908a.ada b/gcc/testsuite/ada/acats/tests/ce/ce3908a.ada new file mode 100644 index 000000000..44c3954da --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ce/ce3908a.ada @@ -0,0 +1,140 @@ +-- CE3908A.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 GET FOR ENUMERATION TYPES CAN OPERATE ON STRINGS. +-- CHECK THAT IT RAISES END_ERROR WHEN THE STRING IS NULL OR +-- EMPTY. CHECK THAT LAST CONTAINS THE INDEX VALUE OF THE LAST +-- CHARACTER READ FROM THE STRING. + +-- HISTORY: +-- SPS 10/11/82 +-- VKG 01/06/83 +-- JBG 02/22/84 CHANGED TO .ADA TEST +-- DWC 09/18/87 ADDED CASES WHICH CONTAIN TABS WITH AND WITHOUT +-- ENUMERATION LITERALS. + +WITH REPORT; +USE REPORT; +WITH TEXT_IO; +USE TEXT_IO; + +PROCEDURE CE3908A IS +BEGIN + + TEST ("CE3908A", "CHECK THAT GET FOR ENUMERATION TYPES CAN " & + "OPERATE ON STRINGS. CHECK THAT IT RAISES " & + "END_ERROR WHEN THE STRING IS NULL OR EMPTY. " & + "CHECK THAT LAST CONTAINS THE INDEX VALUE OF " & + "THE LAST CHARACTER READ FROM THE STRING"); + + DECLARE + TYPE FRUIT IS (APPLE, PEAR, ORANGE, STRAWBERRY); + DESSERT : FRUIT; + PACKAGE FRUIT_IO IS NEW ENUMERATION_IO (FRUIT); + USE FRUIT_IO; + L : POSITIVE; + BEGIN + GET ("APPLE ", DESSERT, L); + IF DESSERT /= APPLE THEN + FAILED ("ENUMERATION VALUE FROM STRING INCORRECT - 1"); + END IF; + + IF L /= IDENT_INT (5) THEN + FAILED ("LAST CONTAINS INCORRECT VALUE AFTER GET - 1"); + END IF; + + GET ("APPLE", DESSERT, L); + IF DESSERT /= APPLE THEN + FAILED ("ENUMERATION VALUE FROM STRING INCORRECT - 2"); + END IF; + + IF L /= IDENT_INT (5) THEN + FAILED ("LAST CONTAINS INCORRECT VALUE AFTER GET - 2"); + END IF; + + BEGIN + GET (ASCII.HT & "APPLE", DESSERT, L); + IF DESSERT /= APPLE THEN + FAILED ("ENUMERATION VALUE FROM STRING " & + "INCORRECT - 3"); + END IF; + IF L /= IDENT_INT(6) THEN + FAILED ("LAST CONTAINS INCORRECT VALUE AFTER " & + "GET - 3"); + END IF; + EXCEPTION + WHEN END_ERROR => + FAILED ("GET DID NOT SKIP LEADING TABS"); + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 3"); + END; + +-- NULL STRING LITERAL. + + BEGIN + GET ("", DESSERT, L); + FAILED ("END_ERROR NOT RAISED - 4"); + EXCEPTION + WHEN END_ERROR => + IF L /= IDENT_INT(6) THEN + FAILED ("LAST CONTAINS INCORRECT VALUE " & + "AFTER GET - 4"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 4"); + END; + + BEGIN + GET (ASCII.HT & "", DESSERT, L); + FAILED ("END_ERROR NOT RAISED - 5"); + EXCEPTION + WHEN END_ERROR => + IF L /= IDENT_INT(6) THEN + FAILED ("LAST CONTAINS INCORRECT VALUE " & + "AFTER GET - 5"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 5"); + END; + +-- STRING LITERAL WITH BLANKS. + + BEGIN + GET(" ", DESSERT, L); + FAILED ("END ERROR NOT RAISED - 6"); + EXCEPTION + WHEN END_ERROR => + IF L /= IDENT_INT(6) THEN + FAILED ("LAST CONTAINS INCORRECT VALUE " & + "AFTER GET - 6"); + END IF; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED - 6"); + END; + + END; + + RESULT; +END CE3908A; |