Skip to content

Commit 5afdd8a

Browse files
committed
Fixed operator error
1 parent 76bc786 commit 5afdd8a

File tree

4 files changed

+261
-17
lines changed

4 files changed

+261
-17
lines changed

testing/Compiler.cls

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ End Function
5151
' ---------------------
5252

5353
Public Function CompileProgram(src As String, Optional progName As String = "@anon") As Long
54-
Dim p As parser
54+
Dim p As Parser
5555
Dim toks As Collection
5656
Dim progScope As ScopeStack
5757
Dim stmtsAST As Collection
@@ -65,7 +65,7 @@ Public Function CompileProgram(src As String, Optional progName As String = "@an
6565
Exit Function
6666
End If
6767

68-
Set p = New parser
68+
Set p = New Parser
6969
With p
7070
.SetGlobals GLOBALS_
7171
Set toks = .Tokenize(src)
@@ -540,8 +540,8 @@ ParseArgsMain:
540540
End Function
541541

542542
Private Function ParseExprFromStringToNode(exprStr As String) As Map
543-
Dim p As parser
544-
Set p = New parser
543+
Dim p As Parser
544+
Set p = New Parser
545545
Dim toks As Collection
546546
Set toks = p.Tokenize(exprStr)
547547
Set ParseExprFromStringToNode = ParseExprTokensToNode(toks)

testing/Parser.cls

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -83,8 +83,8 @@ Tokenize_MainLoop:
8383
toks.Add Array("SEP", ch): i = i + 1: GoTo Tokenize_SkipToLoopEnd
8484
Case "(", ")", "{", "}", "[", "]"
8585
toks.Add Array("PAREN", ch): i = i + 1: GoTo Tokenize_SkipToLoopEnd
86-
Case "+", "-", "*", "^", "%"
87-
' support +=, -=, *=, ^=, %=
86+
Case "+", "-", "*", "/", "^", "%"
87+
' support +=, -=, *=, /=, ^=, %=
8888
If i < n And Mid$(src, i + 1, 1) = "=" Then
8989
toks.Add Array("OP", ch & "="): i = i + 2
9090
Else
@@ -109,9 +109,9 @@ Tokenize_MainLoop:
109109
If i < n And Mid$(src, i + 1, 1) = "=" Then toks.Add Array("OP", "=="): i = i + 2 Else toks.Add Array("OP", "="): i = i + 1
110110
GoTo Tokenize_SkipToLoopEnd
111111
Case "?"
112-
toks.Add Array("OP", "?"): i = i + 1: GoTo Tokenize_SkipToLoopEnd
112+
toks.Add Array("OP", ch): i = i + 1: GoTo Tokenize_SkipToLoopEnd
113113
Case ":"
114-
toks.Add Array("OP", ":"): i = i + 1: GoTo Tokenize_SkipToLoopEnd
114+
toks.Add Array("OP", ch): i = i + 1: GoTo Tokenize_SkipToLoopEnd
115115
Case "'"
116116
j = i + 1
117117
Dim sb As String: sb = ""

testing/VM.cls

Lines changed: 13 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -375,11 +375,13 @@ Private Function ExecSwitchNode(node As Map, progScope As ScopeStack) As String
375375
Dim switchVal As Variant: switchVal = EvalExprNode(node.GetValue("expr"), progScope)
376376
Dim cases As Collection: Set cases = node.GetValue("cases")
377377
Dim i As Long
378+
Dim match As Boolean
378379
For i = 1 To cases.Count
379380
Dim pair As Collection: Set pair = cases(i)
380381
Dim caseExpr As Map: Set caseExpr = pair(1)
381382
Dim blockStmts As Collection: Set blockStmts = pair(2)
382-
If EvalExprNode(caseExpr, progScope) = switchVal Then
383+
match = (EvalExprNode(caseExpr, progScope) = switchVal)
384+
If match Then
383385
Dim s As Long
384386
For s = 1 To blockStmts.Count
385387
Dim ctrl As String: ctrl = ExecuteStmtNode(blockStmts(s), progScope)
@@ -388,14 +390,16 @@ Private Function ExecSwitchNode(node As Map, progScope As ScopeStack) As String
388390
Next s
389391
End If
390392
Next i
391-
Dim defBlk As Collection: Set defBlk = node.GetValue("default")
392-
If Not defBlk Is Nothing Then
393-
Dim d As Long
394-
For d = 1 To defBlk.Count
395-
Dim ctrl2 As String: ctrl2 = ExecuteStmtNode(defBlk(d), progScope)
396-
If ctrl2 = "BREAK" Then ExecSwitchNode = "": Exit Function
397-
If ctrl2 = "RETURN" Or ctrl2 = "ERR" Then ExecSwitchNode = ctrl2: Exit Function
398-
Next d
393+
If Not match Then
394+
Dim defBlk As Collection: Set defBlk = node.GetValue("default")
395+
If Not defBlk Is Nothing Then
396+
Dim d As Long
397+
For d = 1 To defBlk.Count
398+
Dim ctrl2 As String: ctrl2 = ExecuteStmtNode(defBlk(d), progScope)
399+
If ctrl2 = "BREAK" Then ExecSwitchNode = "": Exit Function
400+
If ctrl2 = "RETURN" Or ctrl2 = "ERR" Then ExecSwitchNode = ctrl2: Exit Function
401+
Next d
402+
End If
399403
End If
400404
ExecSwitchNode = ""
401405
End Function

testing/tests.txt

Lines changed: 240 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,240 @@
1+
Core tests (syntax & basic evaluation)
2+
3+
arith_simple
4+
Script: print(1 + 2 * 3);
5+
Expected prints: 7
6+
Pass if: precedence * before +.
7+
Notes: checks operator precedence pipeline (ParseMul/ParseAdd).
8+
9+
paren_grouping
10+
Script: print((1 + 2) * 3);
11+
Expected: 9
12+
Pass if parentheses handled correctly.
13+
14+
negation_unary
15+
Script: print(-5 + 3, !false, !true);
16+
Expected: -2, True, False (three separate prints or comma-joined depending on print impl)
17+
Pass if: unary - and ! work.
18+
19+
power_right_assoc
20+
Script: print(2 ^ 3 ^ 2);
21+
Expected: 512 (2^(3^2))
22+
Pass if: power associativity correct (if not, one of the exponent functions wrong).
23+
24+
Boolean & short-circuit
25+
26+
shortc_and
27+
Script: x = false; print(x && (1/0));
28+
Expected: False
29+
Pass if: RHS not evaluated when left is false (no division-by-zero).
30+
31+
shortc_or
32+
Script: x = true; print(x || (1/0));
33+
Expected: True
34+
Pass if: RHS not evaluated when left is true.
35+
36+
Conditionals & block attachment
37+
38+
if_chain_same_line
39+
Script: a=2; if (a==1) { print('one') } elseif (a==2) { print('two') } else { print('other') }; print('done');
40+
Expected: two, done
41+
Pass if: elseif and else attach to the if node, not compiled as separate statements.
42+
43+
if_multiline
44+
Script:
45+
a=3;
46+
if (a==1) {
47+
print('one')
48+
} elseif (a==2) {
49+
print('two')
50+
} elseif (a==3) {
51+
print('three')
52+
} else {
53+
print('other')
54+
};
55+
print('end');
56+
57+
Expected: three, end
58+
59+
For / While / Loop controls
60+
61+
for_simple
62+
Script: s=0; for(i=1,i<=3,i=i+1) { s = s + i }; print(s);
63+
Expected: 6
64+
Pass if: i is visible in body and step; init was normalized to an Assign that writes to program scope.
65+
66+
for_break_continue
67+
Script: s=0; for(i=1,i<=5,i=i+1) { if (i==3) { continue } if (i==5) { break } s = s + i }; print(s);
68+
Expected: 7
69+
Pass if: continue skips to next iteration (step executed), and break exits loop. Watch: ensure s = s + i is parsed as a separate statement after the two ifs (semicolon rules).
70+
71+
while_break_continue
72+
Script: i=1; s=0; while (i <= 5) { if (i==2) { i = i + 1 ; continue } if (i==5) { break } s = s + i ; i = i + 1 }; print(s);
73+
Expected: 8
74+
Notes: the : inline separator is not accepted in the parser
75+
76+
for_init_expr_visibility
77+
Script: for (i = 1, i <= 2, i = i + 1) { print(i) }; print(i);
78+
Expected: 1, 2, 3 (prints from loop then final i value if loop preserves i in outer scope)
79+
Pass if: i persists after loop because init assigned in program scope.
80+
81+
Switch, try/catch, errors
82+
83+
switch_case
84+
Script: c='blue'; switch(c) { case 'red' { print('warm') } case 'blue' { print('cool') } default { print('other') } }
85+
Expected: cool
86+
87+
try_catch
88+
Script: try { x = 1/0 } catch { print('caught') }
89+
Expected: caught
90+
Notes: runtime errors inside try should transfer flow to catch block. Confirm error is swallowed if catch exists.
91+
92+
Functions, recursion, scope, closures
93+
94+
function_basic
95+
Script: fun add(a,b) { return a + b }; print(add(2,3));
96+
Expected: 5
97+
98+
function_scope_isolation
99+
Script: a=5; fun f(a) { a = a + 1 : print(a) } ; f(a); print(a);
100+
Expected: 6, 5
101+
Pass if: function parameter shadows global var in call scope.
102+
103+
recursion_fib
104+
Script: fun fib(n) { if (n <= 2) { return 1 } return fib(n-1) + fib(n-2) } ; a = []; for(i=1,i<=6,i=i+1) { a[i] = fib(i) }; print(a[1]); print(a[6]);
105+
Expected: 1, 8
106+
Notes: ensure array indexing and recursive calls work.
107+
108+
closure_shared_write
109+
Script: a = 1; f = fun() { a = a + 1; return a }; print(f()); print(a);
110+
Expected: 2, 2
111+
Pass if: closure captures program scope by reference and writes are visible outside.
112+
113+
closure_multiple_instances
114+
Script:
115+
a = 0;
116+
fun make() { return fun() { a = a + 1 : return a } }
117+
f1 = make(); f2 = make();
118+
print(f1()); print(f2()); print(a)
119+
120+
Expected: 1, 2, 2
121+
Notes: Both closures share same a if make() uses shared env. If you intended per-closure private a, compile-time behavior must capture different envs. This test checks sharing.
122+
123+
Arrays & Indexing
124+
125+
array_literal_and_length
126+
Script: a=[10,20,30]; print(a[2]); print(a.length);
127+
Expected: 20, 3
128+
129+
array_index_assignment
130+
Script: a = [] ; a[1] = 7 ; a[3] = 9 ; print(a[1]); print(a[3]); print(a.length)
131+
Expected: 7, 9, 3
132+
Notes: checks auto-ReDim/-preserve logic.
133+
134+
Objects, Members, Member assignment & calls
135+
136+
object_literal_and_member
137+
Script: o = { x: 10, y: 'hi' } ; print(o.x) ; o.x = o.x + 5 ; print(o.x)
138+
Expected: 10, 15
139+
Pass if: Member reading/writing works; assignment uses property write path.
140+
141+
nested_member_index_LValue
142+
Script: o = { a: [ {v:1}, {v:2} ] } ; o.a[2].v = o.a[2].v + 5 ; print(o.a[2].v)
143+
Expected: 7
144+
Notes: verifies Member LValue resolution like a.b[3].c = value.
145+
146+
method_call_on_member
147+
Script: o = { v: 10, incr: fun(x) { return x + 1 } } ; print(o.incr(o.v))
148+
Expected: 11
149+
Notes: ensures Member used as callee or MemberCall dispatch works; fallback to closure call on property.
150+
151+
Anonymous functions & passing as args
152+
153+
anon_func_as_arg
154+
Script: fun apply(f,x) { return f(x) } ; print(apply(fun(y) { return y * 2 }, 5))
155+
Expected: 10
156+
Notes: ensure compiler emits FuncLiteral and VM supports invoking a function-value.
157+
158+
anon_func_closure_arg
159+
Script:
160+
a = 5;
161+
fun apply(f) { return f() }
162+
print(apply(fun() { return a + 1 }))
163+
164+
Expected: 6
165+
Notes: anon functions capture current env by reference.
166+
167+
Ternary and compound assignments
168+
169+
ternary_operator
170+
Script: print( 1 < 2 ? 'yes' : 'no' )
171+
Expected: yes
172+
Notes: Check parse of ? : precendence.
173+
174+
compound_assignment_plus_equals
175+
Script: a=2; a += 3; print(a);
176+
Expected: 5
177+
Notes: compile pass should normalize += into a = a + 3 or VM should handle.
178+
179+
Semicolon vs comma separator & parser warnings
180+
181+
separator_semicolon_required
182+
Script: print('one') , print('two') ;
183+
Expected: depending on your chosen rule: If commas are only argument separators, this should raise a parse warning/error or treat as invalid top-level separator.
184+
Pass if: compiler logs an error or warning that commas cannot be used as statement separators at top-level. (If your implementation quietly allowed it, it's a bug per requirement.)
185+
186+
missing_separator_after_block
187+
Script: if (1==1) { print('x') } print('y');
188+
Expected: x, y
189+
But if there's no semicolon between } and print and your grammar requires explicit separators, this should produce a log/warning; check behavior and ensure the compiler doesn't silently eat statements.
190+
Notes: this test checks your "log when missing statement separator" feature.
191+
192+
VBAexpressions integration
193+
194+
vbexpr_embedded
195+
Script: print( @( 2 + 3 * 4 ) );
196+
Expected: 14
197+
Notes: @(...) should be parsed as VBExpr node and evaluated by VBAexpressions seeded with program variables.
198+
199+
vbexpr_function_fallback
200+
Script: print(sqrt(25));
201+
Expected: 5 if sqrt available in your VBAexpressions setup; otherwise this test verifies that call falls back to VB evaluator by EvalVBFunctionCall.
202+
Notes: Ensure call forwarding builds a correct expression like sqrt(__asf_vbarg_1).
203+
204+
Error & edge-case tests
205+
206+
division_by_zero_error
207+
Script: print(1/0);
208+
Expected: runtime error => either ERR in control flow or a try/catch would catch it. When not caught, gRuntimeLog should contain an error message.
209+
Pass if: error surfaced to runtime log and execution halts (or try/catch catches).
210+
211+
unclosed_parenthesis_error
212+
Script: print( (1 + 2 );
213+
Expected: compile-time parse error.
214+
Pass if: CompileProgram raises or returns an error and program not added.
215+
216+
circular_print_protection (optional depending on pretty-print implementation)
217+
Script:
218+
o = { };
219+
o.self = o;
220+
print(o);
221+
222+
Expected: no infinite recursion or crash. Either prints some safe representation like {self: [Circular]} or logs an error.
223+
Notes: if your ValueToStringForPrint doesn't protect, this will infinite-loop — consider adding depth/cycle detection.
224+
225+
Integration & regression suite
226+
227+
combined_sanity
228+
Script:
229+
/* combined run */
230+
print('start');
231+
a=[1,2];
232+
print(a[1]);
233+
fun incr(x) { return x+1 };
234+
print(incr(4));
235+
try { y=1/0 } catch { print('err') }
236+
print('end');
237+
238+
Expected: start, 1, 5, err, end
239+
Pass if many features cooperate together.
240+

0 commit comments

Comments
 (0)