diff --git a/dev/modules/cpanplus.md b/dev/modules/cpanplus.md index 751463c81..e578fef13 100644 --- a/dev/modules/cpanplus.md +++ b/dev/modules/cpanplus.md @@ -2,7 +2,22 @@ ## Current Status -`CPANPLUS::Config` now loads under PerlOnJava after fixing loop-control parsing for bare labels that share a name with an imported constant. This unblocks the upstream `Makefile.PL` path that declares CPANPLUS' dynamic prerequisites, including `Log::Message`. +`CPANPLUS::Config` loads under PerlOnJava after fixing loop-control parsing for bare labels that share a name with an imported constant. This unblocks the upstream `Makefile.PL` path that declares CPANPLUS' dynamic prerequisites. + +`./jcpan -t CPANPLUS` now passes with CPANPLUS 0.9916: + +```text +Files=20, Tests=1751, Result: PASS +EXIT: 0 +``` + +The run also verifies the dependency chain that previously blocked CPANPLUS: `Archive::Extract`, `Object::Accessor`, `File::Fetch`, `Log::Message`, `Module::Loaded`, `Package::Constants`, `Log::Message::Simple`, and `Term::UI`. + +The only observed remaining issue is a non-fatal warning during CPANPLUS' own suite: + +```text +Use of uninitialized value in addition (+) at jar:PERL5LIB/File/Copy.pm line 303. +``` ## Symptom @@ -25,7 +40,7 @@ WriteMakefile( That fallback had no `PREREQ_PM`, so `Log::Message` was never scheduled. -## Root Cause Fixed +## Root Causes Fixed `CPANPLUS::Config` imports constants from `CPANPLUS::Internals::Constants`, including: @@ -45,11 +60,34 @@ Perl treats bare `last BIN` as a literal loop label, even when a constant sub na The fix keeps a standalone bare identifier immediately after `last`, `next`, or `redo` as a literal loop label. Parenthesized and expression labels still go through the dynamic-label path. +`Archive::Extract` then failed because PerlOnJava's bundled `Archive::Zip` member objects exposed `_name` but CPAN `Archive::Extract` expects the compatibility hash key `fileName`, and it passes member objects back into `extractMember`. The bundled module now exposes both names and accepts member objects. + +`Object::Accessor` then exposed tied lexical cleanup differences. A tied lexical scalar whose tie object should be destroyed at scope exit was being cleaned through the generic scalar path, so `DESTROY` did not fire at the Perl-compatible time. Tied scalar cleanup is now explicit and idempotent, including the closure-capture case. + +CPANPLUS' tests also use strict bareword coderef calls in forms such as `BUILD_PL->(...)`, `-e BUILD_PL->(...)`, and `stat MAKEFILE->(...)`. PerlOnJava now treats a bareword to the left of `->(...)` as a sub call returning a coderef, and reassociates filetest and `stat`/`lstat` unary operators so those expressions match Perl's parse. + +Version checks then exposed decimal vs dotted-version numification differences. `version->parse("v1.5")->numify` now returns `1.005000`, while decimal versions such as `1.5` and `1.2345` retain decimal-padding semantics. + +The final CPANPLUS blocker was in the generated Makefile for a dummy `Foo-Bar` distribution. When `Makefile.PL` was rerun after `blib/lib` already existed, PerlOnJava's MakeMaker treated staged `blib/lib/*.pm` files as source files. Its generated `pm_to_blib` target could delete `blib/lib/Foo/Bar.pm` and then try to copy that same path back to itself. MakeMaker now prefers real `lib/` sources over stale `blib/` entries and does not stage already-staged files back into `blib`. + ## Completed Work - Fixed loop-control parsing in [`OperatorParser.java`](../../src/main/java/org/perlonjava/frontend/parser/OperatorParser.java). - Added regression coverage in [`loop_label_bareword_constant.t`](../../src/test/resources/unit/loop_label_bareword_constant.t). - Verified CPANPLUS' upstream `Makefile.PL` now completes and emits `PREREQ_PM` / `MYMETA.yml` entries for `Log::Message`. +- Fixed the `Archive::Extract` dependency failure by making PerlOnJava's bundled `Archive::Zip` expose the CPAN-compatible member hash field `fileName` and accept member objects in `extractMember`. +- Added regression coverage in [`archive_zip_members_matching_qr.t`](../../src/test/resources/unit/archive_zip_members_matching_qr.t) for direct member hash access and object extraction. +- Verified `Archive::Extract` 0.88 upstream suite passes: `Files=1, Tests=1795, Result: PASS`. +- Fixed tied scalar scope cleanup so `Object::Accessor` local attribute restore passes. +- Added regression coverage in [`tie_scalar.t`](../../src/test/resources/unit/tie_scalar.t) for tied lexical `DESTROY` at scope exit and deferred destruction while a tie object is still referenced. +- Fixed strict bareword coderef arrow parsing and filetest/stat reassociation for CPANPLUS' `BUILD_PL->(...)` and `MAKEFILE->(...)` patterns. +- Added regression coverage in [`subroutine.t`](../../src/test/resources/unit/subroutine.t) for strict bareword coderef calls and unary-operator reassociation. +- Fixed `version` numification/normalization for dotted `v` versions and decimal versions. +- Added regression coverage in [`version_numify.t`](../../src/test/resources/unit/version_numify.t). +- Fixed PerlOnJava MakeMaker reruns after `blib/lib` exists so stale staged files are not copied onto themselves. +- Added regression coverage in [`makemaker_stale_blib_source.t`](../../src/test/resources/unit/makemaker_stale_blib_source.t). +- Verified `Object::Accessor` upstream suite passes: `Files=7, Tests=155, Result: PASS`. +- Verified `./jcpan -t CPANPLUS` passes: `Files=20, Tests=1751, Result: PASS`. - Verified `make` passes. ## Acceptance @@ -57,7 +95,7 @@ The fix keeps a standalone bare identifier immediately after `last`, `next`, or ```bash timeout 60 ./jperl src/test/resources/unit/loop_label_bareword_constant.t timeout 60 ./jperl -I$CPANPLUS_DIR/inc/bundle -I$CPANPLUS_DIR/lib -e 'require CPANPLUS::Config; print "ok\n"' -timeout 600 ./jcpan -t CPANPLUS +timeout 1200 ./jcpan -t CPANPLUS make ``` @@ -65,13 +103,12 @@ Before running the full `jcpan -t CPANPLUS` acceptance, make sure no local CPANP ## Next Steps -1. Re-run `timeout 600 ./jcpan -t CPANPLUS` without the temporary local CPANPLUS distropref and confirm CPAN installs or schedules `Log::Message` from the upstream Makefile.PL metadata. -2. Inspect the generated `Makefile`, `MYMETA.yml`, and CPAN log to verify `PREREQ_PM` includes the CPANPLUS runtime dependency set from `CPANPLUS::Selfupdate`. -3. Continue from the next observed failures after dependency discovery is correct. The earlier workaround run reached `Archive::Extract` and `Module::Loaded`; treat those as separate module/runtime issues, not dependency-discovery fixes. -4. Add any new minimal runtime/parser regression tests before patching CPAN distroprefs. Distroprefs should only be used for unavoidable CPAN packaging/test harness differences, not to hide missing interpreter semantics. -5. When CPANPLUS tests are passing or have documented non-runtime blockers, update this document with the final test count and remaining skips/failures. +1. Reduce the non-fatal `File::Copy.pm line 303` warning from CPANPLUS' own suite. It appears to come from numeric conversion of `$!` or `$^E` after a failed move fallback, but it does not currently fail CPANPLUS. +2. Re-run `timeout 1200 ./jcpan -t CPANPLUS` from a fresh or isolated CPAN home before merging if cache independence is required. +3. Audit whether MakeMaker still needs to discover installable files from `blib/lib`; if it does, keep the new no-self-staging behavior as the regression guard. +4. Keep CPANPLUS as a regression target when touching `Archive::Extract`, `Object::Accessor`, `ExtUtils::MakeMaker`, parser precedence, or `version`. ## Open Questions -- Does CPAN consume CPANPLUS' dynamic prereqs from `MYMETA.yml` reliably after the upstream Makefile.PL succeeds, or does PerlOnJava's MakeMaker shim need a targeted metadata handoff fix? -- Are the later `Archive::Extract` / `Module::Loaded` failures pure module gaps, network/cache issues, or consequences of CPANPLUS test setup? +- Does the `File::Copy` warning reveal a generic `$!` / `$^E` numeric conversion difference when the error variables are unset? +- Are there CPAN distributions that intentionally rely on MakeMaker installing files that only exist under `blib/lib` after configure/build, and should that path be modeled more explicitly? diff --git a/src/main/java/org/perlonjava/frontend/parser/ParseInfix.java b/src/main/java/org/perlonjava/frontend/parser/ParseInfix.java index 1480c8586..809509719 100644 --- a/src/main/java/org/perlonjava/frontend/parser/ParseInfix.java +++ b/src/main/java/org/perlonjava/frontend/parser/ParseInfix.java @@ -191,6 +191,15 @@ public static Node parseInfixOperation(Parser parser, Node left, int precedence) case "(": TokenUtils.consume(parser); right = new ListNode(ListParser.parseList(parser, ")", 0), parser.tokenIndex); + if (left instanceof OperatorNode op && isArrowReassociatingUnaryOperator(op.operator)) { + Node arrowLeft = coderefArrowLeft(op.operand); + BinaryOperatorNode arrowCall = new BinaryOperatorNode(token.text, + arrowLeft, + right, + parser.tokenIndex); + return new OperatorNode(op.operator, arrowCall, op.getIndex()); + } + left = coderefArrowLeft(left); return new BinaryOperatorNode(token.text, left, right, parser.tokenIndex); case "**": // Postfix GLOB dereference: $ref->** @@ -630,4 +639,23 @@ private static void checkMyInFalseConditional(String operator, Node left, Node r } } } + + private static Node coderefArrowLeft(Node left) { + if (left instanceof IdentifierNode) { + OperatorNode subRef = new OperatorNode("&", left, left.getIndex()); + return new BinaryOperatorNode("(", + subRef, + new ListNode(left.getIndex()), + left.getIndex()); + } + return left; + } + + private static boolean isArrowReassociatingUnaryOperator(String operator) { + if (operator == null) return false; + if (operator.equals("stat") || operator.equals("lstat")) return true; + return operator.length() == 2 + && operator.charAt(0) == '-' + && "rwxoRWXOezsfdlpSbctugkTBMAC".indexOf(operator.charAt(1)) >= 0; + } } diff --git a/src/main/java/org/perlonjava/runtime/operators/VersionHelper.java b/src/main/java/org/perlonjava/runtime/operators/VersionHelper.java index d7db90278..934730d11 100644 --- a/src/main/java/org/perlonjava/runtime/operators/VersionHelper.java +++ b/src/main/java/org/perlonjava/runtime/operators/VersionHelper.java @@ -336,6 +336,9 @@ public static String normalizeVersion(RuntimeScalar wantVersion) { if (minor.length() > 3) { minor = minor.substring(0, 3); } + while (patch.length() < 3) { + patch = patch + "0"; + } if (patch.length() > 3) { patch = patch.substring(0, 3); } diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/ArchiveZip.java b/src/main/java/org/perlonjava/runtime/perlmodule/ArchiveZip.java index 1dd13a527..b43555bd8 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/ArchiveZip.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/ArchiveZip.java @@ -34,6 +34,8 @@ public class ArchiveZip extends PerlModuleBase { private static final String MEMBERS_KEY = "_members"; private static final String FILENAME_KEY = "_filename"; private static final String COMMENT_KEY = "_zipfileComment"; + private static final String MEMBER_NAME_KEY = "_name"; + private static final String MEMBER_COMPAT_FILENAME_KEY = "fileName"; /** * Resolve a path string against Perl's notion of the current working @@ -329,7 +331,7 @@ public static RuntimeList readFromFileHandle(RuntimeArray args, int ctx) { // Create member object RuntimeHash member = new RuntimeHash(); - member.put("_name", new RuntimeScalar(entry.getName())); + putMemberName(member, entry.getName()); member.put("_externalFileName", new RuntimeScalar("")); member.put("_isDirectory", entry.isDirectory() ? scalarTrue : scalarFalse); member.put("_uncompressedSize", new RuntimeScalar(entry.getSize() >= 0 ? entry.getSize() : entryBaos.size())); @@ -511,7 +513,8 @@ public static RuntimeList memberNames(RuntimeArray args, int ctx) { RuntimeList result = new RuntimeList(); for (int i = 0; i < members.size(); i++) { RuntimeHash member = members.get(i).hashDeref(); - result.add(member.get("_name")); + RuntimeScalar memberName = getMemberNameScalar(member); + result.add(memberName != null ? memberName : scalarUndef); } return result; } @@ -545,7 +548,7 @@ public static RuntimeList memberNamed(RuntimeArray args, int ctx) { for (int i = 0; i < members.size(); i++) { RuntimeHash member = members.get(i).hashDeref(); - RuntimeScalar memberName = member.get("_name"); + RuntimeScalar memberName = getMemberNameScalar(member); if (memberName != null && memberName.toString().equals(name)) { return members.get(i).getList(); } @@ -577,7 +580,7 @@ public static RuntimeList membersMatching(RuntimeArray args, int ctx) { try { for (int i = 0; i < members.size(); i++) { RuntimeHash member = members.get(i).hashDeref(); - RuntimeScalar memberName = member.get("_name"); + RuntimeScalar memberName = getMemberNameScalar(member); if (memberName != null && RuntimeRegex.matchRegex( regex, memberName, RuntimeContextType.SCALAR).scalar().getBoolean()) { result.add(members.get(i)); @@ -616,7 +619,7 @@ public static RuntimeList addFile(RuntimeArray args, int ctx) { long lastModified = Files.getLastModifiedTime(path).toMillis(); RuntimeHash member = new RuntimeHash(); - member.put("_name", new RuntimeScalar(memberName)); + putMemberName(member, memberName); member.put("_externalFileName", new RuntimeScalar(filename)); member.put("_contents", new RuntimeScalar(new String(content, StandardCharsets.ISO_8859_1))); member.put("_isDirectory", scalarFalse); @@ -655,7 +658,7 @@ public static RuntimeList addString(RuntimeArray args, int ctx) { byte[] contentBytes = content.getBytes(StandardCharsets.ISO_8859_1); RuntimeHash member = new RuntimeHash(); - member.put("_name", new RuntimeScalar(memberName)); + putMemberName(member, memberName); member.put("_externalFileName", new RuntimeScalar("")); member.put("_contents", new RuntimeScalar(content)); member.put("_isDirectory", scalarFalse); @@ -692,7 +695,7 @@ public static RuntimeList addDirectory(RuntimeArray args, int ctx) { } RuntimeHash member = new RuntimeHash(); - member.put("_name", new RuntimeScalar(dirName)); + putMemberName(member, dirName); member.put("_externalFileName", new RuntimeScalar("")); member.put("_contents", new RuntimeScalar("")); member.put("_isDirectory", scalarTrue); @@ -721,7 +724,17 @@ public static RuntimeList extractMember(RuntimeArray args, int ctx) { } RuntimeHash self = args.get(0).hashDeref(); - String memberName = args.get(1).toString(); + RuntimeScalar memberArg = args.get(1); + String memberName; + if (RuntimeScalarType.isReference(memberArg)) { + RuntimeScalar name = getMemberNameScalar(memberArg.hashDeref()); + if (name == null || name.type == RuntimeScalarType.UNDEF) { + return new RuntimeScalar(AZ_ERROR).getList(); + } + memberName = name.toString(); + } else { + memberName = memberArg.toString(); + } String destName = args.size() > 2 ? args.get(2).toString() : memberName; try { @@ -729,7 +742,7 @@ public static RuntimeList extractMember(RuntimeArray args, int ctx) { for (int i = 0; i < members.size(); i++) { RuntimeHash member = members.get(i).hashDeref(); - RuntimeScalar name = member.get("_name"); + RuntimeScalar name = getMemberNameScalar(member); if (name != null && name.toString().equals(memberName)) { RuntimeScalar isDir = member.get("_isDirectory"); if (isDir != null && isDir.getBoolean()) { @@ -789,7 +802,7 @@ public static RuntimeList extractMemberWithoutPaths(RuntimeArray args, int ctx) member = found.scalar().hashDeref(); } - RuntimeScalar name = member.get("_name"); + RuntimeScalar name = getMemberNameScalar(member); if (name == null) { return new RuntimeScalar(AZ_ERROR).getList(); } @@ -876,7 +889,7 @@ public static RuntimeList extractTree(RuntimeArray args, int ctx) { for (int i = 0; i < members.size(); i++) { RuntimeHash member = members.get(i).hashDeref(); - RuntimeScalar name = member.get("_name"); + RuntimeScalar name = getMemberNameScalar(member); if (name == null) continue; String memberName = name.toString(); @@ -933,7 +946,7 @@ public static RuntimeList removeMember(RuntimeArray args, int ctx) { String targetName; if (RuntimeScalarType.isReference(memberArg)) { RuntimeHash member = memberArg.hashDeref(); - RuntimeScalar name = member.get("_name"); + RuntimeScalar name = getMemberNameScalar(member); targetName = name != null ? name.toString() : ""; } else { targetName = memberArg.toString(); @@ -941,7 +954,7 @@ public static RuntimeList removeMember(RuntimeArray args, int ctx) { for (int i = 0; i < members.size(); i++) { RuntimeHash member = members.get(i).hashDeref(); - RuntimeScalar name = member.get("_name"); + RuntimeScalar name = getMemberNameScalar(member); if (name != null && name.toString().equals(targetName)) { RuntimeScalar removed = members.get(i); // Remove from array @@ -969,7 +982,7 @@ public static RuntimeList fileName(RuntimeArray args, int ctx) { return scalarUndef.getList(); } RuntimeHash member = args.get(0).hashDeref(); - RuntimeScalar name = member.get("_name"); + RuntimeScalar name = getMemberNameScalar(member); return name != null ? name.getList() : scalarUndef.getList(); } @@ -1179,9 +1192,25 @@ private static RuntimeArray getMembers(RuntimeHash self) { return membersRef.arrayDeref(); } + private static void putMemberName(RuntimeHash member, String name) { + RuntimeScalar nameScalar = new RuntimeScalar(name); + member.put(MEMBER_NAME_KEY, nameScalar); + // CPAN Archive::Zip exposes this hash key and callers such as + // Archive::Extract read it directly instead of calling fileName(). + member.put(MEMBER_COMPAT_FILENAME_KEY, nameScalar); + } + + private static RuntimeScalar getMemberNameScalar(RuntimeHash member) { + RuntimeScalar name = member.get(MEMBER_NAME_KEY); + if (name == null || name.type == RuntimeScalarType.UNDEF) { + name = member.get(MEMBER_COMPAT_FILENAME_KEY); + } + return name; + } + private static RuntimeHash createMemberFromEntry(ZipFile zipFile, ZipEntry entry, Long rawDosTimestamp) throws IOException { RuntimeHash member = new RuntimeHash(); - member.put("_name", new RuntimeScalar(entry.getName())); + putMemberName(member, entry.getName()); member.put("_externalFileName", new RuntimeScalar("")); member.put("_isDirectory", entry.isDirectory() ? scalarTrue : scalarFalse); member.put("_uncompressedSize", new RuntimeScalar(entry.getSize())); @@ -1234,7 +1263,7 @@ private static RuntimeHash createMemberFromEntry(ZipFile zipFile, ZipEntry entry } private static void writeMemberToZip(ZipOutputStream zos, RuntimeHash member) throws IOException { - RuntimeScalar name = member.get("_name"); + RuntimeScalar name = getMemberNameScalar(member); if (name == null) return; ZipEntry entry = new ZipEntry(name.toString()); diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Version.java b/src/main/java/org/perlonjava/runtime/perlmodule/Version.java index 7fca2ef00..4737e0ddd 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Version.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Version.java @@ -173,12 +173,6 @@ else if (versionStr.type == VSTRING) { // Perl 5 treats these as v-strings with is_qv=true isVString = true; version = "v" + version; - } else if (dotCount == 1 && version.length() < 4) { - // If exactly one dot and short, prepend "v" for internal processing - // but keep the original for stringify() and qv flag - version = "v" + version; - // Note: originalVersionStr stays as the user's input (e.g., "1.0") - // Note: isVString remains false - this is a decimal version } } @@ -192,7 +186,7 @@ else if (versionStr.type == VSTRING) { versionObj.put("qv", getScalarBoolean(isVString)); // Parse components - String normalized = VersionHelper.normalizeVersion(new RuntimeScalar(version)); + String normalized = normalizeDottedVersion(version); versionObj.put("version", new RuntimeScalar(normalized)); } else { // Decimal format @@ -216,6 +210,18 @@ else if (versionStr.type == VSTRING) { return blessed.getList(); } + private static String normalizeDottedVersion(String version) { + String normalized = version.startsWith("v") ? version.substring(1) : version; + normalized = normalized.replace("_", ""); + String[] parts = normalized.split("\\."); + StringBuilder dotted = new StringBuilder(); + for (int i = 0; i < parts.length; i++) { + if (i > 0) dotted.append("."); + dotted.append(Integer.parseInt(parts[i])); + } + return dotted.toString(); + } + /** * Creates a dotted-decimal version object. * This is a method that expects to be called as version->declare() @@ -263,6 +269,11 @@ public static RuntimeList numify(RuntimeArray args, int ctx) { RuntimeHash versionObj = self.hashDeref(); String version = versionObj.get("version").toString(); + if (!versionObj.get("qv").getBoolean()) { + String original = versionObj.get("original").toString().replace("_", ""); + return new RuntimeScalar(numifyDecimalVersion(original)).getList(); + } + String[] parts = version.split("\\."); if (parts.length == 0) { @@ -285,6 +296,32 @@ public static RuntimeList numify(RuntimeArray args, int ctx) { return new RuntimeScalar(numified.toString()).getList(); } + private static String numifyDecimalVersion(String version) { + String clean = version.trim(); + if (clean.startsWith("v")) { + clean = clean.substring(1); + } + int dot = clean.indexOf('.'); + if (dot < 0) { + return clean + ".000"; + } + + String major = clean.substring(0, dot); + String decimal = clean.substring(dot + 1); + if (major.isEmpty()) { + major = "0"; + } + if (decimal.isEmpty()) { + decimal = "0"; + } + int width = ((decimal.length() + 2) / 3) * 3; + StringBuilder padded = new StringBuilder(decimal); + while (padded.length() < width) { + padded.append("0"); + } + return major + "." + padded; + } + /** * Returns the normalized dotted-decimal form with leading v. */ diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java index 3d9ef2e39..4082ca486 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java @@ -746,6 +746,11 @@ public void releaseCaptures() { // Sub::Defer/Moo's %DEFERRED and %QUOTED weak ref tables. // The JVM GC handles truly-dead unblessed containers eventually. if (s.scopeExited) { + if (s.type == RuntimeScalarType.TIED_SCALAR + && s.value instanceof TiedVariableBase tiedVariable) { + tiedVariable.releaseTiedObject(); + continue; + } if ((s.type & RuntimeScalarType.REFERENCE_BIT) != 0 && s.value instanceof RuntimeBase rb && rb.blessId != 0) { diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java index 93c6483bc..b76f818df 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java @@ -2712,7 +2712,8 @@ public static void scopeExitCleanup(RuntimeScalar scalar) { // - captureCount=0 → capture handling branch not taken // - ioOwner=false → IO fd recycling branch not taken if (!scalar.refCountOwned && scalar.captureCount == 0 && !scalar.ioOwner - && !scalar.ownsScalarReferenceContents) { + && !scalar.ownsScalarReferenceContents + && scalar.type != RuntimeScalarType.TIED_SCALAR) { // Special case: CODE refs with unreleased captures that were never // stored via set() (e.g., anonymous subs passed directly as arguments). // These have refCount=0 (from makeCodeObject) and refCountOwned=false @@ -2812,6 +2813,12 @@ public static void scopeExitCleanup(RuntimeScalar scalar) { // Captures are properly released when the CODE ref is overwritten // (via setLarge) or undef'd (via undefine). + if (scalar.type == RuntimeScalarType.TIED_SCALAR + && scalar.value instanceof TiedVariableBase tiedVariable) { + tiedVariable.releaseTiedObject(); + return; + } + // Existing: IO fd recycling for anonymous filehandle globs if (scalar.ioOwner && scalar.type == GLOBREFERENCE && scalar.value instanceof RuntimeGlob glob diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/TiedVariableBase.java b/src/main/java/org/perlonjava/runtime/runtimetypes/TiedVariableBase.java index 561b8c176..539079f48 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/TiedVariableBase.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/TiedVariableBase.java @@ -25,6 +25,8 @@ public abstract class TiedVariableBase extends RuntimeBaseProxy { */ protected final String tiedPackage; + private boolean tiedObjectReleased = false; + /** * Creates a new TiedVariableBase instance. * @@ -207,6 +209,8 @@ public String getTiedPackage() { * Called by untie() after UNTIE has been dispatched. */ public void releaseTiedObject() { + if (tiedObjectReleased) return; + tiedObjectReleased = true; if ((self.type & RuntimeScalarType.REFERENCE_BIT) != 0 && self.value instanceof RuntimeBase base) { if (base.refCount > 0 && --base.refCount == 0) { @@ -216,4 +220,3 @@ public void releaseTiedObject() { } } } - diff --git a/src/main/perl/lib/ExtUtils/MakeMaker.pm b/src/main/perl/lib/ExtUtils/MakeMaker.pm index 8b19d3c8f..ee79cb494 100644 --- a/src/main/perl/lib/ExtUtils/MakeMaker.pm +++ b/src/main/perl/lib/ExtUtils/MakeMaker.pm @@ -282,6 +282,7 @@ sub _install_pure_perl { # Some modules like Image::ExifTool use .pl files loaded via require, # .dat files for data (e.g., Geolocation.dat), and Mozilla::CA uses .pem my $installable_re = qr/\.(?:pm|pl|pod|dat|json|ya?ml|xml|txt|cfg|conf|ini|pem)$/i; + my %pm_rel_seen; if (-d 'lib') { find({ wanted => sub { @@ -289,19 +290,24 @@ sub _install_pure_perl { my $src = $File::Find::name; (my $rel = $src) =~ s{^lib/}{}; $pm{$src} = File::Spec->catfile($INSTALL_BASE, $rel); + $pm_rel_seen{$rel} = 1; }, no_chdir => 1, }, 'lib'); } - # Also check for blib/lib (after a build) + # Also check for blib/lib (after a build). Prefer real sources + # under lib/ when both exist; rerunning Makefile.PL after a build + # must not turn blib/lib files into self-copying pm_to_blib sources. if (-d 'blib/lib') { find({ wanted => sub { return unless -f && /$installable_re/; my $src = $File::Find::name; (my $rel = $src) =~ s{^blib/lib/}{}; + return if $pm_rel_seen{$rel}; $pm{$src} = File::Spec->catfile($INSTALL_BASE, $rel); + $pm_rel_seen{$rel} = 1; }, no_chdir => 1, }, 'blib/lib'); @@ -670,7 +676,7 @@ sub _create_install_makefile { # Flat layout: compute from dest path relative to INSTALL_BASE ($blib_rel = $dest) =~ s{^\Q$INSTALL_BASE\E/?}{}; } - if ($blib_rel) { + if ($blib_rel && $src !~ m{^blib/lib/}) { my $blib_dest = "\$(INST_LIB)/$blib_rel"; my $blib_dir = dirname($blib_dest); unless ($blib_dirs_seen{$blib_dir}++) { @@ -716,7 +722,7 @@ sub _create_install_makefile { my $blib_script_cmds_str = join("\n", @blib_script_cmds) || "\t\@true"; my $file_count = scalar(keys %$pm) + scalar(keys %$scripts); - my $pm_deps_str = join(' ', sort keys %$pm); + my $pm_deps_str = join(' ', sort grep { $_ !~ m{^blib/lib/} } keys %$pm); $pm_deps_str = " $pm_deps_str" if length $pm_deps_str; # Make pm_to_blib target conditional - if no .pm files, make it a no-op diff --git a/src/test/resources/unit/archive_zip_members_matching_qr.t b/src/test/resources/unit/archive_zip_members_matching_qr.t index 920193668..fba457183 100644 --- a/src/test/resources/unit/archive_zip_members_matching_qr.t +++ b/src/test/resources/unit/archive_zip_members_matching_qr.t @@ -1,10 +1,15 @@ #!/usr/bin/perl use strict; use warnings; -use Test::More tests => 8; +use Test::More tests => 13; +use File::Path qw(rmtree); use Archive::Zip; +my $tmp = "archive_zip_compat_$$"; +END { rmtree($tmp) if -d $tmp; } +mkdir $tmp or die "mkdir $tmp: $!"; + my $zip = Archive::Zip->new(); $zip->addString('{}', 'Fruit-Role-Fermentable-1.0/META.json'); $zip->addString('package Fruit::Role::Fermentable;', 'Fruit-Role-Fermentable-1.0/lib/Fruit/Role/Fermentable.pm'); @@ -26,3 +31,14 @@ is($modules[0]->fileName, 'Fruit-Role-Fermentable-1.0/lib/Fruit/Role/Fermentable my @plain = $zip->membersMatching('README'); is($plain[0]->fileName, 'README', 'membersMatching still accepts string patterns'); + +my $zip_path = "$tmp/read.zip"; +is($zip->writeToFileNamed($zip_path), 0, 'wrote zip fixture'); + +my $read = Archive::Zip->new(); +is($read->read($zip_path), 0, 'read zip fixture'); + +my ($read_meta) = $read->membersMatching(qr/META\.json\z/); +is($read_meta->{fileName}, 'Fruit-Role-Fermentable-1.0/META.json', 'member hash exposes fileName compatibility field'); +is($read->extractMember($read_meta, "$tmp/meta.json"), 0, 'extractMember accepts member object'); +ok(-e "$tmp/meta.json", 'member object extraction wrote file'); diff --git a/src/test/resources/unit/makemaker_stale_blib_source.t b/src/test/resources/unit/makemaker_stale_blib_source.t new file mode 100644 index 000000000..9e791bccf --- /dev/null +++ b/src/test/resources/unit/makemaker_stale_blib_source.t @@ -0,0 +1,55 @@ +use strict; +use warnings; +use Test::More; +use Cwd qw(getcwd); +use File::Path qw(make_path); +use File::Temp qw(tempdir); + +my $orig_dir = getcwd(); +my $tmpdir = tempdir(CLEANUP => 1); + +END { + chdir $orig_dir if defined $orig_dir; +} + +chdir $tmpdir or die "chdir $tmpdir: $!"; +make_path('lib/Foo', 'blib/lib/Foo') or die "make_path test dirs: $!"; + +open my $src_pm, '>', 'lib/Foo/Bar.pm' + or die "create source module: $!"; +print {$src_pm} "package Foo::Bar;\nour \$VERSION = '0.001';\n1;\n"; +close $src_pm or die "close source module: $!"; + +open my $staged_pm, '>', 'blib/lib/Foo/Bar.pm' + or die "create stale staged module: $!"; +print {$staged_pm} "package Foo::Bar;\nour \$VERSION = '0.001';\n1;\n"; +close $staged_pm or die "close staged module: $!"; + +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Foo::Bar', + VERSION => '0.001', +); + +open my $mf, '<', 'Makefile' or die "open generated Makefile: $!"; +my $makefile = do { local $/; <$mf> }; +close $mf or die "close generated Makefile: $!"; + +like( + $makefile, + qr/^pm_to_blib:: lib\/Foo\/Bar\.pm$/m, + 'pm_to_blib depends on the real lib source', +); +unlike( + $makefile, + qr/^pm_to_blib::.*blib\/lib\/Foo\/Bar\.pm/m, + 'pm_to_blib does not depend on stale blib source files', +); +unlike( + $makefile, + qr/cp 'blib\/lib\/Foo\/Bar\.pm' '\$\(INST_LIB\)\/Foo\/Bar\.pm'/, + 'generated pm_to_blib does not copy a staged blib file onto itself', +); + +done_testing(); diff --git a/src/test/resources/unit/subroutine.t b/src/test/resources/unit/subroutine.t index abb7ee007..127634708 100644 --- a/src/test/resources/unit/subroutine.t +++ b/src/test/resources/unit/subroutine.t @@ -89,6 +89,25 @@ is($result, "", "direct call reusing @_"); $result = $sub_ref->(101); is($result, "<101>", "indirect call with sub_ref->()"); +sub returns_coderef { sub { return "<@_>" } } +$result = returns_coderef->(202); +is($result, "<202>", "bareword subroutine before ->() returns a callable coderef under strict"); + +sub returns_path_coderef { sub { return "/tmp" } } +ok(-e returns_path_coderef->("ignored"), "file tests bind outside bareword coderef arrow calls"); +ok(defined((stat returns_path_coderef->("ignored"))[9]), "stat binds outside bareword coderef arrow calls"); + +my $missing_coderef_error = do { + local $@; + eval 'use strict; missing_coderef_for_arrow->(); 1'; + $@; +}; +like( + $missing_coderef_error, + qr/Undefined subroutine .*missing_coderef_for_arrow/, + "missing bareword before ->() is a runtime subroutine error, not strict-subs" +); + @_ = ("another", "test"); $result = &$sub_ref; is($result, "", "indirect call reusing @_"); diff --git a/src/test/resources/unit/tie_scalar.t b/src/test/resources/unit/tie_scalar.t index aeb4be3ea..64091b2e4 100644 --- a/src/test/resources/unit/tie_scalar.t +++ b/src/test/resources/unit/tie_scalar.t @@ -341,6 +341,46 @@ subtest 'DESTROY called on untie' => sub { } }; +subtest 'DESTROY called when tied lexical scalar leaves scope' => sub { + @TrackedTiedScalar::method_calls = (); + + { + tie my $scalar, 'TrackedTiedScalar'; + $scalar = "scoped"; + @TrackedTiedScalar::method_calls = (); + } + + is_deeply( + \@TrackedTiedScalar::method_calls, + [['DESTROY']], + 'tied object destroyed when lexical tied scalar leaves scope' + ); +}; + +subtest 'tied lexical DESTROY deferred while tie object is referenced' => sub { + @TrackedTiedScalar::method_calls = (); + + my $object; + { + $object = tie my $scalar, 'TrackedTiedScalar'; + $scalar = "scoped"; + @TrackedTiedScalar::method_calls = (); + } + + is_deeply( + \@TrackedTiedScalar::method_calls, + [], + 'external tie object reference defers DESTROY at lexical scope exit' + ); + + undef $object; + is_deeply( + \@TrackedTiedScalar::method_calls, + [['DESTROY']], + 'DESTROY fires after the external tie object reference is dropped' + ); +}; + subtest 'UNTIE called before DESTROY' => sub { # Test that UNTIE is called before DESTROY @TrackedTiedScalar::method_calls = (); # Clear method calls @@ -362,4 +402,3 @@ subtest 'UNTIE called before DESTROY' => sub { }; done_testing(); - diff --git a/src/test/resources/unit/version_numify.t b/src/test/resources/unit/version_numify.t new file mode 100644 index 000000000..a3577f24c --- /dev/null +++ b/src/test/resources/unit/version_numify.t @@ -0,0 +1,18 @@ +use strict; +use warnings; +use Test::More; +use version; + +is(version->parse('v1.5')->numify, '1.005000', 'dotted v-version numifies with component padding'); +is(version->parse('v1.5')->normal, 'v1.5.0', 'dotted v-version normal form preserves component value'); + +is(version->parse('1.5')->numify, '1.500', 'decimal version numifies with decimal padding'); +is(version->parse('1.5')->normal, 'v1.500.0', 'decimal version normal form groups decimal digits'); + +is(version->parse('1.2345')->numify, '1.234500', 'long decimal version numifies to grouped width'); +is(version->parse('1.2345')->normal, 'v1.234.500', 'long decimal version normal form pads patch group'); + +is(version->parse('v1.2.3')->numify, '1.002003', 'three-part v-version numifies as dotted components'); +is(version->parse('1.2.3')->numify, '1.002003', 'three-part dotted version without v is qv-style'); + +done_testing();