1#!./parrot
2# Copyright (C) 2006-2010, Parrot Foundation.
3
4=head1 NAME
5
6t/compilers/pge/06-grammar.t - test some simple grammars
7
8=head1 SYNOPSIS
9
10% prove t/compilers/pge/06-grammar.t
11
12=head1 DESCRIPTION
13
14Test some simple grammars.
15
16=cut
17
18.sub main :main
19    load_bytecode 'Test/Builder.pbc'
20    load_bytecode 'PGE.pbc'
21    load_bytecode 'PGE/Perl6Grammar.pbc'
22    .include "iglobals.pasm"
23
24    .local pmc test, todo_tests, todo_desc, grammar, expr, description, test_num
25
26    # avoid name clashes in grammars with fatal method redefinition
27    test_num  = new 'Integer'
28    test_num  = 0
29    set_global 'test_num', test_num
30
31    # the test builder
32    test = new [ 'Test'; 'Builder' ]
33
34    # PMCs to store TODO tests and reasons/descriptions
35    todo_tests = new 'Hash'
36    todo_desc  = new 'Hash'
37
38    # PMCs to store grammars and expressions to test for each grammar
39    # also set description for that grammar
40    grammar     = new 'ResizableStringArray'
41    expr        = new 'ResizablePMCArray'
42    description = new 'ResizableStringArray'
43
44    .local int ok, n_grammars, n_tests
45
46    # plan tests to run
47    test.'plan'(16)
48
49    # define descriptions / grammars / expressions to run
50
51    .local pmc targets
52
53    targets = new 'ResizableStringArray'
54    push targets, '1313'                    # n1
55    push targets, ' 1414 '                  # n2
56
57    'test_grammar_against_targets'( <<'EOF_SIMPLE_GRAMMAR', targets, 'simple token/rule match' )
58grammar Simple::Test1;
59rule main { <number> }
60token number { \d+ }
61EOF_SIMPLE_GRAMMAR
62
63
64    targets = new 'ResizableStringArray'
65    push targets, '[1313]'                  # n3
66    push targets, '[ 1313 ]'                # n4
67    push targets, '[    1313  ]'            # n5
68    'test_grammar_against_targets'( <<'EOF_SIMPLE_GRAMMAR', targets, 'simple token/rule match with constant chars' )
69grammar Simple::Test2;
70rule main { \[ <number> \] }
71token number { \d+ }
72EOF_SIMPLE_GRAMMAR
73
74
75    targets = new 'ResizableStringArray'
76    push targets, ''                        # n6
77    push targets, '11'                      # n7
78    push targets, '11 12 13'                # n8
79    push targets, ' 11     12  13   14'     # n9
80    'test_grammar_against_targets'( <<'EOF_SIMPLE_GRAMMAR', targets, 'simple token/rule match with repetition using *' )
81grammar Simple::Test3;
82rule main { [<number> <.ws>]* }
83token number { \d+ }
84EOF_SIMPLE_GRAMMAR
85
86
87    targets = new 'ResizableStringArray'
88    push targets, '11 12 13'                # n10
89    'test_grammar_against_targets'( <<'EOF_SIMPLE_GRAMMAR', targets, 'another simple token/rule match with repetition using *' )
90grammar Simple::Test4;
91rule main { [<number> ]* }
92token number { \d+ }
93EOF_SIMPLE_GRAMMAR
94
95    targets = new 'ResizableStringArray'
96    push targets, '11'                      # n11
97    push targets, '11 12 13'                # n12
98    push targets, ' 11     12  13   14'     # n13
99    'test_grammar_against_targets'( <<'EOF_SIMPLE_GRAMMAR', targets, 'simple token/rule match with repetition using +' )
100grammar Simple::Test5;
101rule main { [<number> <.ws>]+ }
102token number { \d+ }
103EOF_SIMPLE_GRAMMAR
104
105    targets = new 'ResizableStringArray'
106    push targets, '11'                      # n14
107    push targets, '11 12 13'                # n15
108    push targets, '  11     12  13  '       # n16
109    'test_grammar_against_targets'( <<'EOF_SIMPLE_GRAMMAR', targets, 'simple token/rule match with repetition using *' )
110grammar Simple::Test6;
111rule main { [ <number>]* }
112token number { \d+ }
113EOF_SIMPLE_GRAMMAR
114
115.end
116
117
118.sub 'test_grammar_against_targets'
119    .param string grammar
120    .param pmc    targets
121    .param string description
122
123    load_bytecode 'Test/Builder.pbc'
124    .local pmc    test
125                  test = new [ 'Test'; 'Builder' ]
126
127    .local int    ok
128                  ok = 0
129    .local pmc    compiler
130                  compiler = '_compile_grammar'(grammar)
131
132    .local pmc    test_num
133                  test_num  = get_global 'test_num'
134
135    # it starts at zero
136    inc test_num
137
138    .local string test_num_str
139                  test_num_str = test_num
140    .local string test_name
141                  test_name    = 'Simple::Test' . test_num_str
142
143    $P0 = split '::', test_name
144    .local pmc parser
145               parser = get_hll_global $P0, 'main'
146
147  next_target:
148    .local string target
149                  target = shift targets
150
151    ok = '_match_expr'( parser, target )
152    test.'ok'( ok, description )
153    $I0 = targets
154    if $I0 goto next_target
155.end
156
157.sub '_compile_grammar'
158    .param string grammar
159
160    .local pmc p6grammar, code, pir_compiler, parser
161
162    p6grammar    = compreg 'PGE::Perl6Grammar'
163    code         = p6grammar.'compile'(grammar, 'target'=>'PIR')
164    pir_compiler = compreg 'PIR'
165    parser       = pir_compiler(code)
166
167    .return( parser )
168.end
169
170
171.sub '_match_expr'
172    .param pmc    parser
173    .param string expr
174
175    .local int ok
176    .local string result, test_name, test_num_str
177    .local pmc p6grammar, code, parse, match, test_num
178
179  do_match:
180    load_bytecode 'PGE.pbc'
181    load_bytecode 'PGE/Perl6Grammar.pbc'
182
183    ok        = 1
184    match     = parser(expr)
185    result    = match
186
187    if result == expr goto match_ok
188    ok = 0
189
190  match_ok:
191    .return(ok)
192.end
193
194=head1 AUTHOR
195
196Nuno 'smash' Carvalho <mestre.smash@gmail.com>
197
198=cut
199
200# Local Variables:
201#   mode: pir
202#   fill-column: 100
203# End:
204# vim: expandtab shiftwidth=4 ft=pir:
205