diff --git a/dev/cpan-reports/cpan-compatibility.md b/dev/cpan-reports/cpan-compatibility.md index a0605e25b..e292f7096 100644 --- a/dev/cpan-reports/cpan-compatibility.md +++ b/dev/cpan-reports/cpan-compatibility.md @@ -3703,7 +3703,7 @@ | Test::Override::UserAgent | | Unknown test outcome | 2026-04-30 | | Test::Run | | Unknown test outcome | 2026-04-30 | | Test::Script | | Unknown test outcome | 2026-04-21 | -| Test::Unit::Lite | | | 2026-04-30 | +| Test::Unit::Lite | PASS | 39/39 pass | 2026-05-01 | | Text::ASCIIMathML | | | 2026-04-30 | | Text::DelimMatch | | Unknown test outcome | 2026-04-30 | | Text::FillIn | | Unknown test outcome | 2026-04-12 | diff --git a/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java b/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java index 65fa0eb03..5cedbc636 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java +++ b/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java @@ -182,7 +182,14 @@ else if (node.right instanceof ListNode) { int rd = bytecodeCompiler.allocateOutputRegister(); // Emit CALL_SUB opcode - bytecodeCompiler.emit(Opcodes.CALL_SUB); + // Use emitWithToken so pcToTokenIndex maps the call instruction to the + // coderef's token index (call-site line), not the closing ')' line. + int callSiteToken = node.left.getIndex(); + if (callSiteToken > 0) { + bytecodeCompiler.emitWithToken(Opcodes.CALL_SUB, callSiteToken); + } else { + bytecodeCompiler.emit(Opcodes.CALL_SUB); + } bytecodeCompiler.emitReg(rd); bytecodeCompiler.emitReg(coderefReg); bytecodeCompiler.emitReg(argsReg); @@ -246,7 +253,15 @@ else if (node.right instanceof BinaryOperatorNode rightCall) { int rd = bytecodeCompiler.allocateOutputRegister(); // Emit CALL_METHOD - bytecodeCompiler.emit(Opcodes.CALL_METHOD); + // Use emitWithToken so pcToTokenIndex maps the call instruction to the + // invocant's token index (call-site line), not the closing ')' line. + // This ensures caller() inside the called method reports the correct line. + int callSiteToken = node.left.getIndex(); + if (callSiteToken > 0) { + bytecodeCompiler.emitWithToken(Opcodes.CALL_METHOD, callSiteToken); + } else { + bytecodeCompiler.emit(Opcodes.CALL_METHOD); + } bytecodeCompiler.emitReg(rd); bytecodeCompiler.emitReg(invocantReg); bytecodeCompiler.emitReg(methodReg); @@ -403,8 +418,12 @@ else if (node.right instanceof BinaryOperatorNode rightCall) { boolean shareCallerArgs = node.getBooleanAnnotation("shareCallerArgs"); // Emit CALL_SUB or CALL_SUB_SHARE_ARGS opcode + // Pass node.left.getIndex() so pcToTokenIndex maps the call to the function + // name / reference token index (call-site line) rather than the closing ')'. + int callSiteToken = (node.left != null && node.left.getIndex() > 0) + ? node.left.getIndex() : node.getIndex(); int rd = CompileBinaryOperatorHelper.compileBinaryOperatorSwitch( - bytecodeCompiler, node.operator, rs1, rs2, node.getIndex(), + bytecodeCompiler, node.operator, rs1, rs2, callSiteToken, shareCallerArgs); bytecodeCompiler.lastResultReg = rd; return; diff --git a/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperatorHelper.java b/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperatorHelper.java index 786d15282..2b91e1f58 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperatorHelper.java +++ b/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperatorHelper.java @@ -223,7 +223,11 @@ public static int compileBinaryOperatorSwitch(BytecodeCompiler bytecodeCompiler, // Emit CALL_SUB: rd = coderef.apply(args, context) // Use CALL_SUB_SHARE_ARGS for &func (no parens) to share caller's @_ - bytecodeCompiler.emit(shareCallerArgs ? Opcodes.CALL_SUB_SHARE_ARGS : Opcodes.CALL_SUB); + // emitWithToken records tokenIndex in pcToTokenIndex so caller() sees the + // call-site line (tokenIndex was set to node.left.getIndex() by the caller). + bytecodeCompiler.emitWithToken( + shareCallerArgs ? Opcodes.CALL_SUB_SHARE_ARGS : Opcodes.CALL_SUB, + tokenIndex); bytecodeCompiler.emitReg(rd); // Result register bytecodeCompiler.emitReg(rs1); // Code reference register bytecodeCompiler.emitReg(rs2); // Arguments register (RuntimeList to be converted to RuntimeArray) diff --git a/src/main/java/org/perlonjava/backend/jvm/Dereference.java b/src/main/java/org/perlonjava/backend/jvm/Dereference.java index 3b0877c07..00ca80c7a 100644 --- a/src/main/java/org/perlonjava/backend/jvm/Dereference.java +++ b/src/main/java/org/perlonjava/backend/jvm/Dereference.java @@ -972,6 +972,13 @@ static void handleArrowOperator(EmitterVisitor emitterVisitor, BinaryOperatorNod // Allocate a unique callsite ID for inline method caching int callsiteId = nextMethodCallsiteId++; + // Set debug line number to the call site (the object/receiver expression), + // so that caller() inside the called method reports the correct source line. + // Without this, the JVM frame reports the line of the closing ')' instead. + if (node.left.getIndex() > 0) { + ByteCodeSourceMapper.setDebugInfoLineNumber(emitterVisitor.ctx, node.left.getIndex()); + } + mv.visitLdcInsn(callsiteId); mv.visitVarInsn(Opcodes.ALOAD, objectSlot); mv.visitVarInsn(Opcodes.ALOAD, methodSlot); diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java index 82c0f27f2..5521dba62 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java @@ -701,6 +701,13 @@ static void handleApplyOperator(EmitterVisitor emitterVisitor, BinaryOperatorNod } } + // Set debug line number to the call site (the function name/reference expression), + // so that caller() inside the called subroutine reports the correct source line. + // Without this, the JVM frame reports the line of the closing ')' instead. + if (node.left != null && node.left.getIndex() > 0) { + ByteCodeSourceMapper.setDebugInfoLineNumber(emitterVisitor.ctx, node.left.getIndex()); + } + mv.visitVarInsn(Opcodes.ALOAD, codeRefSlot); mv.visitVarInsn(Opcodes.ALOAD, nameSlot); mv.visitVarInsn(Opcodes.ALOAD, argsArraySlot); diff --git a/src/main/java/org/perlonjava/runtime/operators/IOOperator.java b/src/main/java/org/perlonjava/runtime/operators/IOOperator.java index 079705531..8fb6c6f68 100644 --- a/src/main/java/org/perlonjava/runtime/operators/IOOperator.java +++ b/src/main/java/org/perlonjava/runtime/operators/IOOperator.java @@ -87,8 +87,21 @@ public static RuntimeScalar select(RuntimeList runtimeList, int ctx) { } // select FILEHANDLE (returns/sets current filehandle) RuntimeScalar fh = new RuntimeScalar(RuntimeIO.selectedHandle); - RuntimeIO.selectedHandle = runtimeList.getFirst().getRuntimeIO(); - RuntimeIO.lastAccesseddHandle = RuntimeIO.selectedHandle; + RuntimeScalar fileHandleArg = runtimeList.getFirst(); + RuntimeIO newIO = fileHandleArg.getRuntimeIO(); + // Auto-vivify: when called with an undefined scalar, Perl creates a new anonymous + // GLOB reference and stores it back in the variable (like `open my $fh, ...` does). + // This enables the idiom: select select my $fh_null; tie *$fh_null, 'SomeClass'; + if (newIO == null && !fileHandleArg.getDefinedBoolean()) { + RuntimeGlob anonGlob = new RuntimeGlob(null); + RuntimeIO anonIO = new RuntimeIO(); + anonGlob.setIO(anonIO); + RuntimeScalar newGlobRef = anonGlob.createReference(); + fileHandleArg.set(newGlobRef); + newIO = anonIO; + } + RuntimeIO.selectedHandle = newIO; + RuntimeIO.lastAccesseddHandle = newIO; return fh; } diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/FileSpec.java b/src/main/java/org/perlonjava/runtime/perlmodule/FileSpec.java index 58e380112..46cda69fa 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/FileSpec.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/FileSpec.java @@ -2,6 +2,7 @@ import org.perlonjava.runtime.runtimetypes.GlobalVariable; import org.perlonjava.runtime.runtimetypes.RuntimeArray; +import org.perlonjava.runtime.runtimetypes.RuntimeContextType; import org.perlonjava.runtime.runtimetypes.RuntimeHash; import org.perlonjava.runtime.runtimetypes.RuntimeList; import org.perlonjava.runtime.runtimetypes.RuntimeScalar; @@ -438,9 +439,21 @@ public static RuntimeList splitdir(RuntimeArray args, int ctx) { String directories = args.get(1).toString(); // Empty string returns empty list (Perl 5 behavior) if (directories.isEmpty()) { + // In scalar context, return count (0) — mirrors Perl's split behaviour + if (ctx == RuntimeContextType.SCALAR) { + return new RuntimeScalar(0).getList(); + } return new RuntimeList(new ArrayList<>()); } - String[] dirs = directories.split(Pattern.quote(File.separator), -1); + // On Windows, File::Spec::Win32::splitdir splits on both '/' and '\'. + // On Unix, File::Spec::Unix::splitdir splits on '/'. + String splitPattern = File.separator.equals("\\") ? "[/\\\\]" : Pattern.quote(File.separator); + String[] dirs = directories.split(splitPattern, -1); + // In scalar context, return the count — mirrors Perl's `split` returning + // the number of fields when evaluated in scalar context (perlop "split"). + if (ctx == RuntimeContextType.SCALAR) { + return new RuntimeScalar(dirs.length).getList(); + } List dirList = new ArrayList<>(); for (String dir : dirs) { dirList.add(new RuntimeScalar(dir)); diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Symbol.java b/src/main/java/org/perlonjava/runtime/perlmodule/Symbol.java index 82d28cfe9..542e067cc 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Symbol.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Symbol.java @@ -164,10 +164,13 @@ public static RuntimeList qualify_to_ref(RuntimeArray args, int ctx) { RuntimeScalar object = qualify(args, ctx).scalar(); RuntimeScalar result; if (!object.isString()) { + // Already a glob reference or similar — return as-is result = object; } else { - // System.out.println("qualify_to_ref"); - result = new RuntimeScalar().set(new RuntimeGlob(object.toString())); + // Create a named RuntimeGlob and return a GLOBREFERENCE to it. + // This mirrors Perl's \*{name}: the caller gets a reference whose + // hash slot (and other slots) delegate to the global symbol table. + result = new RuntimeGlob(object.toString()).createReference(); } // System.out.println("qualify_to_ref returns " + result.type); RuntimeList list = new RuntimeList(); diff --git a/src/test/resources/unit/directory.t b/src/test/resources/unit/directory.t index 9966b90c5..6f30f67ca 100644 --- a/src/test/resources/unit/directory.t +++ b/src/test/resources/unit/directory.t @@ -1,7 +1,7 @@ use 5.38.0; use strict; use warnings; -use Test::More tests => 9; +use Test::More tests => 12; use Cwd qw(getcwd abs_path); use File::Spec; @@ -91,3 +91,15 @@ if (-d $test_dir) { if (-d $test_dir || -e "$test_dir/$test_file") { diag "Warning: Cleanup verification found leftover files (will retry in END block)"; } + +# Test File::Spec->splitdir scalar context (mirrors Perl's `split` count semantics) +{ + my $count = scalar File::Spec->splitdir("a/b/c"); + is($count, 3, 'scalar File::Spec->splitdir returns count of components'); + + my $count2 = scalar File::Spec->splitdir("t/tlib"); + is($count2, 2, 'scalar File::Spec->splitdir("t/tlib") returns 2'); + + my $count3 = scalar File::Spec->splitdir(""); + is($count3, 0, 'scalar File::Spec->splitdir("") returns 0 for empty string'); +} diff --git a/src/test/resources/unit/typeglob.t b/src/test/resources/unit/typeglob.t index ac43171db..2fa624b42 100644 --- a/src/test/resources/unit/typeglob.t +++ b/src/test/resources/unit/typeglob.t @@ -75,4 +75,26 @@ subtest 'References in package code slots' => sub { } }; +subtest 'Symbol::qualify_to_ref returns a glob reference' => sub { + use Symbol; + + # qualify_to_ref must return a GLOB reference (ref eq "GLOB"), not the + # glob itself. Perl's list_tests idiom relies on: + # keys %{ *{ Symbol::qualify_to_ref("Pkg::") } } + # to inspect a package's symbol table. + + package QTRTest; + sub qtr_method { 1 } + + package main; + + my $ref = Symbol::qualify_to_ref("QTRTest::"); + like($ref, qr/^GLOB\(/, 'qualify_to_ref stringifies as GLOB(...)'); + is(ref($ref), 'GLOB', 'qualify_to_ref returns a reference of type GLOB'); + + # Dereference to get the typeglob, then access its HASH slot (package stash) + my %stash = %{ *{$ref} }; + ok(exists $stash{qtr_method}, 'hash slot of qualify_to_ref result contains package symbols'); +}; + done_testing();