diff --git a/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java b/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java index f4ba676de..d3949b1e3 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java @@ -380,9 +380,18 @@ public static int executeSelect( } /** - * SLOW_LOAD_GLOB: rd = getGlobalIO(name) + * SLOW_LOAD_GLOB: rd = getGlobalIO(name).createDetachedCopy() * Format: [SLOW_LOAD_GLOB] [rd] [name_idx] * Effect: Loads a glob/filehandle from global variables + * + *

IMPORTANT: This returns a detached copy of the glob. + * This is crucial for the {@code do { local *FH; *FH }} pattern used to create anonymous + * filehandles. The detached copy captures the current IO slot, so that when the local + * scope ends and restores the global glob, the captured copy retains its IO. + * + *

If we returned the global glob directly, the copy would only be made when the + * glob is assigned to a variable (in RuntimeScalar constructor), which happens AFTER + * the local scope ends, and by that time the IO would have been restored to the original. */ public static int executeLoadGlob( int[] bytecode, @@ -398,7 +407,8 @@ public static int executeLoadGlob( // Call GlobalVariable.getGlobalIO() to get the RuntimeGlob RuntimeGlob glob = GlobalVariable.getGlobalIO(globName); - registers[rd] = glob; + // Return a detached copy to preserve IO during local scope + registers[rd] = glob.createDetachedCopy(); return pc; } diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitOperatorLocal.java b/src/main/java/org/perlonjava/backend/jvm/EmitOperatorLocal.java index 1ac7b6c6c..88c5d21fe 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitOperatorLocal.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitOperatorLocal.java @@ -130,8 +130,23 @@ static void handleLocal(EmitterVisitor emitterVisitor, OperatorNode node) { lvalueContext = LValueVisitor.getContext(varToLocal); } - varToLocal.accept(emitterVisitor.with(lvalueContext)); boolean isTypeglob = varToLocal instanceof OperatorNode operatorNode && operatorNode.operator.equals("*"); + + // For local *GLOB, we must NOT create a detached copy - we need to localize the actual + // global glob from globalIORefs, so that later accesses via *GLOB see the new IO slot. + // This is critical for the `do { local *FH; *FH }` pattern to work correctly. + if (isTypeglob && varToLocal instanceof OperatorNode opNode2 && opNode2.operand instanceof IdentifierNode idNode) { + String fullName = NameNormalizer.normalizeVariableName(idNode.name, emitterVisitor.ctx.symbolTable.getCurrentPackage()); + mv.visitLdcInsn(fullName); + mv.visitMethodInsn(org.objectweb.asm.Opcodes.INVOKESTATIC, + "org/perlonjava/runtime/runtimetypes/GlobalVariable", + "getGlobalIO", + "(Ljava/lang/String;)Lorg/perlonjava/runtime/runtimetypes/RuntimeGlob;", + false); + } else { + varToLocal.accept(emitterVisitor.with(lvalueContext)); + } + // save the old value if (isTypeglob) { emitterVisitor.ctx.mv.visitMethodInsn(Opcodes.INVOKESTATIC, diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitVariable.java b/src/main/java/org/perlonjava/backend/jvm/EmitVariable.java index bb4b6281b..944867b29 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitVariable.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitVariable.java @@ -346,7 +346,8 @@ static void handleVariableOperator(EmitterVisitor emitterVisitor, OperatorNode n if (CompilerOptions.DEBUG_ENABLED) emitterVisitor.ctx.logDebug("GETVAR " + sigil + name); if (sigil.equals("*")) { - // typeglob + // typeglob - return a detached copy to preserve IO during local scope + // This is crucial for the `do { local *FH; *FH }` pattern String fullName = NameNormalizer.normalizeVariableName(name, emitterVisitor.ctx.symbolTable.getCurrentPackage()); mv.visitLdcInsn(fullName); // emit string emitterVisitor.ctx.mv.visitMethodInsn( @@ -355,6 +356,13 @@ static void handleVariableOperator(EmitterVisitor emitterVisitor, OperatorNode n "getGlobalIO", "(Ljava/lang/String;)Lorg/perlonjava/runtime/runtimetypes/RuntimeGlob;", false); + // Create detached copy NOW (before local restores) to capture current IO + emitterVisitor.ctx.mv.visitMethodInsn( + Opcodes.INVOKEVIRTUAL, + "org/perlonjava/runtime/runtimetypes/RuntimeGlob", + "createDetachedCopy", + "()Lorg/perlonjava/runtime/runtimetypes/RuntimeGlob;", + false); return; } diff --git a/src/main/java/org/perlonjava/core/Configuration.java b/src/main/java/org/perlonjava/core/Configuration.java index 4256e1c56..9c7b9f5c8 100644 --- a/src/main/java/org/perlonjava/core/Configuration.java +++ b/src/main/java/org/perlonjava/core/Configuration.java @@ -33,7 +33,7 @@ public final class Configuration { * Automatically populated by Gradle/Maven during build. * DO NOT EDIT MANUALLY - this value is replaced at build time. */ - public static final String gitCommitId = "36a15d5a2"; + public static final String gitCommitId = "861aaf63a"; /** * Git commit date of the build (ISO format: YYYY-MM-DD). diff --git a/src/main/java/org/perlonjava/runtime/io/CustomFileChannel.java b/src/main/java/org/perlonjava/runtime/io/CustomFileChannel.java index a2daf5e1a..92418a21f 100644 --- a/src/main/java/org/perlonjava/runtime/io/CustomFileChannel.java +++ b/src/main/java/org/perlonjava/runtime/io/CustomFileChannel.java @@ -344,15 +344,11 @@ public RuntimeScalar sync() { * *

Java's FileChannel does not expose the underlying OS file descriptor. * We return undef to match Perl's behavior for handles without a real fd. - * Note: Validity checks should be done in the Java backend, not via fileno(). * * @return RuntimeScalar with undef (Java doesn't expose real fds) */ @Override public RuntimeScalar fileno() { - // Java's FileChannel does not expose the underlying OS file descriptor. - // Return undef to match Perl's behavior for handles without a real fd. - // Note: Validity checks should be done in the Java backend, not via fileno(). return RuntimeScalarCache.scalarUndef; } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java index 38561b9a1..f3ba027f4 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java @@ -532,6 +532,24 @@ public static RuntimeGlob getGlobalIO(String key) { return glob; } + /** + * Retrieves a detached copy of a global IO reference, wrapped in a RuntimeScalar. + * + *

This method is crucial for the {@code do { local *FH; *FH }} pattern used to create + * anonymous filehandles. By creating the detached copy immediately when the glob is + * evaluated, we capture the current IO slot BEFORE the local scope ends and restores + * the original IO. + * + *

The detached copy has the same globName (for stringification) but its own IO + * reference that is independent of the global glob after the copy is made. + * + * @param key The key of the global IO reference. + * @return A RuntimeScalar containing a detached copy of the glob. + */ + public static RuntimeScalar getGlobalIOCopy(String key) { + return new RuntimeScalar(getGlobalIO(key)); + } + /** * Checks if a global IO reference exists. * diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java index 0d7e1e533..23d8c4e47 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java @@ -40,23 +40,33 @@ public RuntimeGlob(String globName) { } /** - * Creates a detached copy of this glob that shares the current IO slot reference. - * Used when assigning a glob to a scalar: `my $fh = *FH` + * Creates a detached copy of this glob that has its own independent IO slot. * - *

This is crucial for `local *GLOB` semantics. When you do: + *

This is crucial for the {@code do { local *GLOB; *GLOB }} pattern used to create + * anonymous filehandles. When you do: * 

-     *   local *FH;
-     *   open FH, ...; 
-     *   my $captured = *FH;
-     *   return $captured;
+     *   my $fh = do { local *FH; open FH, ...; *FH };
      *
- * After the local scope ends, *FH's IO is restored, but $captured should - * still have the IO that was opened. This method creates a new RuntimeGlob - * that points to the CURRENT IO object, so when local restores the original - * glob, the captured copy is unaffected. + * The returned glob must retain the IO that was opened, even after the local scope + * ends and restores the global *FH. This method creates a new RuntimeGlob that: + * * - *

Subclasses (like RuntimeStashEntry) should override this to return - * the same instance, preserving their special ref() behavior. + *

IMPORTANT: The copy shares the same IO RuntimeScalar object as the + * original at the time of copying. This means: + *

+ * + *

Subclasses (like RuntimeStashEntry) should override this to return the same + * instance, preserving their special ref() behavior. * * @return A new RuntimeGlob with the same globName and IO reference. */ @@ -66,6 +76,34 @@ public RuntimeGlob createDetachedCopy() { return copy; } + /** + * Returns a hash code based on the glob name. + * This ensures that all copies of the same glob (including detached copies) + * have the same hash code, which is necessary for correct stringification + * and equality comparisons in Perl code like `$_[0] eq \*FOO`. + * + * @return Hash code based on the glob name + */ + @Override + public int hashCode() { + return globName != null ? globName.hashCode() : 0; + } + + /** + * Checks equality based on glob name. + * Two RuntimeGlob objects are equal if they have the same globName. + * This ensures that detached copies compare equal to the original glob. + * + * @param obj The object to compare + * @return true if both are RuntimeGlob with the same globName + */ + @Override + public boolean equals(Object obj) { + if (this == obj) return true; + if (!(obj instanceof RuntimeGlob other)) return false; + return globName != null ? globName.equals(other.globName) : other.globName == null; + } + public static boolean isGlobAssigned(String globName) { return GlobalVariable.globalGlobs.getOrDefault(globName, false); } @@ -235,8 +273,11 @@ public RuntimeScalar set(RuntimeGlob value) { InheritanceResolver.invalidateCache(); // Alias the IO slot: both names point to the same IO object + // Must update BOTH this.IO (for detached copies) AND the global glob's IO RuntimeGlob sourceIO = GlobalVariable.getGlobalIO(globName); + RuntimeGlob targetIO = GlobalVariable.getGlobalIO(this.globName); this.IO = sourceIO.IO; + targetIO.IO = sourceIO.IO; // Alias the ARRAY slot: both names point to the same RuntimeArray object RuntimeArray sourceArray = GlobalVariable.getGlobalArray(globName); @@ -503,9 +544,11 @@ public String toStringRef() { /** * Returns an integer representation of the typeglob reference. - * This is the hash code of the current instance. + * This is the unsigned interpretation of the hash code. + * Note: This may overflow for hash codes > Integer.MAX_VALUE, but + * getDoubleRef() returns the correct unsigned value. * - * @return The hash code of this instance. + * @return The hash code of this instance as unsigned (may overflow). */ public int getIntRef() { return this.hashCode(); @@ -513,12 +556,13 @@ public int getIntRef() { /** * Returns a double representation of the typeglob reference. - * This is the hash code of the current instance, cast to a double. + * This is the unsigned interpretation of the hash code, matching what + * hex() would return from the stringified address in toStringRef(). * - * @return The hash code of this instance as a double. + * @return The hash code as an unsigned value (as double). */ public double getDoubleRef() { - return this.hashCode(); + return Integer.toUnsignedLong(this.hashCode()); } /** diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java index 90bf555fb..dd3cf992b 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java @@ -768,18 +768,37 @@ public static void closeAllHandles() { /** * Extracts a RuntimeIO from various Perl scalar types. * - *

Handles: + *

This method handles several common filehandle representations: *

* + *

IMPORTANT for detached glob copies: When a glob is captured via + * {@code do { local *FH; *FH }}, the returned glob is a "detached copy" created + * by {@link RuntimeGlob#createDetachedCopy()}. This copy has its own IO slot + * that is independent of the global *FH after the local scope ends. This method + * must extract the IO from the detached copy's own IO slot, NOT from the global + * handle looked up by name. The fallback lookup by globName (lines 820-828) should + * only be used when the glob's own IO slot is genuinely null/empty, not just + * because it contains an empty RuntimeScalar. + * * @param runtimeScalar the scalar containing or referencing an I/O handle - * @return the extracted RuntimeIO + * @return the extracted RuntimeIO, or null if no IO handle found */ public static RuntimeIO getRuntimeIO(RuntimeScalar runtimeScalar) { RuntimeIO fh = null; + boolean ioDebug = System.getenv("JPERL_IO_DEBUG") != null; + + if (ioDebug) { + System.err.println("[JPERL_IO_DEBUG] getRuntimeIO ENTRY: type=" + runtimeScalar.type + + " valueClass=" + (runtimeScalar.value != null ? runtimeScalar.value.getClass().getSimpleName() : "null") + + " valueId=" + (runtimeScalar.value != null ? System.identityHashCode(runtimeScalar.value) : 0)); + System.err.flush(); + } + // Handle: my $fh2 = \*STDOUT; // Handle: my $fh = *STDOUT; @@ -813,11 +832,25 @@ public static RuntimeIO getRuntimeIO(RuntimeScalar runtimeScalar) { if (runtimeScalar.value instanceof RuntimeGlob runtimeGlob) { RuntimeScalar ioScalar = runtimeGlob.getIO(); + if (ioDebug) { + System.err.println("[JPERL_IO_DEBUG] getRuntimeIO: glob=" + runtimeGlob.globName + + " globId=" + System.identityHashCode(runtimeGlob) + + " ioScalar=" + (ioScalar != null ? ioScalar.type + "/" + System.identityHashCode(ioScalar) : "null") + + " ioValue=" + (ioScalar != null ? (ioScalar.value != null ? ioScalar.value.getClass().getSimpleName() + "/" + System.identityHashCode(ioScalar.value) : "null") : "N/A")); + System.err.flush(); + } if (ioScalar != null) { fh = ioScalar.getRuntimeIO(); } - // If the glob's IO part is null, try to look up the global handle by name + // If the glob's IO part is null, try to look up the global handle by name. + // IMPORTANT: This fallback should only be used when the detached copy's own + // IO slot genuinely has no IO handle. For the `do { local *FH; *FH }` pattern, + // the detached copy's IO slot IS the correct place to look. if (fh == null && runtimeGlob.globName != null) { + if (ioDebug) { + System.err.println("[JPERL_IO_DEBUG] getRuntimeIO: fallback lookup for " + runtimeGlob.globName); + System.err.flush(); + } RuntimeGlob globalGlob = GlobalVariable.getGlobalIO(runtimeGlob.globName); if (globalGlob != null) { RuntimeScalar globalIoScalar = globalGlob.getIO(); @@ -828,9 +861,18 @@ public static RuntimeIO getRuntimeIO(RuntimeScalar runtimeScalar) { } } else if (runtimeScalar.value instanceof RuntimeIO runtimeIO) { // Direct I/O handle + if (ioDebug) { + System.err.println("[JPERL_IO_DEBUG] getRuntimeIO: found direct RuntimeIO id=" + System.identityHashCode(runtimeIO)); + System.err.flush(); + } fh = runtimeIO; } + if (ioDebug) { + System.err.println("[JPERL_IO_DEBUG] getRuntimeIO EXIT: fh=" + (fh != null ? System.identityHashCode(fh) : "null")); + System.err.flush(); + } + if (fh == null) { // Check if object is eligible for overloading `*{}` int blessId = RuntimeScalarType.blessedId(runtimeScalar); diff --git a/src/test/resources/unit/local_glob_filehandle.t b/src/test/resources/unit/local_glob_filehandle.t new file mode 100644 index 000000000..d8e7aae83 --- /dev/null +++ b/src/test/resources/unit/local_glob_filehandle.t @@ -0,0 +1,193 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use File::Temp qw(tempdir); + +=head1 NAME + +local_glob_filehandle.t - Tests for the C pattern + +=head1 DESCRIPTION + +This test verifies that the classic Perl idiom for creating anonymous filehandles +works correctly: + + my $fh = do { local *FH; *FH; }; + +This pattern is widely used in CPAN modules (e.g., Log::Log4perl::Appender::File) +to create unique filehandle copies. Each call should return a glob with an +independent IO slot, so that opening files with different handles doesn't +cause them to share the same underlying file descriptor. + +=head2 How the pattern works in Perl + +1. C saves the current *FH glob and creates a new empty glob + for the duration of the block +2. C<*FH> returns that localized glob value +3. When the block ends, *FH is restored, but the returned value retains + its own independent IO slot +4. Multiple calls create multiple independent filehandle copies + +=head2 The bug + +In PerlOnJava, the returned glob copies were sharing the same IO slot, +causing all filehandles to point to the last-opened file. + +=cut + +# Create a temporary directory for our test files +my $tmpdir = tempdir(CLEANUP => 1); + +# Helper function that uses the classic pattern +sub make_fh { + my $fh = do { local *FH; *FH; }; + return $fh; +} + +subtest 'Basic local *FH pattern' => sub { + my $fh = make_fh(); + ok(defined $fh, 'make_fh returns a defined value'); + is(ref(\$fh), 'GLOB', 'make_fh returns a glob'); + like("$fh", qr/\*main::FH/, 'glob stringifies to *main::FH'); +}; + +subtest 'Multiple filehandles are independent - the core bug' => sub { + # This is the critical test case from Log::Log4perl bug + # See: Log::Log4perl::Appender::File line 124 + # my $fh = do { local *FH; *FH; }; + + my $file1 = "$tmpdir/test1.txt"; + my $file2 = "$tmpdir/test2.txt"; + + # Create two independent filehandles + my $fh1 = make_fh(); + my $fh2 = make_fh(); + + # Both stringify the same way (this is expected and OK) + is("$fh1", "$fh2", 'Both handles stringify to *main::FH (expected)'); + + # Open different files + open $fh1, ">", $file1 or die "Cannot open $file1: $!"; + open $fh2, ">", $file2 or die "Cannot open $file2: $!"; + + # The handles should stringify the same (both are *main::FH) + # but write to different files because they have independent IO slots + + # Write to each handle + print $fh1 "Content for file1\n"; + print $fh2 "Content for file2\n"; + + close $fh1; + close $fh2; + + # Verify file contents - this is the real test of the bug fix + my $content1 = do { open my $r, "<", $file1; local $/; <$r> }; + my $content2 = do { open my $r, "<", $file2; local $/; <$r> }; + + is($content1, "Content for file1\n", 'file1 has correct content'); + is($content2, "Content for file2\n", 'file2 has correct content'); +}; + +subtest 'Three independent filehandles' => sub { + my $file1 = "$tmpdir/triple1.txt"; + my $file2 = "$tmpdir/triple2.txt"; + my $file3 = "$tmpdir/triple3.txt"; + + my $fh1 = make_fh(); + my $fh2 = make_fh(); + my $fh3 = make_fh(); + + open $fh1, ">", $file1 or die $!; + open $fh2, ">", $file2 or die $!; + open $fh3, ">", $file3 or die $!; + + print $fh1 "ONE\n"; + print $fh2 "TWO\n"; + print $fh3 "THREE\n"; + + close $fh1; + close $fh2; + close $fh3; + + my $c1 = do { open my $r, "<", $file1; local $/; <$r> }; + my $c2 = do { open my $r, "<", $file2; local $/; <$r> }; + my $c3 = do { open my $r, "<", $file3; local $/; <$r> }; + + is($c1, "ONE\n", 'First file has correct content'); + is($c2, "TWO\n", 'Second file has correct content'); + is($c3, "THREE\n", 'Third file has correct content'); +}; + +subtest 'Filehandles survive local scope restoration' => sub { + # This tests that the captured glob retains its IO even after + # the local scope ends and *FH is restored to its original value + + my $file = "$tmpdir/scope_test.txt"; + my $fh; + + { + # Inside this block, *FH is localized + $fh = do { local *FH; *FH; }; + # The local scope of *FH ends here, but $fh should retain the IO + } + + # Open file after the local scope has ended + open $fh, ">", $file or die $!; + print $fh "survived\n"; + close $fh; + + my $content = do { open my $r, "<", $file; local $/; <$r> }; + is($content, "survived\n", 'Filehandle works after local scope ends'); +}; + +subtest 'Pattern used in object context (like Log::Log4perl)' => sub { + # Simulate how Log::Log4perl uses this pattern + package TestAppender { + sub new { + my ($class, $filename) = @_; + my $self = { filename => $filename }; + bless $self, $class; + + # This is exactly what Log::Log4perl::Appender::File does + my $fh = do { local *FH; *FH; }; + open $fh, ">", $filename or die "Cannot open $filename: $!"; + $self->{fh} = $fh; + + return $self; + } + + sub log { + my ($self, $msg) = @_; + my $fh = $self->{fh}; + print $fh $msg; + } + + sub close { + my ($self) = @_; + close $self->{fh} if $self->{fh}; + } + } + + package main; + + my $file1 = "$tmpdir/appender1.log"; + my $file2 = "$tmpdir/appender2.log"; + + my $app1 = TestAppender->new($file1); + my $app2 = TestAppender->new($file2); + + $app1->log("Message to appender 1\n"); + $app2->log("Message to appender 2\n"); + + $app1->close(); + $app2->close(); + + my $c1 = do { open my $r, "<", $file1; local $/; <$r> }; + my $c2 = do { open my $r, "<", $file2; local $/; <$r> }; + + is($c1, "Message to appender 1\n", 'First appender wrote to correct file'); + is($c2, "Message to appender 2\n", 'Second appender wrote to correct file'); +}; + +done_testing();