Fix CPAN issues 1342, 1376, 1427, and 1428

docs/about/changelog.md

@@ -6,6 +6,7 @@ priorities and future plans.
 
 ## Work in progress
 
+- Preserve hash-reference constant calls after typeglob undefinition, dereference glob-backed hash values during Morpheus configuration traversal, parse Error.pm's dynamic `catch $class with { ... }` form on both backends, and retain integer scalar identity through `int()` for decimal stringification; preserve regex referent types through blessed scalar references and cover Morpheus relational overload dispatch and caller filename normalization (#1342, #1376, #1427, #1428).
 - Implement `Time::HiRes::stat` with high-resolution file timestamps (#1912).
 
 - Export `fieldhash` from `Hash::Util` for compatibility with core Perl.

src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java

@@ -6360,7 +6360,10 @@ void compileVariableReference(OperatorNode node, String op) {
                 if (node.getBooleanAnnotation("directNamedCall")) {
                     int rd = allocateOutputRegister();
                     int nameIdx = addToStringPool(subName);
-                    int cacheIdx = addToConstantPool(new RuntimeScalar());
+                    RuntimeScalar cachedCallRef = node.getBooleanAnnotation("preserveHashConstantCall")
+                            && node.getAnnotation("parseTimeCodeRef") instanceof RuntimeScalar codeRef
+                                    ? codeRef : new RuntimeScalar();
+                    int cacheIdx = addToConstantPool(cachedCallRef);
                     Object classMethod = node.getAnnotation("directClassMethod");
                     int classNameIdx = classMethod instanceof String className
                             ? addToStringPool(className) : -1;

src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java

@@ -213,6 +213,7 @@ static Node parseSubroutineCall(Parser parser, boolean isMethod) {
         String prototype = null;
         List<String> attributes = null;
         RuntimeScalar parseTimeCodeRef = null;
+        boolean preserveHashConstantCall = false;
         String prototypeErrorName = fullName;
         if (!isNewMethod && !isMethod) {
             RuntimeScalar codeRef = null;
@@ -521,7 +522,12 @@ && isValidIndirectMethod(sourceSubName, parser)
         // Handle indirect object syntax with variable class: new $type $arg -> $type->new($arg)
         // This is similar to the IDENTIFIER case above, but for variable class names
         // Only applies when the subroutine doesn't exist (otherwise it's a function call)
-        if (!subExists && peek(parser).text.equals("$") && isValidIndirectMethod(subName) && !prototypeHasGlob) {
+        // The legacy Error.pm form `catch $class with { ... }` remains an
+        // indirect method call even when the core `try` feature is enabled;
+        // the core catch grammar requires a parenthesized exception variable.
+        boolean dynamicCatchClass = subName.equals("catch");
+        if ((!subExists || dynamicCatchClass) && peek(parser).text.equals("$")
+                && (dynamicCatchClass || isValidIndirectMethod(subName)) && !prototypeHasGlob) {
             int currentIndex2 = parser.tokenIndex;
             // Parse the variable that holds the class name
             // Set flag so Variable.parseVariable allows ( after the variable
@@ -881,6 +887,19 @@ && isValidIndirectMethod(sourceSubName, parser)
             }
             if (parseTimeCodeRef != null) {
                 Object target = parseTimeCodeRef.value;
+                if (target instanceof RuntimeCode constantCode
+                        && isHashReferenceConstant(constantCode)
+                        && parser.ctx.symbolTable.getCurrentSubroutine() != null
+                        && !parser.ctx.symbolTable.getCurrentSubroutine().isEmpty()) {
+                    // A named body may be emitted only when first called,
+                    // after runtime has executed `undef *CONSTANT`. Keep the
+                    // constant CV captured by this body independent from the
+                    // mutable CODE slot so hash-reference constants retain
+                    // their compile-time value on both backends.
+                    parseTimeCodeRef = new RuntimeScalar(constantCode.cloneForClosure());
+                    target = parseTimeCodeRef.value;
+                    preserveHashConstantCall = true;
+                }
                 boolean knownAtParseTime = target instanceof RuntimeCode runtimeCode
                         && (runtimeCode.defined() || runtimeCode.isDeclared);
                 codeRefNode.setAnnotation("subroutineKnownAtParseTime", knownAtParseTime);
@@ -903,6 +922,9 @@ && isValidIndirectMethod(sourceSubName, parser)
                     codeRefNode.setAnnotation("directLvalueCall", true);
                 }
             }
+            if (preserveHashConstantCall) {
+                codeRefNode.setAnnotation("preserveHashConstantCall", true);
+            }
             BinaryOperatorNode call = new BinaryOperatorNode("(",
                     codeRefNode,
                     arguments,
@@ -929,6 +951,19 @@ private static void throwNumberAfterBarewordDiagnostic(Parser parser, String sub
                         + subName + "\"?)" + at + "syntax error" + at);
     }
 
+    private static boolean isHashReferenceConstant(RuntimeCode code) {
+        if (code.constantValue == null || code.constantValue.elements.size() != 1
+                || !(code.constantValue.elements.getFirst() instanceof RuntimeScalar value)) {
+            return false;
+        }
+        while (value.type == RuntimeScalarType.READONLY_SCALAR
+                && value.value instanceof RuntimeScalar inner) {
+            value = inner;
+        }
+        return value.type == RuntimeScalarType.HASHREFERENCE
+                && value.value instanceof RuntimeHash;
+    }
+
     private static boolean isValidIndirectMethod(String subName) {
         return isValidIndirectMethod(subName, null);
     }

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

@@ -1829,8 +1829,15 @@ private static RuntimeScalar integerUnpropagated(RuntimeScalar arg1) {
             return new RuntimeScalar(value);  // Return infinity or NaN as-is
         }
 
-        // Use truncate to get integer part (truncates towards zero)
-        return new RuntimeScalar(truncate(value));
+        // Use truncate to get integer part (truncates towards zero). Perl's
+        // int() produces an IV when the result fits, even when the input was
+        // an NV. Keeping that integer flag matters for later arithmetic and
+        // stringification (for example, epoch microseconds).
+        double truncated = truncate(value);
+        if (truncated >= -0x1.0p63 && truncated < 0x1.0p63) {
+            return getScalarInt((long) truncated);
+        }
+        return new RuntimeScalar(truncated);
     }
 
 

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

@@ -131,16 +131,6 @@ private static RuntimeScalar bless(RuntimeScalar runtimeScalar, RuntimeScalar cl
             if (referent instanceof RuntimeRegex regex) {
                 regex.setBlessId(newBlessId);
             }
-            // qr// values can reach bless as a reference whose referent is a
-            // scalar wrapper around the actual RuntimeRegex.  Keep the regex
-            // payload's class in sync so its mutable scalar view stringifies
-            // as the blessed object after $$qr assignment.
-            if (referent instanceof RuntimeScalar scalar
-                    && scalar.type == REGEX
-                    && scalar.value instanceof RuntimeRegex regex) {
-                regex.setBlessId(newBlessId);
-            }
-            propagateNestedRegexBlessing(runtimeScalar, newBlessId);
             // Blessing into a package materializes its stash in Perl.  Method
             // lookup uses stash existence to decide whether to show the
             // "perhaps you forgot to load" hint.
@@ -286,19 +276,6 @@ private static RuntimeScalar bless(RuntimeScalar runtimeScalar, RuntimeScalar cl
         return runtimeScalar;
     }
 
-    private static void propagateNestedRegexBlessing(RuntimeScalar scalar, int blessId) {
-        RuntimeScalar current = scalar;
-        for (int depth = 0; depth < 8; depth++) {
-            if (current.type == REGEX && current.value instanceof RuntimeRegex regex) {
-                current.setBlessId(blessId);
-                regex.setBlessId(blessId);
-                return;
-            }
-            if (current.type != REFERENCE || !(current.value instanceof RuntimeScalar next)) return;
-            current = next;
-        }
-    }
-
     /**
      * Returns the type of a reference or its blessed package name.
      * Implements Perl's ref() built-in function.

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

@@ -2531,6 +2531,18 @@ public static RuntimeScalar getGlobalCodeRefForDirectCall(String key, RuntimeSca
         if (current == null && !resolvedKey.equals(key)) {
             current = globalCodeRefs.get(key);
         }
+        // Hash-reference constants used by a compiled body retain their CV
+        // after `undef *NAME`; the cached value is an independent constant-CV
+        // snapshot, while the visible glob slot becomes undef. Ordinary direct
+        // calls continue to prefer the currently visible CODE slot below.
+        if (cached != null && cached.type == RuntimeScalarType.CODE
+                && cached.value instanceof RuntimeCode cachedCode
+                && cachedCode.constantValue != null
+                && (current == null || current.type != RuntimeScalarType.CODE
+                    || !(current.value instanceof RuntimeCode currentCode)
+                    || currentCode.constantValue == null)) {
+            return cached;
+        }
         if (current != null) {
             cached.type = current.type;
             cached.value = current.value;

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

@@ -4126,7 +4126,16 @@ public RuntimeHash hashDeref() {
                 if (value instanceof RuntimeIO) {
                     throw new PerlCompilerException("Not a HASH reference");
                 }
-                RuntimeGlob glob = (RuntimeGlob) value;
+                // A glob's scalar slot can itself carry the hash payload while
+                // Perl code traverses a glob reference with ${*{$glob}}{key}.
+                // In that representation the value is already the hash; it is
+                // not a RuntimeGlob wrapper.
+                if (value instanceof RuntimeHash hash) {
+                    yield hash;
+                }
+                if (!(value instanceof RuntimeGlob glob)) {
+                    throw new PerlCompilerException("Not a HASH reference");
+                }
                 // For anonymous globs, use the getGlobHash method which handles local slots
                 yield glob.getGlobHash();
             }
@@ -4180,20 +4189,7 @@ public RuntimeScalar scalarDeref() {
                 yield newScalar;
             }
             case REFERENCE -> {
-                RuntimeScalar referent = (RuntimeScalar) value;
-                // A blessed qr// is represented as a reference to a REGEX
-                // scalar. Dereferencing it must expose the mutable PV view,
-                // retaining the blessing that lives on the reference cell.
-                if (referent.type == REGEX && referent.value instanceof RuntimeRegex regex) {
-                    int regexBlessId = referent.blessId != 0 ? referent.blessId
-                            : this.blessId != 0 ? this.blessId
-                            : blessedId(this) != 0 ? blessedId(this) : regex.blessId;
-                    if (regexBlessId != 0) {
-                        regex.setBlessId(regexBlessId);
-                        yield new RegexScalarLvalue(regex, regexBlessId).propagateTaint(referent);
-                    }
-                }
-                yield referent;
+                yield (RuntimeScalar) value;
             }
             case REGEX -> dereferencedRegexScalar();
             case GLOB -> {
@@ -4308,15 +4304,7 @@ public RuntimeScalar scalarDerefNonStrict(String packageName) {
 
         return switch (type) {
             case REFERENCE -> {
-                RuntimeScalar referent = (RuntimeScalar) value;
-                if (referent.type == REGEX && referent.value instanceof RuntimeRegex regex) {
-                    int regexBlessId = referent.blessId != 0 ? referent.blessId
-                            : this.blessId != 0 ? this.blessId
-                            : blessedId(this) != 0 ? blessedId(this) : regex.blessId;
-                    if (regexBlessId != 0) regex.setBlessId(regexBlessId);
-                    yield new RegexScalarLvalue(regex, regexBlessId).propagateTaint(referent);
-                }
-                yield referent;
+                yield (RuntimeScalar) value;
             }
             case REGEX -> dereferencedRegexScalar();
             case GLOB -> {

src/test/java/org/perlonjava/runtime/runtimetypes/RuntimeScalarGlobHashDerefTest.java

@@ -0,0 +1,22 @@
+package org.perlonjava.runtime.runtimetypes;
+
+import org.junit.jupiter.api.Tag;
+import org.junit.jupiter.api.Test;
+
+import static org.junit.jupiter.api.Assertions.assertSame;
+
+class RuntimeScalarGlobHashDerefTest {
+
+    @Tag("unit")
+    @Test
+    void hashDereferenceAcceptsHashPayloadStoredOnGlobScalar() {
+        RuntimeHash hash = new RuntimeHash();
+        hash.put("1", new RuntimeScalar("value"));
+
+        RuntimeScalar globScalar = new RuntimeScalar();
+        globScalar.type = RuntimeScalarType.GLOB;
+        globScalar.value = hash;
+
+        assertSame(hash, globScalar.hashDeref());
+    }
+}

src/test/resources/unit/issue_1342_overloaded_relational_dispatch.t

@@ -0,0 +1,63 @@
+use strict;
+use warnings;
+use Test::More;
+
+{
+    package Local::PartialOrderKey;
+
+    use overload
+        'eq' => sub {
+            @_ = upgrade(@_);
+            my ($left, $right) = @_;
+            $$left eq $$right;
+        },
+        'lt' => \&less,
+        'le' => sub {
+            @_ = upgrade(@_);
+            my ($left, $right) = @_;
+            $left lt $right || $left eq $right;
+        },
+        'gt' => sub { @_ = upgrade(@_); $_[1] lt $_[0] },
+        'ge' => sub {
+            @_ = upgrade(@_);
+            my ($left, $right) = @_;
+            $right lt $left || $left eq $right;
+        },
+        '""' => sub { ${$_[0]} };
+
+    sub less ($$) {
+        @_ = upgrade(@_);
+        my ($left, $right) = @_;
+        my ($a, $b) = ("$left", "$right");
+        length($a) < length($b) && substr($b, 0, length($a) + 1) eq "$a/";
+    }
+
+    sub new {
+        my ($class, $key) = @_;
+        $key =~ s{/+}{/}g;
+        $key =~ s{^/*}{/};
+        $key =~ s{/+$}{};
+        return bless \$key, $class;
+    }
+
+    sub upgrade {
+        map { ref $_ ? $_ : __PACKAGE__->new($_) } @_;
+    }
+}
+
+sub compare_dynamically {
+    my ($left, $right) = @_;
+    return $left le $right;
+}
+
+my $parent = Local::PartialOrderKey->new('/foo');
+my $child = Local::PartialOrderKey->new('/foo/bar');
+my $sibling = Local::PartialOrderKey->new('/other');
+
+ok(compare_dynamically($parent, $child),
+    'relational overloads dispatch through dynamically typed subroutine arguments');
+ok(compare_dynamically($parent, '/foo'),
+    'relational overloads upgrade a string operand inside an overload method');
+ok(!($parent eq $sibling), 'key equality remains independent of ordering');
+
+done_testing;

src/test/resources/unit/issue_1376_constant_hashref_deref_after_undef.t

@@ -0,0 +1,26 @@
+use strict;
+use warnings;
+use Test::More;
+
+{
+    package Local::HashReferenceConstant;
+
+    use constant TABLE => {
+        answer => [42],
+    };
+
+    sub values_for {
+        my ($key) = @_;
+        return exists TABLE->{$key} ? @{ TABLE->{$key} } : ();
+    }
+}
+
+# Perl compiles the constant dereferences into values before runtime removes
+# the visible typeglob.  A lazily compiled body must retain that same value.
+undef *Local::HashReferenceConstant::TABLE;
+
+my @values = Local::HashReferenceConstant::values_for('answer');
+is(scalar @values, 1, 'hash-reference constant remains available after its typeglob is undefined');
+is($values[0], 42, 'constant hash dereference returns the original array value');
+
+done_testing;

src/test/resources/unit/issue_1427_dynamic_catch_syntax.t

@@ -0,0 +1,21 @@
+use strict;
+use warnings;
+use Test::More;
+
+{
+    package Local::DynamicCatch;
+
+    sub catch {
+        my ($class, $handler) = @_;
+        return $class . ':' . $handler->();
+    }
+}
+
+sub with (&;$) { return $_[0] }
+
+my $exception_class = 'Local::DynamicCatch';
+my $caught = catch $exception_class with { 'handler ran' };
+is($caught, 'Local::DynamicCatch:handler ran',
+    'dynamic class name dispatches catch with its with block');
+
+done_testing;

src/test/resources/unit/issue_1427_regex_scalar_ref_bless_isolation.t

@@ -0,0 +1,35 @@
+use strict;
+use warnings;
+use Test::More;
+
+{
+    package Local::RegexScalarHolder;
+
+    use overload '""' => sub { 'regex assertion' };
+
+    sub new {
+        my $class = shift;
+        my $regex = shift;
+        return bless \$regex, $class;
+    }
+
+    sub do_assertion {
+        my $self = shift;
+        my $target = shift;
+        return $target =~ $$self;
+    }
+}
+
+my $arguments = ['fixed', qr/x/];
+my $holder = Local::RegexScalarHolder->new($arguments->[1]);
+
+is(ref($holder), 'Local::RegexScalarHolder',
+    'blessing a reference to a copied regex scalar blesses the scalar reference');
+ok($holder->do_assertion($arguments->[0]),
+    'a scalar reference to the regex can still perform a match');
+is(ref($arguments->[1]), 'Regexp',
+    'dereferencing the assertion does not bless the caller regex');
+like('fixed', $arguments->[1],
+    'the caller regex remains usable after blessing the scalar copy');
+
+done_testing;