extra/peg/pl0/pl0-tests.factor

   1 ! Copyright (C) 2007 Chris Double.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3
   4 USING: kernel tools.test peg peg.ebnf peg.ebnf.private peg.pl0
   5 sequences accessors ;
   6
   7 { t } [
   8   "CONST foo = 1;" "block" \ pl0 rule (parse) remaining>> empty?
   9 ] unit-test
  10
  11 { t } [
  12   "VAR foo;" "block" \ pl0 rule (parse) remaining>> empty?
  13 ] unit-test
  14
  15 { t } [
  16   "VAR foo,bar , baz;" "block" \ pl0 rule (parse) remaining>> empty?
  17 ] unit-test
  18
  19 { t } [
  20   "foo := 5" "statement" \ pl0 rule (parse) remaining>> empty?
  21 ] unit-test
  22
  23 { t } [
  24   "BEGIN foo := 5 END" "statement" \ pl0 rule (parse) remaining>> empty?
  25 ] unit-test
  26
  27 { t } [
  28   "IF 1=1 THEN foo := 5" "statement" \ pl0 rule (parse) remaining>> empty?
  29 ] unit-test
  30
  31 { t } [
  32   "WHILE 1=1 DO foo := 5" "statement" \ pl0 rule (parse) remaining>> empty?
  33 ] unit-test
  34
  35 { t } [
  36   "WHILE ODD 1 DO foo := 5" "statement" \ pl0 rule (parse) remaining>> empty?
  37 ] unit-test
  38
  39 { t } [
  40   "PROCEDURE square; BEGIN squ:=x*x END" "block" \ pl0 rule (parse) remaining>> empty?
  41 ] unit-test
  42
  43 { t } [
  44 "VAR x, squ;
  45
  46 PROCEDURE square;
  47 BEGIN
  48    squ := x * x
  49 END;
  50
  51 BEGIN
  52    x := 1;
  53    WHILE x <= 10 DO
  54    BEGIN
  55       CALL square;
  56       x := x + 1;
  57    END
  58 END." main \ pl0 rule (parse) remaining>> empty?
  59 ] unit-test
  60
  61 { f } [
  62 "
  63 CONST
  64   m =  7,
  65   n = 85;
  66
  67 VAR
  68   x, y, z, q, r;
  69
  70 PROCEDURE multiply;
  71 VAR a, b;
  72
  73 BEGIN
  74   a := x;
  75   b := y;
  76   z := 0;
  77   WHILE b > 0 DO BEGIN
  78     IF ODD b THEN z := z + a;
  79     a := 2 * a;
  80     b := b / 2;
  81   END
  82 END;
  83
  84 PROCEDURE divide;
  85 VAR w;
  86 BEGIN
  87   r := x;
  88   q := 0;
  89   w := y;
  90   WHILE w <= r DO w := 2 * w;
  91   WHILE w > y DO BEGIN
  92     q := 2 * q;
  93     w := w / 2;
  94     IF w <= r THEN BEGIN
  95       r := r - w;
  96       q := q + 1
  97     END
  98   END
  99 END;
 100
 101 PROCEDURE gcd;
 102 VAR f, g;
 103 BEGIN
 104   f := x;
 105   g := y;
 106   WHILE f # g DO BEGIN
 107     IF f < g THEN g := g - f;
 108     IF g < f THEN f := f - g;
 109   END;
 110   z := f
 111 END;
 112
 113 BEGIN
 114   x := m;
 115   y := n;
 116   CALL multiply;
 117   x := 25;
 118   y :=  3;
 119   CALL divide;
 120   x := 84;
 121   y := 36;
 122   CALL gcd;
 123 END.
 124 " main \ pl0 rule (parse) remaining>> empty?
 125 ] unit-test