Skip to content

Commit 321ca79

Browse files
Fix jcpan -t DateTime regressions: XSLoader @isa fallback and scopeExitCleanup
Three issues fixed: 1. XSLoader @isa fallback too broad (from #441): When a module like Clone has @isa=(Exporter) and XSLoader::load fails to find the Java XS class, the fallback code treated any non-empty @isa as proof the module can work through inheritance. This prevented Clone::PP from loading, breaking the entire DateTime dependency chain. Fix: add NON_FUNCTIONAL_ISA set (Exporter, DynaLoader, AutoLoader, XSLoader) and only succeed on @isa fallback when a functional parent is present. 2. scopeExitCleanup closing shared IO handles (from #440): The foreach body null-stores with closeIO=true called scopeExitCleanup on ALL scalars, including copies of shared filehandle references. This broke Test2 TODO mechanism because Test2::Formatter::TAP copies STDOUT handles into a loop variable, and scopeExitCleanup closed them prematurely. Fix: add ioOwner flag to RuntimeScalar, set only by IOOperator.open() when creating a new anonymous glob. scopeExitCleanup now only closes IO on scalars marked as IO owners. Copies via set() do not inherit the flag. 3. TAP::Parser::Iterator::Process warnings: Guard sysread return value against empty string, skip $fh == $err comparison when $err is not a real filehandle (empty string in PerlOnJava), and protect err handle close against missing refs. Generated with [Devin](https://cli.devin.ai/docs) Co-Authored-By: Devin <158243242+devin-ai-integration[bot]@users.noreply.github.com>
1 parent 0ce54d5 commit 321ca79

5 files changed

Lines changed: 68 additions & 9 deletions

File tree

src/main/java/org/perlonjava/core/Configuration.java

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@ public final class Configuration {
3333
* Automatically populated by Gradle/Maven during build.
3434
* DO NOT EDIT MANUALLY - this value is replaced at build time.
3535
*/
36-
public static final String gitCommitId = "5e818ead7";
36+
public static final String gitCommitId = "9ad8b915c";
3737

3838
/**
3939
* Git commit date of the build (ISO format: YYYY-MM-DD).

src/main/java/org/perlonjava/runtime/operators/IOOperator.java

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -613,6 +613,11 @@ else if (secondArg.type == RuntimeScalarType.GLOB || secondArg.type == RuntimeSc
613613
RuntimeIO.registerGlobForFdRecycling(anonGlob, fh);
614614
// Use set() to modify the lvalue in place
615615
fileHandle.set(newGlob);
616+
// Mark this scalar as the IO owner so scopeExitCleanup will close
617+
// the handle when the variable goes out of scope. Copies of this
618+
// reference (via set()) won't have ioOwner=true, preventing
619+
// premature close of shared handles (e.g., Test2's dup'd STDOUT).
620+
fileHandle.ioOwner = true;
616621
}
617622
long pid = fh.getPid();
618623
if (pid > 0) return new RuntimeScalar(pid);

src/main/java/org/perlonjava/runtime/perlmodule/XSLoader.java

Lines changed: 43 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -8,12 +8,27 @@
88
import java.lang.reflect.Field;
99
import java.lang.reflect.Method;
1010
import java.nio.charset.StandardCharsets;
11+
import java.util.Set;
1112

1213
import static org.perlonjava.runtime.runtimetypes.RuntimeContextType.SCALAR;
1314
import static org.perlonjava.runtime.runtimetypes.RuntimeScalarCache.scalarTrue;
1415

1516
public class XSLoader extends PerlModuleBase {
1617

18+
/**
19+
* Non-functional base classes that should be ignored when checking @ISA
20+
* for pure-Perl fallback parents. These classes provide infrastructure
21+
* (exporting, autoloading) but not the module's actual functionality.
22+
* A module with only these in @ISA should NOT get the silent success
23+
* treatment — it needs XS or its own pure-Perl fallback code.
24+
*/
25+
private static final Set<String> NON_FUNCTIONAL_ISA = Set.of(
26+
"Exporter",
27+
"DynaLoader",
28+
"AutoLoader",
29+
"XSLoader"
30+
);
31+
1732
/**
1833
* Constructor for XSLoader.
1934
* Initializes the module with the name "XSLoader".
@@ -94,13 +109,18 @@ public static RuntimeList load(RuntimeArray args, int ctx) {
94109

95110
return scalarTrue.getList();
96111
} catch (Exception e) {
97-
// No Java XS class found. If the module's @ISA already has a pure-Perl
98-
// parent (set by the .pm file before calling XSLoader::load), the module
99-
// can function through inheritance. Return success so the require doesn't
100-
// fail — the pure-Perl methods from the parent will be used.
112+
// No Java XS class found. If the module's @ISA already has a
113+
// functional pure-Perl parent (set by the .pm file before calling
114+
// XSLoader::load), the module can function through inheritance.
115+
// Return success so the require doesn't fail.
116+
//
117+
// We skip non-functional base classes (Exporter, DynaLoader, etc.)
118+
// because their presence in @ISA does NOT mean the module can work
119+
// without its XS code — e.g. Clone has @ISA=(Exporter) but still
120+
// needs its own pure-Perl fallback to define clone().
101121
String isaKey = moduleName + "::ISA";
102122
RuntimeArray isa = GlobalVariable.getGlobalArray(isaKey);
103-
if (isa != null && !isa.isEmpty()) {
123+
if (isa != null && hasFunctionalParent(isa)) {
104124
// @ISA fallback succeeded. Also try to load any jar: PERL5LIB shim
105125
// for this module, which may provide method overrides (e.g., bug fixes
106126
// for the pure-Perl parent that the XS version would normally handle).
@@ -164,6 +184,24 @@ private static boolean versionsCompatible(String javaVersion, String requestedVe
164184
return javaMajor.equals(requestedMajor);
165185
}
166186

187+
/**
188+
* Checks whether @ISA contains at least one functional parent class.
189+
* Non-functional base classes (Exporter, DynaLoader, etc.) are skipped
190+
* because they provide infrastructure, not the module's actual methods.
191+
*
192+
* @param isa The module's @ISA array
193+
* @return true if at least one entry is a functional parent
194+
*/
195+
private static boolean hasFunctionalParent(RuntimeArray isa) {
196+
for (int i = 0; i < isa.size(); i++) {
197+
String parent = isa.get(i).toString();
198+
if (!NON_FUNCTIONAL_ISA.contains(parent)) {
199+
return true;
200+
}
201+
}
202+
return false;
203+
}
204+
167205
/**
168206
* Stub implementation of bootstrap_inherit for compatibility.
169207
* In standard Perl, this is used for inheritance-aware XS loading.

src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java

Lines changed: 14 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,19 @@ private static boolean mightBeInteger(String s) {
6565
public int type;
6666
public Object value;
6767

68+
/**
69+
* True if this scalar was the direct target of an {@code open()} call that
70+
* created a new anonymous filehandle glob. Used by {@link #scopeExitCleanup}
71+
* to distinguish "owned" filehandles (should be closed at scope exit) from
72+
* copies/aliases of shared handles (should NOT be closed, as other variables
73+
* still reference the same glob).
74+
* <p>
75+
* Set by {@link org.perlonjava.runtime.operators.IOOperator#open} after creating
76+
* a new anonymous glob. NOT copied by {@link #set(RuntimeScalar)}, so copies
77+
* like {@code my $io = $handles->[$hid]} remain {@code false}.
78+
*/
79+
public boolean ioOwner;
80+
6881
// Constructors
6982
public RuntimeScalar() {
7083
this.type = UNDEF;
@@ -1798,7 +1811,7 @@ private void closeIOOnDrop() {
17981811
* @param scalar the RuntimeScalar being cleaned up (may be null if slot was already nulled)
17991812
*/
18001813
public static void scopeExitCleanup(RuntimeScalar scalar) {
1801-
if (scalar != null && scalar.type == GLOBREFERENCE
1814+
if (scalar != null && scalar.ioOwner && scalar.type == GLOBREFERENCE
18021815
&& scalar.value instanceof RuntimeGlob glob
18031816
&& glob.globName == null) {
18041817
RuntimeScalar ioSlot = glob.getIO();

src/main/perl/lib/TAP/Parser/Iterator/Process.pm

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -254,11 +254,12 @@ sub _next {
254254
while ( my @ready = $sel->can_read ) {
255255
for my $fh (@ready) {
256256
my $got = sysread $fh, my ($chunk), $chunk_size;
257+
$got = 0 if !defined $got || $got eq '';
257258

258259
if ( $got == 0 ) {
259260
$sel->remove($fh);
260261
}
261-
elsif ( $fh == $err ) {
262+
elsif ( ref $err && $fh == $err ) {
262263
print STDERR $chunk; # echo STDERR
263264
}
264265
else {
@@ -340,7 +341,9 @@ sub _finish {
340341

341342
# If we have an IO::Select we also have an error handle to close.
342343
if ( $self->{sel} ) {
343-
( delete $self->{err} )->close;
344+
if ( $self->{err} && ref $self->{err} ) {
345+
( delete $self->{err} )->close;
346+
}
344347
delete $self->{sel};
345348
}
346349
else {

0 commit comments

Comments
 (0)