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