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;