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;