← DL-Pascal collection

cov04.pas

DOWNLOAD ORIGINAL FILE

{ DL-Pascal Coverage Section 4: Strings           }
{ Exercises all string operations: Copy, Delete,  }
{ Insert, Pos, Length, Concat, Str, Val, UpCase,  }
{ string comparisons, indexing, and edge cases.   }
{ Expected: runs without error, displays results. }
{$D-C-R-}

PROGRAM Section4;

VAR
  s, t, u : STRING[80];
  i, j    : Integer;
  r       : Real;
  b       : Boolean;
  c       : Char;
  code    : Byte;

PROCEDURE Check(msg : STRING; passed : Boolean);
BEGIN
  IF passed THEN
    WriteLn('OK   ', msg)
  ELSE
    WriteLn('FAIL ', msg);
END;

{ ---- Length ---- }
PROCEDURE TestLength;
BEGIN
  Check('Len empty',    Length('') = 0);
  Check('Len 1',        Length('A') = 1);
  Check('Len hello',    Length('Hello') = 5);
  Check('Len spaces',   Length('   ') = 3);
  s := 'DL-Pascal';
  Check('Len var',      Length(s) = 9);
END;

{ ---- Concatenation ---- }
PROCEDURE TestConcat;
BEGIN
  s := 'Hello' + ' ' + 'World';
  Check('Concat +',       s = 'Hello World');

  s := Concat('AB', 'CD', 'EF');
  Check('Concat func',    s = 'ABCDEF');

  s := '' + 'X';
  Check('Concat empty L', s = 'X');

  s := 'X' + '';
  Check('Concat empty R', s = 'X');

  { Build string in loop }
  s := '';
  FOR i := 1 TO 5 DO s := s + 'x';
  Check('Concat loop',    s = 'xxxxx');
  Check('Concat loop len',Length(s) = 5);
END;

{ ---- Copy ---- }
PROCEDURE TestCopy;
BEGIN
  s := 'Hello World';
  t := Copy(s, 1, 5);
  Check('Copy start',     t = 'Hello');

  t := Copy(s, 7, 5);
  Check('Copy mid',       t = 'World');

  t := Copy(s, 7, 99);
  Check('Copy past end',  t = 'World');

  t := Copy(s, 1, 0);
  Check('Copy zero len',  t = '');

  t := Copy(s, 3, 3);
  Check('Copy llo',       t = 'llo');

  t := Copy('ABCDE', 2, 3);
  Check('Copy literal',   t = 'BCD');

  { Copy whole string }
  t := Copy(s, 1, Length(s));
  Check('Copy all',       t = s);
END;

{ ---- Delete ---- }
PROCEDURE TestDelete;
BEGIN
  s := 'Hello World';
  Delete(s, 6, 6);
  Check('Delete mid',     s = 'Hello');

  s := 'Hello World';
  Delete(s, 1, 6);
  Check('Delete start',   s = 'World');

  s := 'Hello World';
  Delete(s, 6, 99);
  Check('Delete to end',  s = 'Hello');

  s := 'Hello World';
  Delete(s, 1, 0);
  Check('Delete zero',    s = 'Hello World');

  s := 'A';
  Delete(s, 1, 1);
  Check('Delete all',     s = '');

  { Delete from end }
  s := 'Hello!';
  Delete(s, Length(s), 1);
  Check('Delete last',    s = 'Hello');
END;

{ ---- Insert ---- }
PROCEDURE TestInsert;
BEGIN
  s := 'Helo';
  Insert('l', s, 3);
  Check('Insert char',    s = 'Hello');

  s := 'HelloWorld';
  Insert(' ', s, 6);
  Check('Insert space',   s = 'Hello World');

  s := 'World';
  Insert('Hello ', s, 1);
  Check('Insert start',   s = 'Hello World');

  s := 'Hello';
  Insert('!', s, Length(s)+1);
  Check('Insert end',     s = 'Hello!');

  s := 'AC';
  Insert('B', s, 2);
  Check('Insert middle',  s = 'ABC');
END;

{ ---- Pos ---- }
PROCEDURE TestPos;
BEGIN
  s := 'Hello World';
  Check('Pos found',      Pos('World', s) = 7);
  Check('Pos start',      Pos('Hello', s) = 1);
  Check('Pos char',       Pos('o', s) = 5);  { first 'o' }
  Check('Pos not found',  Pos('xyz', s) = 0);
  Check('Pos empty',      Pos('', s) = 0);
  Check('Pos full',       Pos('Hello World', s) = 1);

  s := 'ABCABC';
  Check('Pos first',      Pos('BC', s) = 2);  { finds first }

  s := '';
  Check('Pos in empty',   Pos('A', s) = 0);
END;

{ ---- Str and Val ---- }
PROCEDURE TestStrVal;
BEGIN
  { Str: integer to string }
  Str(42, s);
  Check('Str int',        s = '42');

  Str(-7, s);
  Check('Str neg',        s = '-7');

  Str(0, s);
  Check('Str zero',       s = '0');

  { Str with width formatting }
  Str(42:5, s);
  Check('Str width len',  Length(s) = 5);

  { Val: string to integer }
  Val('123', i, code);
  Check('Val int',        (i = 123) AND (code = 0));

  Val('-99', i, code);
  Check('Val neg',        (i = -99) AND (code = 0));

  Val('0', i, code);
  Check('Val zero',       (i = 0) AND (code = 0));

  { Val error - code is position of bad char }
  Val('12x4', i, code);
  Check('Val error',      code <> 0);

  { Val: string to real }
  Val('3.14', r, code);
  Check('Val real',       (r > 3.13) AND (r < 3.15) AND (code = 0));

  Val('1.5E2', r, code);
  Check('Val sci',        (r = 150.0) AND (code = 0));

  { Round-trip }
  i := 12345;
  Str(i, s);
  Val(s, j, code);
  Check('Str/Val roundtrip', (j = 12345) AND (code = 0));
END;

{ ---- UpCase ---- }
PROCEDURE TestUpCase;
BEGIN
  Check('UpCase a',   UpCase('a') = 'A');
  Check('UpCase z',   UpCase('z') = 'Z');
  Check('UpCase A',   UpCase('A') = 'A');  { already upper }
  Check('UpCase 5',   UpCase('5') = '5');  { non-alpha unchanged }
  Check('UpCase spc', UpCase(' ') = ' ');

  { Convert string manually }
  s := 'Hello World';
  FOR i := 1 TO Length(s) DO
    s[i] := UpCase(s[i]);
  Check('UpCase string', s = 'HELLO WORLD');
END;

{ ---- String indexing ---- }
PROCEDURE TestIndexing;
BEGIN
  s := 'ABCDE';
  Check('Index [1]',   s[1] = 'A');
  Check('Index [3]',   s[3] = 'C');
  Check('Index [5]',   s[5] = 'E');

  { Modify via index }
  s[3] := 'X';
  Check('Index write',  s = 'ABXDE');

  { Build string by index }
  s := '     ';
  FOR i := 1 TO 5 DO s[i] := Chr(Ord('A') + i - 1);
  Check('Build by idx', s = 'ABCDE');
END;

{ ---- Comparisons ---- }
PROCEDURE TestCompare;
BEGIN
  Check('Str =',    'ABC' = 'ABC');
  Check('Str <>',   'ABC' <> 'DEF');
  Check('Str <',    'ABC' < 'ABD');
  Check('Str >',    'ABD' > 'ABC');
  Check('Str <=',   'ABC' <= 'ABC');
  Check('Str >=',   'ABC' >= 'ABC');

  { Case sensitive }
  Check('Str case', 'abc' <> 'ABC');
  Check('Str lower > upper', 'a' > 'A');

  { Length matters }
  Check('Str len <', 'ABC' < 'ABCD');
  Check('Str empty', '' < 'A');

  { Variable comparison }
  s := 'Hello'; t := 'Hello';
  Check('Var str =',  s = t);
  t := 'World';
  Check('Var str <>',  s <> t);
  Check('Var str <',   s < t);
END;

{ ---- Common patterns ---- }
PROCEDURE TestPatterns;
VAR n : Integer;
BEGIN
  { Trim right spaces }
  s := 'Hello   ';
  WHILE (Length(s) > 0) AND (s[Length(s)] = ' ') DO
    Delete(s, Length(s), 1);
  Check('Trim right',    s = 'Hello');

  { Count occurrences }
  s := 'banana'; n := 0;
  FOR i := 1 TO Length(s) DO
    IF s[i] = 'a' THEN Inc(n);
  Check('Count a in banana', n = 3);

  { Reverse a string }
  s := 'Hello'; t := '';
  FOR i := Length(s) DOWNTO 1 DO
    t := t + s[i];
  Check('Reverse',       t = 'olleH');

  { Replace first occurrence }
  s := 'Hello World';
  i := Pos('World', s);
  IF i > 0 THEN BEGIN
    Delete(s, i, 5);
    Insert('Pascal', s, i);
  END;
  Check('Replace',       s = 'Hello Pascal');

  { Split at delimiter }
  s := 'first:second';
  i := Pos(':', s);
  t := Copy(s, 1, i-1);
  u := Copy(s, i+1, Length(s));
  Check('Split left',    t = 'first');
  Check('Split right',   u = 'second');

  { Pad left with zeros }
  Str(42, s);
  WHILE Length(s) < 5 DO Insert('0', s, 1);
  Check('Pad zeros',     s = '00042');
END;

{ ---- Main ---- }
BEGIN
  WriteLn('=== Section 4: Strings ===');
  WriteLn;

  WriteLn('-- Length --');
  TestLength;
  WriteLn;

  WriteLn('-- Concat --');
  TestConcat;
  WriteLn;

  WriteLn('-- Copy --');
  TestCopy;
  WriteLn;

  WriteLn('-- Delete --');
  TestDelete;
  WriteLn;

  WriteLn('-- Insert --');
  TestInsert;
  WriteLn;

  WriteLn('-- Pos --');
  TestPos;
  WriteLn;

  WriteLn('-- Str/Val --');
  TestStrVal;
  WriteLn;

  WriteLn('-- UpCase --');
  TestUpCase;
  WriteLn;

  WriteLn('-- Indexing --');
  TestIndexing;
  WriteLn;

  WriteLn('-- Comparisons --');
  TestCompare;
  WriteLn;

  WriteLn('-- Patterns --');
  TestPatterns;
  WriteLn;

  WriteLn('=== Section 4 complete ===');
END.