diff --git a/README.md b/README.md index ad1256a..8e3d237 100644 --- a/README.md +++ b/README.md @@ -54,6 +54,20 @@ assert($x > 0, "x must be positive"); # => x must be positive ``` +The message expression is lazily evaluated. It is only evaluated when the assertion fails. +This is equivalent to: + +``` +$cond || do { die $msg } +``` + +This means you can use expensive computations or side effects in the message without worrying about performance when the assertion passes: + +``` +assert($x > 0, expensive_debug_info()); +# expensive_debug_info() is NOT called if $x > 0 +``` + # SEE ALSO - [PerlX::Assert](https://metacpan.org/pod/PerlX%3A%3AAssert) diff --git a/lib/Syntax/Keyword/Assert.pm b/lib/Syntax/Keyword/Assert.pm index e298313..cdb427b 100644 --- a/lib/Syntax/Keyword/Assert.pm +++ b/lib/Syntax/Keyword/Assert.pm @@ -87,6 +87,16 @@ You can provide a custom error message as the second argument: assert($x > 0, "x must be positive"); # => x must be positive +The message expression is lazily evaluated. It is only evaluated when the assertion fails. +This is equivalent to: + + $cond || do { die $msg } + +This means you can use expensive computations or side effects in the message without worrying about performance when the assertion passes: + + assert($x > 0, expensive_debug_info()); + # expensive_debug_info() is NOT called if $x > 0 + =head1 SEE ALSO =over 4 diff --git a/lib/Syntax/Keyword/Assert.xs b/lib/Syntax/Keyword/Assert.xs index 6ec8890..97e513b 100644 --- a/lib/Syntax/Keyword/Assert.xs +++ b/lib/Syntax/Keyword/Assert.xs @@ -59,16 +59,12 @@ static OP *pp_assert(pTHX) croak_sv(msg); } -static XOP xop_assert_msg; -static OP *pp_assert_msg(pTHX) +/* Called after msgop is evaluated to croak with the message */ +static XOP xop_assert_croak; +static OP *pp_assert_croak(pTHX) { dSP; SV *custom_msg = POPs; - SV *val = POPs; - - if(SvTRUE(val)) - RETURN; - croak_sv(custom_msg); } @@ -187,9 +183,16 @@ static int build_assert(pTHX_ OP **out, XSParseKeywordPiece *args[], size_t narg if (assert_enabled) { if (msgop) { - // With custom message: use pp_assert_msg - // condop evaluates to true/false, msgop is the error message - *out = newBINOP_CUSTOM(&pp_assert_msg, 0, condop, msgop); + // With custom message: lazy evaluation using OP_OR + // assert(cond, msg) becomes: cond || do { croak(msg) } + // + // OP_OR: if condop is true, short-circuit; if false, evaluate other + // We use op_scope to isolate the other branch's op_next chain + + OP *croakop = newUNOP_CUSTOM(&pp_assert_croak, 0, msgop); + OP *scopedblock = op_scope(croakop); + + *out = newLOGOP(OP_OR, 0, condop, scopedblock); } else { // Without custom message: check if binary operator for better error @@ -248,10 +251,10 @@ BOOT: XopENTRY_set(&xop_assertbin, xop_class, OA_BINOP); Perl_custom_op_register(aTHX_ &pp_assertbin, &xop_assertbin); - XopENTRY_set(&xop_assert_msg, xop_name, "assert_msg"); - XopENTRY_set(&xop_assert_msg, xop_desc, "assert with message"); - XopENTRY_set(&xop_assert_msg, xop_class, OA_BINOP); - Perl_custom_op_register(aTHX_ &pp_assert_msg, &xop_assert_msg); + XopENTRY_set(&xop_assert_croak, xop_name, "assert_croak"); + XopENTRY_set(&xop_assert_croak, xop_desc, "assert croak with message"); + XopENTRY_set(&xop_assert_croak, xop_class, OA_UNOP); + Perl_custom_op_register(aTHX_ &pp_assert_croak, &xop_assert_croak); register_xs_parse_keyword("assert", &hooks_assert, NULL); diff --git a/t/01_assert/custom_message.t b/t/01_assert/custom_message.t index f58538b..b1914c3 100644 --- a/t/01_assert/custom_message.t +++ b/t/01_assert/custom_message.t @@ -60,6 +60,53 @@ subtest 'custom message with string comparison' => sub { ok lives { assert("a" lt "b", "This should not appear") }; }; +subtest 'lazy evaluation of custom message' => sub { + subtest 'message not evaluated when condition is true' => sub { + my $evaluated = 0; + my $get_msg = sub { $evaluated++; return "should not see this" }; + + ok lives { assert(1, $get_msg->()) }; + is $evaluated, 0, "message expression is NOT evaluated when condition is true"; + }; + + subtest 'message evaluated when condition is false' => sub { + my $evaluated = 0; + my $get_msg = sub { $evaluated++; return "assertion failed!" }; + + like dies { assert(0, $get_msg->()) }, + qr/assertion failed!/; + is $evaluated, 1, "message expression is evaluated when condition is false"; + }; + + subtest 'expensive computation skipped when true' => sub { + my @log; + my $expensive = sub { push @log, "computed"; return "error msg" }; + + ok lives { assert("truthy value", $expensive->()) }; + is scalar(@log), 0, "expensive computation skipped when condition is true"; + }; + + subtest 'side effects only on false' => sub { + my $side_effect_count = 0; + my $msg_with_side_effect = sub { + $side_effect_count++; + return "Side effect triggered $side_effect_count times"; + }; + + # Multiple true assertions - side effects should NOT happen + ok lives { assert(1, $msg_with_side_effect->()) }; + ok lives { assert("yes", $msg_with_side_effect->()) }; + ok lives { assert(100, $msg_with_side_effect->()) }; + + is $side_effect_count, 0, "no side effects when all conditions are true"; + + # Now a false assertion - side effect SHOULD happen + like dies { assert(0, $msg_with_side_effect->()) }, + qr/Side effect triggered/; + is $side_effect_count, 1, "side effect happened on false assertion"; + }; +}; + subtest 'custom message with variables' => sub { subtest 'basic' => sub { my $x = 0;