diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 2a6e9ee11..80bb9d91e 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,6 +6,9 @@ priorities and future plans. ## Work in progress +- Avoid allocating discarded old-value scalars for postfix increment and + decrement in JVM-compiled void context. + - Restore `local` compatibility for tied hash and array elements, sparse arrays, magic stashes, implicit `$_` foreach aliases (including early return), and localized regex captures on both execution backends. diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitOperatorNode.java b/src/main/java/org/perlonjava/backend/jvm/EmitOperatorNode.java index 40a8e6eba..d827dc22e 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitOperatorNode.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitOperatorNode.java @@ -9,6 +9,7 @@ import org.perlonjava.frontend.astnode.OperatorNode; import org.perlonjava.runtime.perlmodule.Strict; import org.perlonjava.runtime.runtimetypes.PerlCompilerException; +import org.perlonjava.runtime.runtimetypes.RuntimeContextType; /** * Handles the bytecode emission for Perl operator nodes during compilation. @@ -121,8 +122,15 @@ public static void emitOperatorNode(EmitterVisitor emitterVisitor, OperatorNode // Auto-increment/decrement operators case "++" -> EmitOperator.handleUnaryDefaultCase(node, "preAutoIncrement", emitterVisitor); case "--" -> EmitOperator.handleUnaryDefaultCase(node, "preAutoDecrement", emitterVisitor); - case "++postfix" -> EmitOperator.handleUnaryDefaultCase(node, "postAutoIncrement", emitterVisitor); - case "--postfix" -> EmitOperator.handleUnaryDefaultCase(node, "postAutoDecrement", emitterVisitor); + // In void context no caller can observe postfix's old-value result. + // Use the equivalent prefix mutator so ordinary discarded postfix + // operations do not allocate a temporary scalar just to POP it. + case "++postfix" -> EmitOperator.handleUnaryDefaultCase(node, + emitterVisitor.ctx.contextType == RuntimeContextType.VOID + ? "preAutoIncrement" : "postAutoIncrement", emitterVisitor); + case "--postfix" -> EmitOperator.handleUnaryDefaultCase(node, + emitterVisitor.ctx.contextType == RuntimeContextType.VOID + ? "preAutoDecrement" : "postAutoDecrement", emitterVisitor); // Special case for length under "use bytes" case "length" -> EmitOperator.handleLengthOperator(node, emitterVisitor); diff --git a/src/test/resources/unit/void_postfix_increment.t b/src/test/resources/unit/void_postfix_increment.t new file mode 100644 index 000000000..943df0e4c --- /dev/null +++ b/src/test/resources/unit/void_postfix_increment.t @@ -0,0 +1,47 @@ +use strict; +use warnings; +use Test::More tests => 10; + +my $integer = 4; +$integer++; +is($integer, 5, 'void postfix increment mutates an integer'); + +my $string = 'az'; +$string++; +is($string, 'ba', 'void postfix increment retains string increment semantics'); + +my $undef; +$undef++; +is($undef, 1, 'void postfix increment coerces undef to one'); + +my $decrement = 4; +$decrement--; +is($decrement, 3, 'void postfix decrement mutates an integer'); + +{ + package VoidPostfixTie; + sub TIESCALAR { bless { value => $_[1], fetches => 0, stores => 0 }, $_[0] } + sub FETCH { $_[0]{fetches}++; return $_[0]{value} } + sub STORE { $_[0]{stores}++; $_[0]{value} = $_[1] } +} + +my $tied = tie my $tied_value, 'VoidPostfixTie', 7; +$tied_value++; +is($tied->{value}, 8, 'void postfix increment stores through a tied scalar'); +is($tied->{fetches}, 1, 'void postfix increment fetches a tied scalar once'); +is($tied->{stores}, 1, 'void postfix increment stores a tied scalar once'); + +{ + package VoidPostfixOverload; + use overload '++' => sub { $_[0]{count}++; return $_[0] }, fallback => 1; +} + +my $object = bless { count => 0 }, 'VoidPostfixOverload'; +$object++; +is($object->{count}, 1, 'void postfix increment dispatches overload'); + +is(ref($object), 'VoidPostfixOverload', 'void postfix increment preserves overloaded object identity'); + +my $postfix_value = 9; +my $old = $postfix_value++; +is($old, 9, 'value context retains the original postfix result');