Skip to content

Commit 1bfbc8e

Browse files
fglockdevin-ai-integration[bot]
fglock
and
devin-ai-integration[bot]
committed
Add context semantics unit test and update design doc
- Add unit test documenting Perl context behavior for different block types - Document findings: bare blocks always return their value regardless of context - Update design doc with analysis and solution options Generated with Devin - https://cli.devin.ai/docs Co-Authored-By: Devin <158243242+devin-ai-integration[bot]@users.noreply.github.com>
1 parent ee54425 commit 1bfbc8e

2 files changed

Lines changed: 138 additions & 2 deletions

File tree

‎dev/design/cpan_client.md‎

Lines changed: 27 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -619,8 +619,33 @@ The JUnit parallel test failures ("ctx is null" errors) were caused by stale INI
619619
**Files changed:**
620620
- `src/test/resources/unit/bare_block_return.t` - TODO tests for bare block return values
621621

622+
### Proposed Approach: File-Level Annotation
623+
624+
The key insight is that RUNTIME context is used for both:
625+
- File-level code (where bare blocks SHOULD return values)
626+
- Subroutine bodies (where the existing behavior is correct)
627+
628+
**Solution:** Annotate only file-level bare blocks before compilation.
629+
630+
**Implementation:**
631+
1. In `EmitterMethodCreator.createClassWithMethod()`, before visiting the AST:
632+
- Check if the last statement is a For3Node with `isSimpleBlock=true`
633+
- If so, add annotation `"fileLevelReturnValue" = true` to that node
634+
2. In `EmitStatement.emitFor3()`:
635+
- Check for `"fileLevelReturnValue"` annotation
636+
- If present AND context is RUNTIME, use the register-spilling approach (same as SCALAR/LIST)
637+
638+
This approach:
639+
- Only affects file-level bare blocks (targeted annotation)
640+
- Doesn't change how subroutine bodies compile
641+
- Uses existing register-spilling mechanism that's already proven to work
642+
643+
**Files to modify:**
644+
- `EmitterMethodCreator.java` - Add annotation to file-level bare blocks
645+
- `EmitStatement.java` - Check for annotation in RUNTIME context
646+
622647
### Next Steps
623648

624-
1. **Investigate bare block return value fix** - Need to capture last expression value without changing interior statement compilation
625-
2. **Test Package::Stash::PP loading** - May need explicit `1;` at end of file
649+
1. **Implement file-level annotation approach** for bare block return values
650+
2. **Test Package::Stash::PP loading** - Verify the fix works
626651
3. **Alternative**: Create bundled DateTime.pm wrapper that skips heavy dependencies

‎src/test/resources/unit/context_semantics.t‎

Lines changed: 111 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,111 @@
1+
#!/usr/bin/env perl
2+
use strict;
3+
use warnings;
4+
5+
# Unit test to document and verify context semantics for different Perl block types
6+
# This test helps understand how PerlOnJava should handle contexts
7+
8+
print "1..12\n";
9+
10+
# Declare this before BEGIN so BEGIN can set it
11+
# Note: Don't initialize with = 0, as that happens at runtime AFTER BEGIN runs
12+
our $begin_ctx;
13+
our $begin_ran;
14+
BEGIN {
15+
$begin_ran = 1;
16+
$begin_ctx = defined(wantarray()) ? (wantarray() ? "LIST" : "SCALAR") : "VOID";
17+
}
18+
19+
sub ctx {
20+
my $w = wantarray();
21+
return defined($w) ? ($w ? "LIST" : "SCALAR") : "VOID";
22+
}
23+
24+
# Test 1: Top-level script context when calling a sub
25+
# Note: The context depends on how the result is used
26+
my $top_ctx = ctx(); # Called in scalar context (assigned to scalar)
27+
print $top_ctx eq "SCALAR" ? "ok 1 - sub called at top-level in scalar assignment sees SCALAR\n"
28+
: "not ok 1 - sub called at top-level in scalar assignment sees SCALAR (got $top_ctx)\n";
29+
30+
# Test 2-4: Subroutine called in different contexts
31+
sub test_sub { return ctx(); }
32+
33+
test_sub(); # void context call
34+
my $void_result = "VOID"; # We can't capture void context result, but sub sees caller's context
35+
36+
my $scalar_ctx = test_sub();
37+
print $scalar_ctx eq "SCALAR" ? "ok 2 - sub called in scalar context sees SCALAR\n"
38+
: "not ok 2 - sub called in scalar context sees SCALAR (got $scalar_ctx)\n";
39+
40+
my @list_ctx = test_sub();
41+
print $list_ctx[0] eq "LIST" ? "ok 3 - sub called in list context sees LIST\n"
42+
: "not ok 3 - sub called in list context sees LIST (got $list_ctx[0])\n";
43+
44+
# Test 4: Bare block as expression returns its value
45+
my $bare_result = do { 42 };
46+
print $bare_result == 42 ? "ok 4 - bare block as expression returns value\n"
47+
: "not ok 4 - bare block as expression returns value (got $bare_result)\n";
48+
49+
# Test 5: Bare block as last statement in sub returns its value
50+
sub sub_with_bare_block { { 99 } }
51+
my $sub_bare = sub_with_bare_block();
52+
print $sub_bare == 99 ? "ok 5 - bare block as last statement in sub returns value\n"
53+
: "not ok 5 - bare block as last statement in sub returns value (got $sub_bare)\n";
54+
55+
# Test 6: Nested bare blocks return innermost value
56+
my $nested = do { { { 123 } } };
57+
print $nested == 123 ? "ok 6 - nested bare blocks return innermost value\n"
58+
: "not ok 6 - nested bare blocks return innermost value (got $nested)\n";
59+
60+
# Test 7: File loaded via 'do' runs in scalar context and returns last value
61+
my $tmpfile = "/tmp/context_do_test_$$.pl";
62+
open my $fh, '>', $tmpfile or die "Cannot create $tmpfile: $!";
63+
print $fh "{ 456 }\n";
64+
close $fh;
65+
my $do_result = do $tmpfile;
66+
unlink $tmpfile;
67+
print $do_result == 456 ? "ok 7 - do file with bare block returns block value\n"
68+
: "not ok 7 - do file with bare block returns block value (got " . ($do_result // "undef") . ")\n";
69+
70+
# Test 8: eval string with bare block returns value
71+
my $eval_result = eval '{ 789 }';
72+
print $eval_result == 789 ? "ok 8 - eval string with bare block returns value\n"
73+
: "not ok 8 - eval string with bare block returns value (got $eval_result)\n";
74+
75+
# Test 9: BEGIN block runs in void context
76+
print $begin_ran == 1 ? "ok 9 - BEGIN block executes\n"
77+
: "not ok 9 - BEGIN block executes\n";
78+
print $begin_ctx eq "VOID" ? "# BEGIN block context: VOID (as expected)\n"
79+
: "# BEGIN block context: $begin_ctx\n";
80+
81+
# Test 10: Bare block with statements before the value
82+
my $multi_stmt = do { my $x = 10; my $y = 20; $x + $y };
83+
print $multi_stmt == 30 ? "ok 10 - bare block returns last expression value\n"
84+
: "not ok 10 - bare block returns last expression value (got $multi_stmt)\n";
85+
86+
# Test 11: File ending with VERSION and BEGIN still returns VERSION
87+
my $tmpfile2 = "/tmp/context_version_test_$$.pl";
88+
open my $fh2, '>', $tmpfile2 or die "Cannot create $tmpfile2: $!";
89+
print $fh2 q{
90+
our $VERSION = "1.23";
91+
BEGIN { }
92+
$VERSION;
93+
};
94+
close $fh2;
95+
my $version_result = do $tmpfile2;
96+
unlink $tmpfile2;
97+
print $version_result eq "1.23" ? "ok 11 - file with VERSION and BEGIN returns VERSION\n"
98+
: "not ok 11 - file with VERSION and BEGIN returns VERSION (got " . ($version_result // "undef") . ")\n";
99+
100+
# Test 12: File ending with bare block after other statements
101+
my $tmpfile3 = "/tmp/context_mixed_test_$$.pl";
102+
open my $fh3, '>', $tmpfile3 or die "Cannot create $tmpfile3: $!";
103+
print $fh3 q{
104+
my $x = 1;
105+
{ 999 }
106+
};
107+
close $fh3;
108+
my $mixed_result = do $tmpfile3;
109+
unlink $tmpfile3;
110+
print $mixed_result == 999 ? "ok 12 - file ending with bare block returns block value\n"
111+
: "not ok 12 - file ending with bare block returns block value (got " . ($mixed_result // "undef") . ")\n";

0 commit comments

Comments
 (0)