Skip to content

Commit e39b2e5

Browse files
fglockfglock
authored
Merge pull request #197 from fglock/feature/interpreter-array-operators
Implement interpreter array/hash operators and fix error reporting
2 parents 188ed54 + a64f1ac commit e39b2e5

16 files changed

+1397
-25
lines changed

‎dev/interpreter/architecture/INTERPRETER_ERROR_REPORTING.md‎

Lines changed: 453 additions & 0 deletions
Large diffs are not rendered by default.

‎dev/interpreter/tests/error_handling_comprehensive.t‎

Lines changed: 205 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,205 @@
1+
#!/usr/bin/env perl
2+
use strict;
3+
use warnings;
4+
use Test::More;
5+
6+
# Comprehensive test for interpreter error handling and introspection
7+
# Tests: die, warn, eval block, error variable, caller
8+
9+
print "# Testing die, warn, eval, error var, and caller in interpreter\n";
10+
11+
# Test 1: Basic die and eval
12+
{
13+
my $result = eval {
14+
die "Test error\n";
15+
return "Should not reach here";
16+
};
17+
ok(!$result, 'eval block caught die');
18+
like($@, qr/Test error/, 'die message captured');
19+
print "# Test 1 complete\n";
20+
}
21+
22+
# Test 2: Die without newline (adds location)
23+
{
24+
eval {
25+
die "Error without newline";
26+
};
27+
like($@, qr/Error without newline at/, 'die without newline adds location');
28+
like($@, qr/line \d+/, 'location includes line number');
29+
print "# Test 2 complete\n";
30+
}
31+
32+
# Test 3: Nested eval blocks
33+
{
34+
my $outer;
35+
eval {
36+
eval {
37+
die "Inner error\n";
38+
};
39+
$outer = $@;
40+
die "Outer error\n";
41+
};
42+
like($outer, qr/Inner error/, 'inner error captured');
43+
like($@, qr/Outer error/, 'outer error captured');
44+
print "# Test 3 complete\n";
45+
}
46+
47+
# Test 4: Eval returns undef on die
48+
{
49+
my $result = eval {
50+
die "Test\n";
51+
};
52+
ok(!defined($result), 'eval returns undef when die occurs');
53+
print "# Test 4 complete\n";
54+
}
55+
56+
# Test 5: Warn functionality
57+
{
58+
my $warning;
59+
local $SIG{__WARN__} = sub { $warning = shift };
60+
61+
warn "Test warning\n";
62+
63+
like($warning, qr/Test warning/, 'warn message captured');
64+
print "# Test 5 complete\n";
65+
}
66+
67+
# Test 6: Warn without newline adds location
68+
{
69+
my $warning;
70+
local $SIG{__WARN__} = sub { $warning = shift };
71+
72+
warn "Warning without newline";
73+
74+
like($warning, qr/Warning without newline at/, 'warn adds location');
75+
like($warning, qr/line \d+/, 'warn location has line number');
76+
print "# Test 6 complete\n";
77+
}
78+
79+
# Test 7: Caller in subroutine (0 levels)
80+
{
81+
sub test_caller {
82+
my ($package, $filename, $line) = caller(0);
83+
return ($package, $filename, $line);
84+
}
85+
86+
my ($pkg, $file, $line) = test_caller();
87+
88+
is($pkg, 'main', 'caller(0) returns main package');
89+
ok(defined($file), 'caller(0) returns filename');
90+
ok($line > 0, 'caller(0) returns line number');
91+
92+
print "# Test 7 - caller(0): package=$pkg, file=$file, line=$line\n";
93+
}
94+
95+
# Test 8: Caller with nested calls
96+
{
97+
sub inner_func {
98+
my ($package, $filename, $line, $subroutine) = caller(1);
99+
return ($package, $filename, $line, $subroutine);
100+
}
101+
102+
sub outer_func {
103+
return inner_func();
104+
}
105+
106+
my ($pkg, $file, $line, $sub) = outer_func();
107+
108+
is($pkg, 'main', 'caller(1) returns correct package');
109+
ok(defined($file), 'caller(1) returns filename');
110+
ok($line > 0, 'caller(1) returns line number');
111+
print "# Test 8 - caller(1): package=$pkg, file=$file, line=$line\n";
112+
}
113+
114+
# Test 9: Caller returns false when no caller
115+
{
116+
my @caller = caller(10); # Way too deep
117+
ok(!@caller, 'caller returns empty list when no caller');
118+
print "# Test 9 complete\n";
119+
}
120+
121+
# Test 10: Die inside subroutine with stack trace
122+
{
123+
sub level2 {
124+
die "Error in level2\n";
125+
}
126+
127+
sub level1 {
128+
level2();
129+
}
130+
131+
eval {
132+
level1();
133+
};
134+
135+
like($@, qr/Error in level2/, 'die message from nested call');
136+
print "# Test 10 complete\n";
137+
}
138+
139+
# Test 11: Error variable cleared on successful eval
140+
{
141+
$@ = "Previous error\n";
142+
eval {
143+
1 + 1; # Successful code
144+
};
145+
is($@, '', 'error variable cleared on successful eval');
146+
print "# Test 11 complete\n";
147+
}
148+
149+
# Test 12: Eval can return values
150+
{
151+
my $result = eval {
152+
my $x = 10;
153+
my $y = 20;
154+
$x + $y;
155+
};
156+
is($result, 30, 'eval returns last expression');
157+
is($@, '', 'no error on successful eval');
158+
print "# Test 12 - eval returned: $result\n";
159+
}
160+
161+
# Test 13: Die with saved error
162+
{
163+
eval {
164+
die "First error\n";
165+
};
166+
my $saved = $@;
167+
168+
eval {
169+
die $saved;
170+
};
171+
172+
is($@, $saved, 'die preserves error object');
173+
print "# Test 13 complete\n";
174+
}
175+
176+
# Test 14: Bare die behavior
177+
{
178+
my $result;
179+
180+
eval {
181+
$@ = "Inner saved\n";
182+
die; # Bare die
183+
};
184+
185+
like($@, qr/Inner saved|Died/, 'bare die propagates error');
186+
print "# Test 14 complete\n";
187+
}
188+
189+
# Test 15: Caller inside eval
190+
{
191+
sub caller_in_eval {
192+
my ($pkg, $file, $line) = caller(0);
193+
return ($pkg, $file, $line);
194+
}
195+
196+
my ($pkg, $file, $line) = eval {
197+
caller_in_eval();
198+
};
199+
200+
is($pkg, 'main', 'caller works inside eval');
201+
ok(defined($file), 'caller returns file inside eval');
202+
print "# Test 15 - Caller in eval: $pkg at $file:$line\n";
203+
}
204+
205+
done_testing();

‎dev/interpreter/tests/interpreter_errors.t‎

Lines changed: 109 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,109 @@
1+
use strict;
2+
use warnings;
3+
use Test::More;
4+
5+
# Test interpreter error reporting
6+
7+
# Test 1: Die shows correct location
8+
{
9+
my $error;
10+
my $code = '
11+
sub foo {
12+
die "Error in foo";
13+
}
14+
foo();
15+
';
16+
eval $code;
17+
$error = $@;
18+
19+
# Check that error message includes location
20+
like($error, qr/Error in foo/, 'die message preserved');
21+
like($error, qr/at \(eval \d+\) line/, 'die shows eval location');
22+
23+
print "# Error message: $error";
24+
}
25+
26+
# Test 2: Stack trace with nested calls
27+
{
28+
my $error;
29+
my $code = '
30+
sub bar {
31+
die "Error in bar";
32+
}
33+
sub foo {
34+
bar();
35+
}
36+
foo();
37+
';
38+
eval $code;
39+
$error = $@;
40+
41+
# Check that stack trace includes both functions
42+
like($error, qr/Error in bar/, 'nested die message preserved');
43+
like($error, qr/at \(eval \d+\)/, 'nested die shows location');
44+
45+
print "# Nested error message: $error";
46+
}
47+
48+
# Test 3: Multiple levels of nesting
49+
{
50+
my $error;
51+
my $code = '
52+
sub level3 {
53+
die "Deep error";
54+
}
55+
sub level2 {
56+
level3();
57+
}
58+
sub level1 {
59+
level2();
60+
}
61+
level1();
62+
';
63+
eval $code;
64+
$error = $@;
65+
66+
like($error, qr/Deep error/, 'multi-level die message preserved');
67+
like($error, qr/at \(eval \d+\)/, 'multi-level die shows location');
68+
69+
print "# Multi-level error: $error";
70+
}
71+
72+
# Test 4: Die without explicit message
73+
{
74+
my $error;
75+
my $code = '
76+
$@ = "Previous error\n";
77+
sub test_bare_die {
78+
die;
79+
}
80+
test_bare_die();
81+
';
82+
eval $code;
83+
$error = $@;
84+
85+
# Bare die should propagate $@
86+
like($error, qr/Previous error|Died at/, 'bare die behavior');
87+
88+
print "# Bare die error: $error";
89+
}
90+
91+
# Test 5: Verify line numbers are accurate
92+
{
93+
my $error;
94+
my $code = '# Line 1
95+
sub test_line_numbers { # Line 2
96+
die "Line number test"; # Line 3
97+
} # Line 4
98+
test_line_numbers(); # Line 5
99+
';
100+
eval $code;
101+
$error = $@;
102+
103+
# Should report line 3 (where die is)
104+
like($error, qr/at \(eval \d+\) line 3/, 'die reports correct line number');
105+
106+
print "# Line number error: $error";
107+
}
108+
109+
done_testing();

‎dev/interpreter/tests/line_numbers_comprehensive.t‎

Lines changed: 71 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,71 @@
1+
#!/usr/bin/env perl
2+
use strict;
3+
use warnings;
4+
use Test::More;
5+
6+
# Test 1: Simple die - line 7
7+
eval { die "Line7" };
8+
like($@, qr/Line7 at .* line 7/, 'die on line 7');
9+
10+
# Test 2: Die with blank lines
11+
eval {
12+
13+
14+
die "Line14";
15+
16+
};
17+
like($@, qr/Line14 at .* line 14/, 'die with blank lines shows line 14');
18+
19+
# Test 3: Die in subroutine
20+
sub level1 {
21+
die "In level1";
22+
}
23+
eval { level1(); };
24+
like($@, qr/In level1 at/, 'die in subroutine');
25+
26+
# Test 4: Multi-level subroutines
27+
sub level3 { die "Level3" }
28+
sub level2 { level3() }
29+
sub level1_nested { level2() }
30+
eval { level1_nested(); };
31+
like($@, qr/Level3 at/, 'die in nested subroutines');
32+
33+
# Test 5: caller() with no nesting
34+
sub test_caller_0 {
35+
my ($pkg, $file, $line) = caller(0);
36+
return ($pkg, $file, $line);
37+
}
38+
my ($p, $f, $l) = test_caller_0();
39+
is($p, 'main', 'caller(0) package');
40+
ok($l > 0, 'caller(0) line number');
41+
42+
# Test 6: caller() with nesting
43+
sub inner_caller {
44+
my ($pkg, $file, $line) = caller(1);
45+
return ($pkg, $file, $line);
46+
}
47+
sub outer_caller {
48+
return inner_caller();
49+
}
50+
my ($p2, $f2, $l2) = outer_caller();
51+
is($p2, 'main', 'caller(1) package');
52+
ok($l2 > 0, 'caller(1) line number');
53+
54+
# Test 7: caller() with blank lines
55+
56+
57+
sub with_blanks {
58+
59+
60+
my ($pkg, $file, $line) = caller(0);
61+
62+
63+
return $line;
64+
}
65+
66+
67+
my $line_number = with_blanks();
68+
# This call is on line ~68, with_blanks caller(0) should report this line
69+
ok($line_number > 60 && $line_number < 75, 'caller with blank lines');
70+
71+
done_testing();

0 commit comments

Comments
 (0)