Skip to content

Commit 98afe8e

Browse files
committed
Fix typeglob CODE slot access and add missing IO methods
The real issue was that *{name}{CODE} wasn't calling RuntimeGlob's hashDerefGet() method - it was using the parent RuntimeScalar's version which treats the glob as a hash dereference. Fixes: 1. Override hashDerefGetNonStrict() in RuntimeGlob to properly handle typeglob slot access (CODE, SCALAR, ARRAY, HASH, IO, FORMAT) 2. Check RuntimeCode.defined() before returning CODE slot to match standard Perl behavior where undefined subs don't appear in CODE slot 3. Add missing IO::Handle methods: gets(), _open_mode_string() 4. Add missing IO::Seekable methods: getpos(), setpos() 5. Add missing IO::File method: new_tmpfile() (stub for now) 6. Keep DESTROY method in IO::Handle for compatibility Test Results: t/op/filehandle.t now passes 4/4 tests
1 parent 54e3c10 commit 98afe8e

File tree

4 files changed

+63
-2
lines changed

4 files changed

+63
-2
lines changed

src/main/java/org/perlonjava/runtime/RuntimeGlob.java

Lines changed: 27 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -180,10 +180,35 @@ private void markGlobAsAssigned() {
180180
* @return A RuntimeScalar representing the dereferenced value or reference. If the key
181181
* is not recognized, an empty RuntimeScalar is returned.
182182
*/
183+
@Override
183184
public RuntimeScalar hashDerefGet(RuntimeScalar index) {
184-
// System.out.println("glob hashDerefGet " + index.toString());
185+
return getGlobSlot(index);
186+
}
187+
188+
@Override
189+
public RuntimeScalar hashDerefGetNonStrict(RuntimeScalar index, String packageName) {
190+
// For typeglobs, slot access doesn't need symbolic reference resolution
191+
// Just access the slot directly
192+
return getGlobSlot(index);
193+
}
194+
195+
/**
196+
* Get a typeglob slot (CODE, SCALAR, ARRAY, HASH, IO, FORMAT).
197+
* This is the common implementation for both strict and non-strict contexts.
198+
*/
199+
private RuntimeScalar getGlobSlot(RuntimeScalar index) {
200+
// System.out.println("glob getGlobSlot " + index.toString());
185201
return switch (index.toString()) {
186-
case "CODE" -> GlobalVariable.getGlobalCodeRef(this.globName);
202+
case "CODE" -> {
203+
// Only return CODE ref if the subroutine is actually defined
204+
RuntimeScalar codeRef = GlobalVariable.getGlobalCodeRef(this.globName);
205+
if (codeRef.type == RuntimeScalarType.CODE && codeRef.value instanceof RuntimeCode code) {
206+
if (code.defined()) {
207+
yield codeRef;
208+
}
209+
}
210+
yield new RuntimeScalar(); // Return undef if code doesn't exist
211+
}
187212
case "IO" -> IO;
188213
case "SCALAR" -> GlobalVariable.getGlobalVariable(this.globName);
189214
case "ARRAY" -> {

src/main/perl/lib/IO/File.pm

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -156,6 +156,14 @@ sub new {
156156
$fh;
157157
}
158158

159+
sub new_tmpfile {
160+
my $class = shift;
161+
@_ == 0 or croak "usage: $class->new_tmpfile()";
162+
# TODO: Implement actual temporary file creation
163+
# For now, return undef to indicate not supported
164+
return undef;
165+
}
166+
159167
################################################
160168
## Open
161169
##

src/main/perl/lib/IO/Handle.pm

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -309,6 +309,21 @@ sub getlines {
309309
<$fh>;
310310
}
311311

312+
sub gets {
313+
my $fh = shift;
314+
scalar <$fh>;
315+
}
316+
317+
sub _open_mode_string {
318+
my ($mode) = @_;
319+
$mode =~ /^\+?(<|>>?)$/
320+
or $mode =~ s/^r(\+?)$/$1</
321+
or $mode =~ s/^w(\+?)$/$1>/
322+
or $mode =~ s/^a(\+?)$/$1>>/
323+
or croak "IO::Handle: bad open mode: $mode";
324+
$mode;
325+
}
326+
312327
sub write {
313328
my $fh = shift;
314329
my $buf = shift;

src/main/perl/lib/IO/Seekable.pm

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -123,4 +123,17 @@ sub tell {
123123
tell($_[0]);
124124
}
125125

126+
sub getpos {
127+
@_ == 1 or croak 'usage: $io->getpos()';
128+
my $fh = $_[0];
129+
my $pos = tell($fh);
130+
return undef if $pos < 0;
131+
return $pos;
132+
}
133+
134+
sub setpos {
135+
@_ == 2 or croak 'usage: $io->setpos(POS)';
136+
seek($_[0], $_[1], 0);
137+
}
138+
126139
1;

0 commit comments

Comments
 (0)