From 516c0b17f0f00b213710d84757f74080456ce6c8 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Wed, 28 Oct 2026 16:24:08 +0100 Subject: [PATCH 1/4] fix: address CPAN issues 1342, 1376, 1427, and 1428 Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex --- docs/about/changelog.md | 1 + .../backend/bytecode/BytecodeCompiler.java | 5 +- .../frontend/parser/SubroutineParser.java | 37 ++++++++++++- .../runtime/operators/MathOperators.java | 11 +++- .../runtime/runtimetypes/GlobalVariable.java | 12 +++++ ...ssue_1342_overloaded_relational_dispatch.t | 53 +++++++++++++++++++ ..._1376_constant_hashref_deref_after_undef.t | 26 +++++++++ .../unit/issue_1427_dynamic_catch_syntax.t | 21 ++++++++ .../unit/issue_1428_integer_stringification.t | 18 +++++++ 9 files changed, 180 insertions(+), 4 deletions(-) create mode 100644 src/test/resources/unit/issue_1342_overloaded_relational_dispatch.t create mode 100644 src/test/resources/unit/issue_1376_constant_hashref_deref_after_undef.t create mode 100644 src/test/resources/unit/issue_1427_dynamic_catch_syntax.t create mode 100644 src/test/resources/unit/issue_1428_integer_stringification.t diff --git a/docs/about/changelog.md b/docs/about/changelog.md index a5ebb30201..6f8614074b 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,6 +6,7 @@ priorities and future plans. ## Work in progress +- Preserve hash-reference constant calls after typeglob undefinition, parse Error.pm's dynamic `catch $class with { ... }` form on both backends, and retain integer scalar identity through `int()` for decimal stringification; 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. diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java index 7d9b7c7892..fe555c7d81 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java +++ b/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; diff --git a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java index 2057935cf4..a6d0ca7363 100644 --- a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java @@ -213,6 +213,7 @@ static Node parseSubroutineCall(Parser parser, boolean isMethod) { String prototype = null; List 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); } diff --git a/src/main/java/org/perlonjava/runtime/operators/MathOperators.java b/src/main/java/org/perlonjava/runtime/operators/MathOperators.java index cb11232a1e..4a04200e49 100644 --- a/src/main/java/org/perlonjava/runtime/operators/MathOperators.java +++ b/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); } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java index 7edd678928..a7566dd347 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java +++ b/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; diff --git a/src/test/resources/unit/issue_1342_overloaded_relational_dispatch.t b/src/test/resources/unit/issue_1342_overloaded_relational_dispatch.t new file mode 100644 index 0000000000..8f781d4541 --- /dev/null +++ b/src/test/resources/unit/issue_1342_overloaded_relational_dispatch.t @@ -0,0 +1,53 @@ +use strict; +use warnings; +use Test::More; + +{ + package Local::PartialOrderKey; + + use overload + 'eq' => sub { + my ($left, $right) = map { ref $_ ? $_ : __PACKAGE__->new($_) } @_; + $$left eq $$right; + }, + 'lt' => sub { + my ($left, $right) = map { ref $_ ? $_ : __PACKAGE__->new($_) } @_; + my ($a, $b) = ("$left", "$right"); + length($a) < length($b) && substr($b, 0, length($a) + 1) eq "$a/"; + }, + 'le' => sub { + my ($left, $right) = map { ref $_ ? $_ : __PACKAGE__->new($_) } @_; + $left lt $right || $left eq $right; + }, + 'gt' => sub { $_[1] lt $_[0] }, + 'ge' => sub { + my ($left, $right) = map { ref $_ ? $_ : __PACKAGE__->new($_) } @_; + $right lt $left || $left eq $right; + }, + '""' => sub { ${$_[0]} }; + + sub new { + my ($class, $key) = @_; + $key =~ s{/+}{/}g; + $key =~ s{^/*}{/}; + $key =~ s{/+$}{}; + return bless \$key, $class; + } +} + +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; diff --git a/src/test/resources/unit/issue_1376_constant_hashref_deref_after_undef.t b/src/test/resources/unit/issue_1376_constant_hashref_deref_after_undef.t new file mode 100644 index 0000000000..29c5146e71 --- /dev/null +++ b/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; diff --git a/src/test/resources/unit/issue_1427_dynamic_catch_syntax.t b/src/test/resources/unit/issue_1427_dynamic_catch_syntax.t new file mode 100644 index 0000000000..daaa0267ee --- /dev/null +++ b/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; diff --git a/src/test/resources/unit/issue_1428_integer_stringification.t b/src/test/resources/unit/issue_1428_integer_stringification.t new file mode 100644 index 0000000000..e6b5451c64 --- /dev/null +++ b/src/test/resources/unit/issue_1428_integer_stringification.t @@ -0,0 +1,18 @@ +use strict; +use warnings; +use Test::More; + +my $microseconds = 1051470597; +$microseconds *= 1e6; +$microseconds += int(0.8 * 1e6); + +is("$microseconds", '1051470597800000', + 'large integral arithmetic with int() stringifies as decimal'); + +like("" . (1.5 * 1_000_000_000_000_000), qr/[eE+]/, + 'large fractional NV values retain scientific notation'); + +like("" . 1e20, qr/[eE+]/, + 'large floating literals retain scientific notation'); + +done_testing; From d40427aa640489e9d267ffbbf4c0011ce8a9a716 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Wed, 28 Oct 2026 17:32:48 +0100 Subject: [PATCH 2/4] test: match Morpheus overload dispatch Mirror the upstream upgrade helper and in-place argument replacement in the issue 1342 regression test. Generated with OpenAI Codex (https://openai.com/codex/) Co-Authored-By: OpenAI Codex --- ...ssue_1342_overloaded_relational_dispatch.t | 28 +++++++++++++------ 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/src/test/resources/unit/issue_1342_overloaded_relational_dispatch.t b/src/test/resources/unit/issue_1342_overloaded_relational_dispatch.t index 8f781d4541..4ca1d46b0c 100644 --- a/src/test/resources/unit/issue_1342_overloaded_relational_dispatch.t +++ b/src/test/resources/unit/issue_1342_overloaded_relational_dispatch.t @@ -7,25 +7,31 @@ use Test::More; use overload 'eq' => sub { - my ($left, $right) = map { ref $_ ? $_ : __PACKAGE__->new($_) } @_; + @_ = upgrade(@_); + my ($left, $right) = @_; $$left eq $$right; }, - 'lt' => sub { - my ($left, $right) = map { ref $_ ? $_ : __PACKAGE__->new($_) } @_; - my ($a, $b) = ("$left", "$right"); - length($a) < length($b) && substr($b, 0, length($a) + 1) eq "$a/"; - }, + 'lt' => \&less, 'le' => sub { - my ($left, $right) = map { ref $_ ? $_ : __PACKAGE__->new($_) } @_; + @_ = upgrade(@_); + my ($left, $right) = @_; $left lt $right || $left eq $right; }, - 'gt' => sub { $_[1] lt $_[0] }, + 'gt' => sub { @_ = upgrade(@_); $_[1] lt $_[0] }, 'ge' => sub { - my ($left, $right) = map { ref $_ ? $_ : __PACKAGE__->new($_) } @_; + @_ = 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; @@ -33,6 +39,10 @@ use Test::More; $key =~ s{/+$}{}; return bless \$key, $class; } + + sub upgrade { + map { ref $_ ? $_ : __PACKAGE__->new($_) } @_; + } } sub compare_dynamically { From b32108c2f7742e44b6cb3965277dc52f3eec81ea Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Wed, 28 Oct 2026 17:43:32 +0000 Subject: [PATCH 3/4] fix: preserve regex referent type through scalar refs Avoid blessing the caller's regex when a scalar-reference wrapper is blessed and dereferenced. Add a focused regression matching the assertion wrapper used by Test::Unit, and align the Morpheus overload fixture with its in-place argument upgrade. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex --- docs/about/changelog.md | 2 +- .../runtime/operators/ReferenceOperators.java | 23 ------------ .../runtime/runtimetypes/RuntimeScalar.java | 25 ++----------- ...ssue_1342_overloaded_relational_dispatch.t | 4 +-- ...ue_1427_regex_scalar_ref_bless_isolation.t | 35 +++++++++++++++++++ 5 files changed, 40 insertions(+), 49 deletions(-) create mode 100644 src/test/resources/unit/issue_1427_regex_scalar_ref_bless_isolation.t diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 6f8614074b..e71f67b594 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,7 +6,7 @@ priorities and future plans. ## Work in progress -- Preserve hash-reference constant calls after typeglob undefinition, parse Error.pm's dynamic `catch $class with { ... }` form on both backends, and retain integer scalar identity through `int()` for decimal stringification; cover Morpheus relational overload dispatch and caller filename normalization (#1342, #1376, #1427, #1428). +- Preserve hash-reference constant calls after typeglob undefinition, 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. diff --git a/src/main/java/org/perlonjava/runtime/operators/ReferenceOperators.java b/src/main/java/org/perlonjava/runtime/operators/ReferenceOperators.java index 6c9cf65989..259354130a 100644 --- a/src/main/java/org/perlonjava/runtime/operators/ReferenceOperators.java +++ b/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. diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java index de8f972ad8..45ddad5236 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java @@ -4180,20 +4180,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 +4295,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 -> { diff --git a/src/test/resources/unit/issue_1342_overloaded_relational_dispatch.t b/src/test/resources/unit/issue_1342_overloaded_relational_dispatch.t index 4ca1d46b0c..76a2a63547 100644 --- a/src/test/resources/unit/issue_1342_overloaded_relational_dispatch.t +++ b/src/test/resources/unit/issue_1342_overloaded_relational_dispatch.t @@ -28,8 +28,8 @@ use Test::More; sub less ($$) { @_ = upgrade(@_); my ($left, $right) = @_; - my ($a, $b) = ("$left", "$right"); - length($a) < length($b) && substr($b, 0, length($a) + 1) eq "$a/"; + my ($a, $b) = ("$left", "$right"); + length($a) < length($b) && substr($b, 0, length($a) + 1) eq "$a/"; } sub new { diff --git a/src/test/resources/unit/issue_1427_regex_scalar_ref_bless_isolation.t b/src/test/resources/unit/issue_1427_regex_scalar_ref_bless_isolation.t new file mode 100644 index 0000000000..67db5c269d --- /dev/null +++ b/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; From 011baa261f52b1e223c605a548b417ba216ad508 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Wed, 28 Oct 2026 18:12:16 +0000 Subject: [PATCH 4/4] fix: handle glob-backed hashes in Morpheus traversal Hash dereference now accepts a RuntimeHash payload carried by a GLOB scalar. This is the representation Morpheus configuration traversal reaches while adjusting values held in stash globs. Add focused runtime coverage and include the traversal behavior in the changelog. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex --- docs/about/changelog.md | 2 +- .../runtime/runtimetypes/RuntimeScalar.java | 11 +++++++++- .../RuntimeScalarGlobHashDerefTest.java | 22 +++++++++++++++++++ 3 files changed, 33 insertions(+), 2 deletions(-) create mode 100644 src/test/java/org/perlonjava/runtime/runtimetypes/RuntimeScalarGlobHashDerefTest.java diff --git a/docs/about/changelog.md b/docs/about/changelog.md index e71f67b594..5f4e5230e3 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,7 +6,7 @@ priorities and future plans. ## Work in progress -- Preserve hash-reference constant calls after typeglob undefinition, 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). +- 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. diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java index 45ddad5236..b2eabcdf5b 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java +++ b/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(); } diff --git a/src/test/java/org/perlonjava/runtime/runtimetypes/RuntimeScalarGlobHashDerefTest.java b/src/test/java/org/perlonjava/runtime/runtimetypes/RuntimeScalarGlobHashDerefTest.java new file mode 100644 index 0000000000..5476eefef0 --- /dev/null +++ b/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()); + } +}