Add match statement test suite

Author: fibodevy

tests/test/tmatch1.pp

@@ -0,0 +1,55 @@
+{$mode unleashed}
+{ match statement: basic first-match with ordinal and string subjects }
+program tmatch1;
+
+procedure TestOrdinal;
+var
+  x: Integer;
+  r: Integer;
+begin
+  x := 2;
+  r := 0;
+  match x of
+    1: r := 10;
+    2: r := 20;
+    3: r := 30;
+  end;
+  if r <> 20 then Halt(1);
+end;
+
+procedure TestString;
+var
+  s: String;
+  r: Integer;
+begin
+  s := 'hello';
+  r := 0;
+  match s of
+    'world': r := 1;
+    'hello': r := 2;
+    'foo':   r := 3;
+  end;
+  if r <> 2 then Halt(2);
+end;
+
+procedure TestFirstMatch;
+var
+  x: Integer;
+  r: Integer;
+begin
+  { first-match: only first matching branch executes }
+  x := 5;
+  r := 0;
+  match x of
+    5: r := r + 1;
+    5: r := r + 10;
+  end;
+  if r <> 1 then Halt(3);
+end;
+
+begin
+  TestOrdinal;
+  TestString;
+  TestFirstMatch;
+  WriteLn('OK');
+end.

tests/test/tmatch2.pp

@@ -0,0 +1,51 @@
+{$mode unleashed}
+{ match statement: else and _ catch-all }
+program tmatch2;
+
+procedure TestElse;
+var
+  x, r: Integer;
+begin
+  x := 99;
+  r := 0;
+  match x of
+    1: r := 10;
+    2: r := 20;
+  else
+    r := 999;
+  end;
+  if r <> 999 then Halt(1);
+end;
+
+procedure TestUnderscore;
+var
+  x, r: Integer;
+begin
+  x := 42;
+  r := 0;
+  match x of
+    1: r := 10;
+    _: r := 100;
+  end;
+  if r <> 100 then Halt(2);
+end;
+
+procedure TestUnderscoreSkipsOnMatch;
+var
+  x, r: Integer;
+begin
+  x := 1;
+  r := 0;
+  match x of
+    1: r := 10;
+    _: r := 100;
+  end;
+  if r <> 10 then Halt(3);
+end;
+
+begin
+  TestElse;
+  TestUnderscore;
+  TestUnderscoreSkipsOnMatch;
+  WriteLn('OK');
+end.

tests/test/tmatch3.pp

@@ -0,0 +1,55 @@
+{$mode unleashed}
+{ match all: fallthrough mode and leave }
+program tmatch3;
+
+procedure TestFallthrough;
+var
+  x, r: Integer;
+begin
+  x := 5;
+  r := 0;
+  match all x of
+    5: r := r + 1;
+    5: r := r + 10;
+    3: r := r + 100;
+  end;
+  { both x=5 branches fire, x=3 does not }
+  if r <> 11 then Halt(1);
+end;
+
+procedure TestFallthroughCatchAll;
+var
+  x, r: Integer;
+begin
+  x := 1;
+  r := 0;
+  match all x of
+    1: r := r + 1;
+    2: r := r + 10;
+    _: r := r + 100;
+  end;
+  { x=1 matches, x=2 does not, _ always matches }
+  if r <> 101 then Halt(2);
+end;
+
+procedure TestLeave;
+var
+  x, r: Integer;
+begin
+  x := 5;
+  r := 0;
+  match all x of
+    5: begin r := r + 1; leave; end;
+    5: r := r + 10;
+    _: r := r + 100;
+  end;
+  { leave exits after first branch }
+  if r <> 1 then Halt(3);
+end;
+
+begin
+  TestFallthrough;
+  TestFallthroughCatchAll;
+  TestLeave;
+  WriteLn('OK');
+end.

tests/test/tmatch4.pp

@@ -0,0 +1,54 @@
+{$mode unleashed}
+{ match without of: condition-based matching }
+program tmatch4;
+
+procedure TestFirstMatch;
+var
+  x, r: Integer;
+begin
+  x := 50;
+  r := 0;
+  match
+    x > 100: r := 1;
+    x > 10:  r := 2;
+    x > 0:   r := 3;
+    _:       r := 4;
+  end;
+  { first-match: x=50 matches x>10 first }
+  if r <> 2 then Halt(1);
+end;
+
+procedure TestFallthrough;
+var
+  x, r: Integer;
+begin
+  x := 50;
+  r := 0;
+  match all
+    x > 100: r := r + 1;
+    x > 10:  r := r + 10;
+    x > 0:   r := r + 100;
+  end;
+  { x=50: x>10 and x>0 match }
+  if r <> 110 then Halt(2);
+end;
+
+procedure TestCatchAll;
+var
+  x, r: Integer;
+begin
+  x := -5;
+  r := 0;
+  match
+    x > 0: r := 1;
+    _:     r := 99;
+  end;
+  if r <> 99 then Halt(3);
+end;
+
+begin
+  TestFirstMatch;
+  TestFallthrough;
+  TestCatchAll;
+  WriteLn('OK');
+end.

tests/test/tmatch5.pp

@@ -0,0 +1,52 @@
+{$mode unleashed}
+{ match: comma-separated patterns (OR) }
+program tmatch5;
+
+procedure TestComma;
+var
+  x, r: Integer;
+begin
+  x := 3;
+  r := 0;
+  match x of
+    1, 2, 3: r := 10;
+    4, 5, 6: r := 20;
+    _:       r := 99;
+  end;
+  if r <> 10 then Halt(1);
+end;
+
+procedure TestCommaSecondGroup;
+var
+  x, r: Integer;
+begin
+  x := 5;
+  r := 0;
+  match x of
+    1, 2, 3: r := 10;
+    4, 5, 6: r := 20;
+    _:       r := 99;
+  end;
+  if r <> 20 then Halt(2);
+end;
+
+procedure TestCommaNoMatch;
+var
+  x, r: Integer;
+begin
+  x := 100;
+  r := 0;
+  match x of
+    1, 2, 3: r := 10;
+    4, 5, 6: r := 20;
+    _:       r := 99;
+  end;
+  if r <> 99 then Halt(3);
+end;
+
+begin
+  TestComma;
+  TestCommaSecondGroup;
+  TestCommaNoMatch;
+  WriteLn('OK');
+end.

tests/test/tmatch6.pp

@@ -0,0 +1,54 @@
+{$mode unleashed}
+{ match as expression }
+program tmatch6;
+
+procedure TestBasic;
+var
+  x: Integer;
+  s: String;
+begin
+  x := 2;
+  s := match x of
+    1: 'one';
+    2: 'two';
+    3: 'three';
+    _: 'other';
+  end;
+  if s <> 'two' then Halt(1);
+end;
+
+procedure TestWithElse;
+var
+  x: Integer;
+  s: String;
+begin
+  x := 99;
+  s := match x of
+    1: 'one';
+    2: 'two';
+  else
+    'unknown'
+  end;
+  if s <> 'unknown' then Halt(2);
+end;
+
+procedure TestConditionBased;
+var
+  x: Integer;
+  s: String;
+begin
+  x := 50;
+  s := match
+    x > 100: 'big';
+    x > 10:  'medium';
+    _:       'small';
+  end;
+  if s <> 'medium' then Halt(3);
+end;
+
+begin
+  TestBasic;
+  TestWithElse;
+  TestConditionBased;
+  WriteLn('OK');
+end.