diff --git a/src/main/java/org/perlonjava/core/Configuration.java b/src/main/java/org/perlonjava/core/Configuration.java index cf0b9ed59..28a34eb2c 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 = "8333cd0ba"; + public static final String gitCommitId = "6d1d90197"; /** * Git commit date of the build (ISO format: YYYY-MM-DD). @@ -48,7 +48,7 @@ public final class Configuration { * Parsed by App::perlbrew and other tools via: perl -V | grep "Compiled at" * DO NOT EDIT MANUALLY - this value is replaced at build time. */ - public static final String buildTimestamp = "Apr 30 2026 14:33:22"; + public static final String buildTimestamp = "Apr 30 2026 15:01:59"; // Prevent instantiation private Configuration() { diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java b/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java index 06feb32c0..2d733215b 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java @@ -53,6 +53,12 @@ public static void initialize() { internals.registerMethod("V", "V", null); internals.registerMethod("getcwd", "getcwd", null); internals.registerMethod("abs_path", "abs_path", ";$"); + // PerlOnJava-only probe: report whether a fully qualified sub + // name was installed via typeglob assignment (e.g. Exporter + // imports do `*Dst::name = \&Src::name`). Used by B::GV::GvFLAGS + // to approximate the real-Perl GVf_IMPORTED_CV bit so callers + // such as Pod::Coverage can skip imported helpers. + internals.registerMethod("jperl_is_imported_sub", "jperl_is_imported_sub", "$"); } catch (NoSuchMethodException e) { System.err.println("Warning: Missing Internals method: " + e.getMessage()); } @@ -502,4 +508,26 @@ public static RuntimeList abs_path(RuntimeArray args, int ctx) { return new RuntimeScalar().getList(); // return undef on error } } + + /** + * Returns 1 if the named sub was installed via typeglob assignment + * (i.e. Exporter-style import) rather than defined directly with + * {@code sub name { ... }}, otherwise empty list (undef). + * + *

PerlOnJava tracks this in + * {@link org.perlonjava.runtime.runtimetypes.GlobalVariable#isSubs}; + * we expose it so {@code B::GV::GvFLAGS} can approximate the real-Perl + * {@code GVf_IMPORTED_CV} bit. Pod::Coverage uses this to skip + * imported helpers when reporting coverage. + * + * @param args The fully-qualified sub name (e.g. {@code "Pkg::name"}). + */ + public static RuntimeList jperl_is_imported_sub(RuntimeArray args, int ctx) { + if (args.size() == 0) return new RuntimeScalar().getList(); + String name = args.get(0).toString(); + if (org.perlonjava.runtime.runtimetypes.GlobalVariable.isSubs.getOrDefault(name, false)) { + return new RuntimeScalar(1).getList(); + } + return new RuntimeScalar().getList(); + } } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java index 4c5b8cbf0..329052202 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java @@ -330,6 +330,18 @@ public static java.util.List getGlobAliasGroup(String globName) { return group; } + /** + * Returns true if {@code globName} participates in a `*A = *B` style glob + * alias relationship. Includes both sides — only one direction is stored + * in {@link #globAliases}, so the canonical destination (e.g. {@code B} + * after {@code *A = *B}) is detected by walking the map values. + */ + public static boolean isInGlobAliasGroup(String globName) { + if (globAliases.isEmpty()) return false; + if (globAliases.containsKey(globName)) return true; + return globAliases.containsValue(globName); + } + /** * Retrieves a global variable by its key, initializing it if necessary. * If the key matches a regex capture variable pattern, it initializes a special variable. @@ -449,8 +461,35 @@ public static RuntimeArray getGlobalArray(String key) { } RuntimeArray var = globalArrays.get(key); if (var == null) { - var = new RuntimeArray(); - globalArrays.put(key, var); + // Glob-aliased names (`*A = *B`) need to share the same RuntimeArray + // so that auto-vivification under one name shows up under the other. + // Fan-out to every alias-group sibling on first creation. We detect + // membership by asking for the alias group itself instead of just + // probing globAliases.containsKey(key) — for `*A = *B`, only one + // direction is recorded in the map, so the canonical name (B) is + // not a key but is still part of the group. + java.util.List aliasGroup = isInGlobAliasGroup(key) ? getGlobAliasGroup(key) : null; + if (aliasGroup != null && aliasGroup.size() > 1) { + for (String alias : aliasGroup) { + RuntimeArray existing = globalArrays.get(alias); + if (existing != null) { + var = existing; + break; + } + } + if (var == null) { + var = new RuntimeArray(); + } + for (String alias : aliasGroup) { + globalArrays.putIfAbsent(alias, var); + } + if (!globalArrays.containsKey(key)) { + globalArrays.put(key, var); + } + } else { + var = new RuntimeArray(); + globalArrays.put(key, var); + } } return var; } @@ -508,17 +547,46 @@ public static RuntimeHash getGlobalHash(String key) { } RuntimeHash var = globalHashes.get(key); if (var == null) { - // Check if this is a package stash (ends with ::) - if (key.endsWith("::")) { - var = new RuntimeStash(key); + boolean isStash = key.endsWith("::"); + // Glob-aliased names (`*A = *B`) need to share the same RuntimeHash + // so that auto-vivification under one name shows up under the other. + // Stash-view hashes are excluded — they have their own unification + // path in RuntimeGlob.set(). See getGlobalArray() for the mirror + // logic and the rationale for using isInGlobAliasGroup() (the map + // only records one side of `*A = *B`, so the canonical name has + // to be detected via the values). + java.util.List aliasGroup = + (!isStash && isInGlobAliasGroup(key)) ? getGlobAliasGroup(key) : null; + if (aliasGroup != null && aliasGroup.size() > 1) { + for (String alias : aliasGroup) { + RuntimeHash existing = globalHashes.get(alias); + if (existing != null) { + var = existing; + break; + } + } + if (var == null) { + var = new RuntimeHash(); + } + var.isGlobalPackageHash = true; + for (String alias : aliasGroup) { + globalHashes.putIfAbsent(alias, var); + } + if (!globalHashes.containsKey(key)) { + globalHashes.put(key, var); + } } else { - var = new RuntimeHash(); + if (isStash) { + var = new RuntimeStash(key); + } else { + var = new RuntimeHash(); + } + // D-W6.18: mark as package-global so values stored here + // get the storedInPackageGlobal flag (replaces class-name + // heuristic in walker gate). + var.isGlobalPackageHash = true; + globalHashes.put(key, var); } - // D-W6.18: mark as package-global so values stored here - // get the storedInPackageGlobal flag (replaces class-name - // heuristic in walker gate). - var.isGlobalPackageHash = true; - globalHashes.put(key, var); } return var; } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java index 35ef0091f..68dd29780 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java @@ -463,7 +463,32 @@ public RuntimeScalar set(RuntimeGlob value) { RuntimeGlob sourceIO = GlobalVariable.getGlobalIO(globName); RuntimeGlob targetIO = GlobalVariable.getGlobalIO(this.globName); - RuntimeScalar ioSource = (value.IO != null) ? value.IO : sourceIO.IO; + // Prefer the source glob's IO scalar so that writes during the local + // scope are visible to the caller after it exits. This matches Perl 5 + // semantics for `local(*F) = @_` where `*F` from the caller and the + // local scope's `*F` need to share the same IO slot. + // + // The exception is `RuntimeStashEntry`: stash lookups like + // `$Pkg::{FH}` return a fresh per-call clone whose IO scalar is an + // orphaned empty placeholder, never connected to the canonical glob + // in globalIORefs. Aliasing to that orphaned scalar would make + // `open()` modify a scalar nobody else can see. For stash entries we + // therefore fall back to `sourceIO.IO` (the canonical glob's IO). + RuntimeScalar ioSource; + if (value instanceof RuntimeStashEntry) { + // Use canonical IO unless the stash entry itself happens to + // already carry a real RuntimeIO (Symbol::gensym pattern, where + // the entry was tied or had its slot populated directly). + if (value.IO != null + && (value.IO.value instanceof RuntimeIO + || value.IO.type == RuntimeScalarType.TIED_SCALAR)) { + ioSource = value.IO; + } else { + ioSource = sourceIO.IO; + } + } else { + ioSource = (value.IO != null) ? value.IO : sourceIO.IO; + } // Save old IO for selectedHandle check (needed for local *STDOUT = *OTHER) RuntimeIO oldRuntimeIO = null; @@ -480,15 +505,38 @@ public RuntimeScalar set(RuntimeGlob value) { RuntimeIO.selectedHandle = newRIO; } - // Alias the ARRAY slot: both names point to the same RuntimeArray object - RuntimeArray sourceArray = GlobalVariable.getGlobalArray(globName); - GlobalVariable.globalArrays.put(this.globName, sourceArray); + // Alias the ARRAY slot: both names point to the same RuntimeArray object. + // Only alias if the source actually has an array slot — calling + // getGlobalArray() here would auto-vivify an empty array, which then + // makes `defined *dst{ARRAY}` return true even though neither source + // nor dest ever had an array. Devel::Symdump and other introspection + // modules rely on the absence of these slots. + if (GlobalVariable.existsGlobalArray(globName)) { + RuntimeArray sourceArray = GlobalVariable.getGlobalArray(globName); + GlobalVariable.globalArrays.put(this.globName, sourceArray); + } - // Alias the HASH slot: both names point to the same RuntimeHash object - RuntimeHash sourceHash = GlobalVariable.getGlobalHash(globName); - GlobalVariable.globalHashes.put(this.globName, sourceHash); + // Alias the HASH slot: both names point to the same RuntimeHash object. + // Stash globs (name ends with "::") always have an intrinsic HASH slot + // that mirrors the package's symbol table — getGlobSlot("HASH") returns + // it unconditionally for stashes, so we must materialise the alias here + // even if globalHashes hasn't been populated yet. + boolean sourceHasHash = GlobalVariable.existsGlobalHash(globName) + || globName.endsWith("::"); + if (sourceHasHash) { + RuntimeHash sourceHash = GlobalVariable.getGlobalHash(globName); + GlobalVariable.globalHashes.put(this.globName, sourceHash); + } - // Alias the SCALAR slot: both names point to the same RuntimeScalar object + // Alias the SCALAR slot: both names point to the same RuntimeScalar + // object. We deliberately auto-vivify the source side when it doesn't + // exist yet — unlike arrays/hashes, a scalar slot is always present + // in real Perl semantics (a glob's GvSV is conceptually always there, + // even if it holds undef), so consumers like `*& = *a6; *& = 0` + // expect that `*& = *a6` makes `*&` and `*a6` share storage even when + // neither has been written yet. Without this, the second `*& = 0` + // hits the original read-only `$&` instead of the freshly-aliased + // scalar (refstack.t GH#15752). RuntimeScalar sourceScalar = GlobalVariable.getGlobalVariable(globName); GlobalVariable.globalVariables.put(this.globName, sourceScalar); @@ -564,14 +612,28 @@ public RuntimeScalar getGlobSlot(RuntimeScalar index) { case "IO", "FILEHANDLE" -> { // Accessing the IO slot yields a blessable reference-like value. // We model this by returning a GLOBREFERENCE wrapper around the RuntimeIO. - if (IO != null && IO.type == RuntimeScalarType.GLOB && IO.value instanceof RuntimeIO) { + // + // For named globs we may be looking at a *copy* of the canonical + // glob (e.g. RuntimeStashEntry, or the lightweight clone produced + // by globDeref()). `open(Pkg::FH, ...)` only stores the + // RuntimeIO on the canonical glob in globalIORefs, so consult + // that as a fallback when the local IO slot is empty. + RuntimeScalar effectiveIO = this.IO; + if ((effectiveIO == null || effectiveIO.value == null) && this.globName != null) { + RuntimeGlob canonical = GlobalVariable.peekGlobalIO(this.globName); + if (canonical != null && canonical != this && canonical.IO != null) { + effectiveIO = canonical.IO; + } + } + if (effectiveIO != null && effectiveIO.type == RuntimeScalarType.GLOB + && effectiveIO.value instanceof RuntimeIO) { RuntimeScalar ioRef = new RuntimeScalar(); ioRef.type = RuntimeScalarType.GLOBREFERENCE; - ioRef.value = IO.value; - ioRef.blessId = IO.blessId; + ioRef.value = effectiveIO.value; + ioRef.blessId = effectiveIO.blessId; yield ioRef; } - yield IO; + yield effectiveIO != null ? effectiveIO : IO; } case "SCALAR" -> { // For anonymous globs (null globName), use local scalarSlot @@ -650,7 +712,11 @@ public RuntimeHash getGlobHash() { // The glob for $::{"UNIVERSAL::"} has globName "main::UNIVERSAL::" but the // stash is stored with key "UNIVERSAL::". Strip "main::" for top-level packages. if (this.globName.endsWith("::")) { - String stashKey = this.globName.startsWith("main::") + // Strip a leading "main::" only when there is something after it + // (e.g. "main::Foo::" -> "Foo::"). For the bare "main::" stash, + // keep the key intact so we don't end up looking up "" and + // returning an empty hash. Mirrors GlobalVariable.getGlobalHash(). + String stashKey = this.globName.length() > 6 && this.globName.startsWith("main::") ? this.globName.substring(6) : this.globName; return GlobalVariable.getGlobalHash(stashKey); @@ -977,9 +1043,13 @@ public RuntimeGlob undefine() { @Override public void dynamicSaveState() { - RuntimeScalar savedScalar = GlobalVariable.getGlobalVariable(this.globName); - RuntimeArray savedArray = GlobalVariable.getGlobalArray(this.globName); - RuntimeHash savedHash = GlobalVariable.getGlobalHash(this.globName); + // Capture pre-existence so we can faithfully restore an absent slot + // (rather than leaving an empty placeholder behind that would make + // `defined *glob{ARRAY|HASH}` lie after `local(*glob) = $val`). + // Use direct map access so we don't auto-vivify the slot here. + RuntimeScalar savedScalar = GlobalVariable.globalVariables.get(this.globName); + RuntimeArray savedArray = GlobalVariable.globalArrays.get(this.globName); + RuntimeHash savedHash = GlobalVariable.globalHashes.get(this.globName); RuntimeScalar savedCode = GlobalVariable.getGlobalCodeRef(this.globName); // Save the current IO object reference (not its state) so we can restore it later. // This allows captured glob references to keep the "local" IO even after restore. @@ -996,15 +1066,34 @@ public void dynamicSaveState() { savedSelectedHandle = RuntimeIO.selectedHandle; isSelectedHandle = true; } - globSlotStack.push(new GlobSlotSnapshot(this.globName, savedScalar, savedArray, savedHash, savedCode, savedIO, savedSelectedHandle)); + globSlotStack.push(new GlobSlotSnapshot(this.globName, + savedScalar, savedArray, savedHash, + savedCode, savedIO, savedSelectedHandle)); // Replace global table entries with NEW empty objects instead of mutating the // existing ones in-place. This is critical because the existing objects may be // aliased (e.g., via *glob = $blessed_ref), and calling dynamicSaveState() on // them would clear/corrupt the original blessed reference's data. + // + // Only pre-populate slots that already existed before the local scope. + // Otherwise we would make `defined *glob{ARRAY|HASH}` return true even + // when neither the saved state nor any code in the local scope ever + // assigned to the slot. Lazy slot creation handles writes within the + // local scope: getGlobalArray()/getGlobalHash() will materialise a + // fresh empty container on first access, which is then visible only + // for the duration of the scope (dynamicRestoreState removes it). + // The scalar slot is conceptually always present in Perl (a glob's + // GvSV is "there" with value undef even when never written), so + // unconditionally install a fresh RuntimeScalar for the local scope. + // Otherwise `local *X; $X = 5` would mutate the canonical $X and the + // change would survive the scope exit. GlobalVariable.globalVariables.put(this.globName, new RuntimeScalar()); - GlobalVariable.globalArrays.put(this.globName, new RuntimeArray()); - GlobalVariable.globalHashes.put(this.globName, new RuntimeHash()); + if (savedArray != null) { + GlobalVariable.globalArrays.put(this.globName, new RuntimeArray()); + } + if (savedHash != null) { + GlobalVariable.globalHashes.put(this.globName, new RuntimeHash()); + } RuntimeScalar newCode = new RuntimeScalar(); GlobalVariable.globalCodeRefs.put(this.globName, newCode); // Decrement stashRefCount on the saved CODE ref being removed from the stash @@ -1067,9 +1156,24 @@ public void dynamicRestoreState() { // Restore saved objects directly - they were never mutated, so no // dynamicRestoreState() call is needed. - GlobalVariable.globalVariables.put(snap.globName, snap.scalar); - GlobalVariable.globalHashes.put(snap.globName, snap.hash); - GlobalVariable.globalArrays.put(snap.globName, snap.array); + // A null saved value means the slot did not exist before the local + // scope; remove the placeholder we may have lazily created during the + // scope so that `defined *glob{SLOT}` reports false again. + if (snap.scalar != null) { + GlobalVariable.globalVariables.put(snap.globName, snap.scalar); + } else { + GlobalVariable.globalVariables.remove(snap.globName); + } + if (snap.hash != null) { + GlobalVariable.globalHashes.put(snap.globName, snap.hash); + } else { + GlobalVariable.globalHashes.remove(snap.globName); + } + if (snap.array != null) { + GlobalVariable.globalArrays.put(snap.globName, snap.array); + } else { + GlobalVariable.globalArrays.remove(snap.globName); + } // Before replacing the code ref, decrement the refCount of the CODE // that was installed during the local scope. The local scope's code diff --git a/src/main/perl/lib/B.pm b/src/main/perl/lib/B.pm index dede76a0a..6cdccc04f 100644 --- a/src/main/perl/lib/B.pm +++ b/src/main/perl/lib/B.pm @@ -281,6 +281,58 @@ package B::GV { } return B::SPECIAL->new(0); # 0 = index for 'Nullsv' } + + # GvFLAGS returns the GV flag bits. PerlOnJava does not track real GV + # flags, but we can approximate GVf_IMPORTED_CV by comparing the CV's + # original package (recorded via Sub::Util introspection) against this + # GV's stash. When a sub is imported into another package via typeglob + # assignment (Exporter style), the CV remembers its home package, so + # if they disagree we report the IMPORTED_CV bit. This is what callers + # such as Pod::Coverage rely on to skip imported helpers. + sub GvFLAGS { + my $self = shift; + my $name = $self->{name}; + my $pkg = $self->{package}; + return 0 unless defined $name && defined $pkg && length $name; + my $fqn = "${pkg}::${name}"; + # PerlOnJava records typeglob CODE assignments (Exporter imports + # like `*Dst::name = \&Src::name`) in an internal map. Expose that + # as the GVf_IMPORTED_CV bit so callers like Pod::Coverage skip + # imported helpers without forcing every package to document them. + if (Internals::jperl_is_imported_sub($fqn)) { + return B::GVf_IMPORTED_CV(); + } + # Constants defined via `use constant` are stored in PerlOnJava as + # CODE slots with an empty prototype. Real Perl uses proxy constant + # subroutines (PCS) and tags them with GVf_IMPORTED_CV so Pod + # coverage tools skip them; mirror that here so packages that only + # declare constants don't fail Pod::Coverage tests. + no strict 'refs'; + my $code = *{$fqn}{CODE}; + if (defined $code) { + my $proto = prototype($code); + if (defined $proto && $proto eq '') { + return B::GVf_IMPORTED_CV(); + } + } + return 0; + } + + # CV slot accessor: return a B::CV for the sub installed under this glob, + # or B::SPECIAL/Nullsv when the slot is empty. Pod::Coverage and friends + # call this to inspect the underlying coderef. + sub CV { + my $self = shift; + my $name = $self->{name}; + my $pkg = $self->{package}; + my $fqn = $pkg . '::' . $name; + no strict 'refs'; + my $code = *{$fqn}{CODE}; + if (defined $code) { + return B::CV->new($code); + } + return B::SPECIAL->new(0); + } } package B::SPECIAL { @@ -413,6 +465,12 @@ sub svref_2object { # Export CVf_ANON as a function sub CVf_ANON() { return 0x0004; } +# GV flag for "this CV was imported". Real Perl uses 0x80 in older perls and +# 0x4000 in newer ones; Pod::Coverage falls back to 0x80 when this is missing. +# Returning 0 here means GvFLAGS() & GVf_IMPORTED_CV() is always 0 (PerlOnJava +# doesn't track this), which is what callers default to anyway. +sub GVf_IMPORTED_CV() { return 0x80; } + # Export SVf_IOK as a function sub SVf_IOK() { return 0x00000100; } diff --git a/src/main/perl/lib/Config.pm b/src/main/perl/lib/Config.pm index 70dbf1afc..c43ffd00d 100644 --- a/src/main/perl/lib/Config.pm +++ b/src/main/perl/lib/Config.pm @@ -197,6 +197,15 @@ $os_name =~ s/\s+/_/g; d_double_has_inf => 'define', d_double_has_nan => 'define', d_double_style_ieee => 'define', + + # Directory handles — we implement opendir/readdir/telldir/closedir + # via java.nio. Devel::Symdump (and similar introspection modules) + # branch on these to choose between telldir() and B::IO::IoTYPE + # introspection, so they need to be advertised honestly. + d_telldir => 'define', + d_seekdir => 'define', + d_rewinddir => 'define', + d_readdir => 'define', # Socket support - we have implemented socket operators d_socket => 'define',