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;
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
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 (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
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;
CLOSE (FILE1);
OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
BEGIN
GET (FILE1, NST);
EXCEPTION
WHEN OTHERS =>
FAILED (" GET FAILED ON NULL STRING");
END;
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;