← DL-Pascal collectioncov09.pas
DOWNLOAD ORIGINAL FILE
{ DL-Pascal Coverage Section 9: Sets and Files }
{ Sets: construction, IN, +, -, *, comparison. }
{ Files: text files (Assign/Reset/Rewrite/Close/Eof), }
{ typed files (Seek/FilePos/FileSize), IOResult, }
{ Append, Rename, Erase, BlockRead/Write. }
{ Expected: runs without error, displays results. }
{$D-C-R-}
PROGRAM Section9;
TYPE
TByteSet = SET OF Byte;
TCharSet = SET OF Char;
TSmallSet = SET OF 0..15;
TDigits = SET OF '0'..'9';
VAR
s1, s2, s3 : TByteSet;
cs : TCharSet;
ss : TSmallSet;
i, j : Integer;
b : Boolean;
c : Char;
code : Byte;
{ File variables }
tf : Text;
rf : FILE OF Integer;
uf : FILE;
n : Integer;
s : STRING[80];
buf : ARRAY[0..63] OF Char;
rd : Word;
PROCEDURE Check(msg : STRING; passed : Boolean);
BEGIN
IF passed THEN
WriteLn('OK ', msg)
ELSE
WriteLn('FAIL ', msg);
END;
{ ==== SETS ==== }
{ ---- Set construction and IN ---- }
PROCEDURE TestSetBasic;
BEGIN
{ Literal set }
s1 := [1, 3, 5, 7, 9];
Check('IN 1', 1 IN s1);
Check('IN 3', 3 IN s1);
Check('NOT IN 2', NOT (2 IN s1));
Check('NOT IN 0', NOT (0 IN s1));
{ Range set }
s1 := [1..5];
Check('Range IN 1', 1 IN s1);
Check('Range IN 5', 5 IN s1);
Check('Range !IN 6',NOT (6 IN s1));
Check('Range !IN 0',NOT (0 IN s1));
{ Empty set }
s1 := [];
Check('Empty set', NOT (0 IN s1));
Check('Empty set 5',NOT (5 IN s1));
{ Full byte range }
s1 := [0..255];
Check('Full IN 0', 0 IN s1);
Check('Full IN 128', 128 IN s1);
Check('Full IN 255', 255 IN s1);
{ Char set }
cs := ['A'..'Z'];
Check('Char IN A', 'A' IN cs);
Check('Char IN Z', 'Z' IN cs);
Check('Char !IN a', NOT ('a' IN cs));
Check('Char !IN 0', NOT ('0' IN cs));
cs := ['0'..'9', 'A'..'F'];
Check('Hex IN 0', '0' IN cs);
Check('Hex IN F', 'F' IN cs);
Check('Hex IN 9', '9' IN cs);
Check('Hex !IN G', NOT ('G' IN cs));
END;
{ ---- Set operators ---- }
PROCEDURE TestSetOps;
BEGIN
s1 := [1, 2, 3, 4, 5];
s2 := [3, 4, 5, 6, 7];
{ Union }
s3 := s1 + s2;
Check('Union 1', 1 IN s3);
Check('Union 6', 6 IN s3);
Check('Union 3', 3 IN s3);
Check('Union !8', NOT (8 IN s3));
{ Intersection }
s3 := s1 * s2;
Check('Inter 3', 3 IN s3);
Check('Inter 5', 5 IN s3);
Check('Inter !2', NOT (2 IN s3));
Check('Inter !6', NOT (6 IN s3));
{ Difference }
s3 := s1 - s2;
Check('Diff 1', 1 IN s3);
Check('Diff 2', 2 IN s3);
Check('Diff !3', NOT (3 IN s3));
Check('Diff !6', NOT (6 IN s3));
{ Reverse difference }
s3 := s2 - s1;
Check('RDiff 6', 6 IN s3);
Check('RDiff 7', 7 IN s3);
Check('RDiff !3', NOT (3 IN s3));
END;
{ ---- Set comparisons ---- }
PROCEDURE TestSetCompare;
BEGIN
s1 := [1, 2, 3];
s2 := [1, 2, 3];
s3 := [1, 2, 3, 4];
{ Equality }
Check('Set =', s1 = s2);
Check('Set <>', s1 <> s3);
{ Subset: s1 <= s3 means s1 is subset of s3 }
Check('Subset <=', s1 <= s3);
Check('Subset =', s1 <= s2); { equal sets are subsets }
Check('Not subset', NOT (s3 <= s1));
{ Superset: s3 >= s1 }
Check('Super >=', s3 >= s1);
Check('Not super', NOT (s1 >= s3));
{ Empty set is subset of everything }
s2 := [];
Check('Empty sub', s2 <= s1);
END;
{ ---- Set in loops and conditions ---- }
PROCEDURE TestSetUsage;
VAR vowels : TCharSet;
count : Integer;
BEGIN
vowels := ['A','E','I','O','U','a','e','i','o','u'];
s := 'Hello World';
count := 0;
FOR i := 1 TO Length(s) DO
IF s[i] IN vowels THEN Inc(count);
Check('Vowel count', count = 3); { e, o, o }
{ CASE with set â simulate via IN }
i := 5;
IF i IN [1,3,5,7,9] THEN b := True ELSE b := False;
Check('Set odd', b);
i := 4;
IF i IN [1,3,5,7,9] THEN b := True ELSE b := False;
Check('Set even', NOT b);
{ Build set dynamically }
ss := [];
FOR i := 0 TO 15 DO
IF Odd(i) THEN ss := ss + [i];
Check('Dyn set 1', 1 IN ss);
Check('Dyn set 3', 3 IN ss);
Check('Dyn set !2', NOT (2 IN ss));
Check('Dyn set 15', 15 IN ss);
END;
{ ==== FILES ==== }
{ ---- Text file write and read ---- }
PROCEDURE TestTextFile;
BEGIN
{ Write a text file }
Assign(tf, 'TEST.TXT');
Rewrite(tf);
WriteLn(tf, 'Line one');
WriteLn(tf, 'Line two');
WriteLn(tf, 'Line three');
Write(tf, 42);
WriteLn(tf);
Close(tf);
Check('Text write', True);
{ Read it back }
Reset(tf);
ReadLn(tf, s);
Check('Text read 1', s = 'Line one');
ReadLn(tf, s);
Check('Text read 2', s = 'Line two');
ReadLn(tf, s);
Check('Text read 3', s = 'Line three');
ReadLn(tf, n);
Check('Text read int', n = 42);
Check('Text Eof', Eof(tf));
Close(tf);
END;
{ ---- Eof / Eoln ---- }
PROCEDURE TestEofEoln;
BEGIN
Assign(tf, 'EOLN.TXT');
Rewrite(tf);
WriteLn(tf, 'ABC');
WriteLn(tf, 'DE');
Close(tf);
Reset(tf);
{ First line: A B C EOL }
Read(tf, c); Check('Eoln char A', c = 'A');
Check('Not Eoln A', NOT Eoln(tf));
Read(tf, c); { B }
Read(tf, c); { C }
Check('Eoln after C', Eoln(tf));
ReadLn(tf); { skip to next line }
Check('Not Eof L2', NOT Eof(tf));
ReadLn(tf, s);
Check('Eof at end', Eof(tf));
Close(tf);
{ Cleanup }
Assign(tf, 'EOLN.TXT');
{$I-} Erase(tf); {$I+}
END;
{ ---- Append ---- }
PROCEDURE TestAppend;
BEGIN
Assign(tf, 'APND.TXT');
Rewrite(tf);
WriteLn(tf, 'First');
Close(tf);
Append(tf);
WriteLn(tf, 'Second');
Close(tf);
Reset(tf);
ReadLn(tf, s); Check('Append line 1', s = 'First');
ReadLn(tf, s); Check('Append line 2', s = 'Second');
Check('Append Eof', Eof(tf));
Close(tf);
{$I-} Erase(tf); {$I+}
END;
{ ---- IOResult ---- }
PROCEDURE TestIOResult;
VAR errCode : Integer;
BEGIN
{ Try to open non-existent file }
Assign(tf, 'NOFILE.XYZ');
{$I-}
Reset(tf);
errCode := IOResult;
{$I+}
Check('IOResult error', errCode <> 0);
WriteLn(' IOResult: ', errCode);
{ After IOResult read, next call returns 0 }
errCode := IOResult;
Check('IOResult clear', errCode = 0);
{ Successful operation gives 0 }
Assign(tf, 'TEST.TXT');
{$I-}
Reset(tf);
errCode := IOResult;
{$I+}
Check('IOResult ok', errCode = 0);
Close(tf);
END;
{ ---- Typed file ---- }
PROCEDURE TestTypedFile;
VAR
tf2 : FILE OF Integer;
val : Integer;
BEGIN
{ Write 10 integers }
Assign(tf2, 'INT.DAT');
Rewrite(tf2);
FOR i := 1 TO 10 DO Write(tf2, i);
Close(tf2);
{ Read back }
Reset(tf2);
Check('TFile size', FileSize(tf2) = 10);
Check('TFile pos0', FilePos(tf2) = 0);
Read(tf2, val);
Check('TFile val 1', val = 1);
Check('TFile pos1', FilePos(tf2) = 1);
{ Seek to element 5 (0-based) }
Seek(tf2, 4);
Read(tf2, val);
Check('TFile seek', val = 5);
Check('TFile pos5', FilePos(tf2) = 5);
{ Seek to end }
Seek(tf2, FileSize(tf2));
Check('TFile Eof', Eof(tf2));
Close(tf2);
{ Cleanup }
Assign(tf2, 'INT.DAT');
{$I-} Erase(tf2); {$I+}
END;
{ ---- Rename ---- }
PROCEDURE TestRename;
BEGIN
{ Create a file }
Assign(tf, 'OLD.TXT');
Rewrite(tf);
WriteLn(tf, 'rename test');
Close(tf);
{ Rename it }
Assign(tf, 'OLD.TXT');
Rename(tf, 'NEW.TXT');
Check('Rename done', True);
{ Read from new name }
Assign(tf, 'NEW.TXT');
Reset(tf);
ReadLn(tf, s);
Check('Rename read', s = 'rename test');
Close(tf);
{$I-} Erase(tf); {$I+}
End;
{ ---- Erase ---- }
PROCEDURE TestErase;
VAR errCode : Integer;
BEGIN
{ Create then erase }
Assign(tf, 'TOERASE.TXT');
Rewrite(tf);
WriteLn(tf, 'bye');
Close(tf);
Assign(tf, 'TOERASE.TXT');
Erase(tf);
Check('Erase done', True);
{ Verify gone }
{$I-}
Reset(tf);
errCode := IOResult;
{$I+}
Check('Erase verify', errCode <> 0);
END;
{ ---- Cleanup TEST.TXT ---- }
PROCEDURE Cleanup;
BEGIN
Assign(tf, 'TEST.TXT');
{$I-} Erase(tf); {$I+}
i := IOResult; { clear }
END;
{ ---- Main ---- }
BEGIN
WriteLn('=== Section 9: Sets and Files ===');
WriteLn;
WriteLn('-- Set Basic --');
TestSetBasic; WriteLn;
WriteLn('-- Set Operators --');
TestSetOps; WriteLn;
WriteLn('-- Set Compare --');
TestSetCompare; WriteLn;
WriteLn('-- Set Usage --');
TestSetUsage; WriteLn;
WriteLn('-- Text File --');
TestTextFile; WriteLn;
WriteLn('-- Eof/Eoln --');
TestEofEoln; WriteLn;
WriteLn('-- Append --');
TestAppend; WriteLn;
WriteLn('-- IOResult --');
TestIOResult; WriteLn;
WriteLn('-- Typed File --');
TestTypedFile; WriteLn;
WriteLn('-- Rename --');
TestRename; WriteLn;
WriteLn('-- Erase --');
TestErase; WriteLn;
Cleanup;
WriteLn('=== Section 9 complete ===');
END.