diff --git a/docs/about/changelog.md b/docs/about/changelog.md index f7d3298da..b25da30fd 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -8,6 +8,9 @@ priorities and future plans. - Preserve UTF-8 HTML octets through HTML::Parser and no-op entity decoding, restoring complete Thai text in HTML::Formatter output. + +- Return `undef` from false `if` expressions without an `else`, preserving + omitted optional arguments for `Params::Validate` and DateTime formatters. - Preserve caller-owned array and hash lifetimes across generated coercion callbacks, so `Types::Const` freezes cloned values without modifying the original reference. diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java index 0c1b4b302..c3ce53ec9 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java @@ -7350,7 +7350,9 @@ public void visit(IfNode node) { if (node.elseBranch != null) { node.elseBranch.accept(this); } else { - lastResultReg = -1; + // Perl returns the evaluated condition when an if without + // an else does not take its branch. + compileNode(node.condition, -1, RuntimeContextType.SCALAR); } } return; @@ -7417,11 +7419,21 @@ public void visit(IfNode node) { lastResultReg = thenResultReg >= 0 ? thenResultReg : elseResultReg; } else { - // No else block - patch if-false jump to here (after then block) - int endPos = bytecode.size(); - patchIntOffset(ifFalsePos + 2, endPos); + // Perl returns the evaluated condition when an if without an else + // does not take its branch. Materialize it in the conditional's + // result register so a skipped then branch cannot expose stale data. + int resultReg = thenResultReg >= 0 ? thenResultReg : allocateOutputRegister(); + int gotoEndPos = bytecode.size(); + emit(Opcodes.GOTO); + emitInt(0); - lastResultReg = thenResultReg; + int falseStart = bytecode.size(); + patchIntOffset(ifFalsePos + 2, falseStart); + emitAliasWithTarget(resultReg, condReg); + + int endPos = bytecode.size(); + patchIntOffset(gotoEndPos + 1, endPos); + lastResultReg = resultReg; } symbolTable.exitScope(ifScopeIndex); } diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitStatement.java b/src/main/java/org/perlonjava/backend/jvm/EmitStatement.java index 5fda88ef7..246a271d1 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitStatement.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitStatement.java @@ -464,8 +464,8 @@ public static void emitIf(EmitterVisitor emitterVisitor, IfNode node) { emitterVisitor.ctx.javaClassInfo.popGotoLabels(); } } else { - // No else branch - emit condition value if not void context - // Perl returns the condition value when no branch is taken + // No else branch - Perl returns the condition value when + // no branch is taken. if (emitterVisitor.ctx.contextType != RuntimeContextType.VOID) { node.condition.accept(emitterVisitor.with(RuntimeContextType.SCALAR)); } @@ -489,7 +489,7 @@ public static void emitIf(EmitterVisitor emitterVisitor, IfNode node) { Label endLabel = new Label(); // When there's no else branch and we need a result value, DUP the condition - // so the condition value is returned when no branch is taken (Perl semantics) + // so the condition value is returned when no branch is taken (Perl semantics). boolean needConditionValue = (node.elseBranch == null && emitterVisitor.ctx.contextType != RuntimeContextType.VOID); // An elsif is an else-branch AST child rather than an EmitBlock statement, diff --git a/src/test/resources/unit/params_validate_optional_argument.t b/src/test/resources/unit/params_validate_optional_argument.t new file mode 100644 index 000000000..c1c3766d1 --- /dev/null +++ b/src/test/resources/unit/params_validate_optional_argument.t @@ -0,0 +1,57 @@ +use strict; +use warnings; +use Test::More; + +sub validate_named_arguments { + my %input = @_; + my %specification = ( + required => { optional => 0 }, + optional => { optional => 1 }, + ); + my %arguments; + + OUTER: for my $name (qw(required optional)) { + my $value = do { + if (exists $specification{$name}{default}) { + $specification{$name}{default}; + } + } || do { + next OUTER if $specification{$name}{optional} && !exists $input{$name}; + $input{$name}; + }; + + $arguments{$name} = $value; + } + + return exists $arguments{optional} ? 'explicit-undef' : 'omitted'; +} + +sub false_if_result { + if ($_[0]) { 'taken' } +} + +is( + false_if_result(0), + 0, + 'an untaken if without else returns its false condition value', +); + +is( + false_if_result(1), + 'taken', + 'a taken if without else returns its branch value', +); + +is( + validate_named_arguments(required => 'value'), + 'omitted', + 'omitted optional named arguments are not materialized as undef', +); + +is( + validate_named_arguments(required => 'value', optional => undef), + 'explicit-undef', + 'explicit undef remains distinguishable from an omitted argument', +); + +done_testing;