From 21daa8414161597cb7bb9cf925471c78433ba3fe Mon Sep 17 00:00:00 2001 From: kobaken Date: Fri, 20 Dec 2024 21:24:29 +0900 Subject: [PATCH 1/4] Added parser setting --- lib/Syntax/Keyword/Assert.xs | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/lib/Syntax/Keyword/Assert.xs b/lib/Syntax/Keyword/Assert.xs index 805ebac..6be9e9e 100644 --- a/lib/Syntax/Keyword/Assert.xs +++ b/lib/Syntax/Keyword/Assert.xs @@ -213,9 +213,9 @@ ok: RETURN; } -static int build_assert(pTHX_ OP **out, XSParseKeywordPiece *arg0, void *hookdata) +static int build_assert(pTHX_ OP **out, XSParseKeywordPiece *args[], size_t nargs, void *hookdata) { - OP *argop = arg0->op; + OP *argop = args[0]->op; if (assert_enabled) { enum BinopType binoptype = classify_binop(argop->op_type); if (binoptype) { @@ -239,8 +239,15 @@ static int build_assert(pTHX_ OP **out, XSParseKeywordPiece *arg0, void *hookdat static const struct XSParseKeywordHooks hooks_assert = { .permit_hintkey = "Syntax::Keyword::Assert/assert", - .piece1 = XPK_TERMEXPR_SCALARCTX, - .build1 = &build_assert, + .pieces = (const struct XSParseKeywordPieceType[]) { + XPK_ARGS( + XPK_TERMEXPR_SCALARCTX, + XPK_OPTIONAL(XPK_COMMA), + XPK_TERMEXPR_SCALARCTX_OPT + ), + {0} + }, + .build = &build_assert, }; MODULE = Syntax::Keyword::Assert PACKAGE = Syntax::Keyword::Assert From 03f8b2447fa87afb23a1b8e3bb34f80fb3808cfd Mon Sep 17 00:00:00 2001 From: kobaken Date: Mon, 8 Dec 2025 20:50:27 +0900 Subject: [PATCH 2/4] Fixed warning: !$x == 100 --- t/01_assert/number_comparison.t | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/t/01_assert/number_comparison.t b/t/01_assert/number_comparison.t index 57a4ebf..4d141b6 100644 --- a/t/01_assert/number_comparison.t +++ b/t/01_assert/number_comparison.t @@ -12,8 +12,10 @@ subtest 'NUM_EQ' => sub { is dies { assert($x + $y == 100) }, expected_assert_bin(3, '==', 100); is dies { assert($x == 100) }, expected_assert_bin(1, '==', 100); - is dies { assert(!!$x == 100) }, expected_assert_bin('true', '==', 100); - is dies { assert(!$x == 100) }, expected_assert_bin('false', '==', 100); + my $true = !!1; + my $false = !1; + is dies { assert($true == 100) }, expected_assert_bin('true', '==', 100); + is dies { assert($false == 100) }, expected_assert_bin('false', '==', 100); my $message = 'hello'; my $undef = undef; From f296e05dde4eb321f2e59b5d7c7320b6a0a9264e Mon Sep 17 00:00:00 2001 From: kobaken Date: Mon, 8 Dec 2025 20:54:22 +0900 Subject: [PATCH 3/4] Test: no paren --- t/01_assert.t | 2 ++ 1 file changed, 2 insertions(+) diff --git a/t/01_assert.t b/t/01_assert.t index 478f8a0..ca725e1 100644 --- a/t/01_assert.t +++ b/t/01_assert.t @@ -7,9 +7,11 @@ use TestUtil; subtest 'Test `assert` keyword' => sub { ok lives { assert(1) }; + ok lives { assert 1 }; ok lives { assert("hello") }; like dies { assert(undef) }, expected_assert('undef'); like dies { assert(0) }, expected_assert('0'); + like dies { assert 0 }, expected_assert('0'); like dies { assert('0') }, expected_assert('"0"'); like dies { assert('') }, expected_assert('""'); like dies { assert(!!0) }, expected_assert('false'); From 7d78f10e832ba9675384a24d5f0d0d5aafa0a090 Mon Sep 17 00:00:00 2001 From: kobaken Date: Mon, 8 Dec 2025 22:14:18 +0900 Subject: [PATCH 4/4] Add custom error message support for assert MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Allow users to provide a custom error message as the second argument: assert($x > 0, "x must be positive"); When the assertion fails, the custom message is displayed instead of the auto-generated one. This is useful when the default message (e.g., "Assertion failed (0 > 0)") is not descriptive enough. 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude --- hax/newBINOP_CUSTOM.c.inc | 25 +++++ lib/Syntax/Keyword/Assert.xs | 210 +++++++++++++++++------------------ t/01_assert/custom_message.t | 126 +++++++++++++++++++++ 3 files changed, 250 insertions(+), 111 deletions(-) create mode 100644 hax/newBINOP_CUSTOM.c.inc create mode 100644 t/01_assert/custom_message.t diff --git a/hax/newBINOP_CUSTOM.c.inc b/hax/newBINOP_CUSTOM.c.inc new file mode 100644 index 0000000..9c56657 --- /dev/null +++ b/hax/newBINOP_CUSTOM.c.inc @@ -0,0 +1,25 @@ +/* Before perl 5.22 under -DDEBUGGING, various new*OP() functions throw assert + * failures on OP_CUSTOM. + * https://rt.cpan.org/Ticket/Display.html?id=128562 + * + * Based on: https://metacpan.org/release/PEVANS/Syntax-Keyword-Try-0.31/source/hax/newOP_CUSTOM.c.inc + */ + +#define newBINOP_CUSTOM(func, flags, first, last) S_newBINOP_CUSTOM(aTHX_ func, flags, first, last) +static OP *S_newBINOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first, OP *last) +{ + BINOP *binop; +#if HAVE_PERL_VERSION(5,22,0) + binop = (BINOP *)newBINOP(OP_CUSTOM, flags, first, last); +#else + NewOp(1101, binop, 1, BINOP); + binop->op_type = (OPCODE)OP_CUSTOM; + binop->op_first = first; + first->op_sibling = last; + binop->op_last = last; + binop->op_flags = (U8)(flags | OPf_KIDS); + binop->op_private = (U8)(2 | (flags >> 8)); +#endif + binop->op_ppaddr = func; + return (OP *)binop; +} diff --git a/lib/Syntax/Keyword/Assert.xs b/lib/Syntax/Keyword/Assert.xs index 6be9e9e..5484a25 100644 --- a/lib/Syntax/Keyword/Assert.xs +++ b/lib/Syntax/Keyword/Assert.xs @@ -9,6 +9,7 @@ (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S)))))) #include "newUNOP_CUSTOM.c.inc" +#include "newBINOP_CUSTOM.c.inc" #include "sv_numeq.c.inc" #include "sv_numcmp.c.inc" #include "sv_streq.c.inc" @@ -58,6 +59,19 @@ static OP *pp_assert(pTHX) croak_sv(msg); } +static XOP xop_assert_msg; +static OP *pp_assert_msg(pTHX) +{ + dSP; + SV *custom_msg = POPs; + SV *val = POPs; + + if(SvTRUE(val)) + RETURN; + + croak_sv(custom_msg); +} + enum BinopType { BINOP_NONE, BINOP_NUM_EQ, @@ -95,6 +109,49 @@ static enum BinopType classify_binop(int type) return BINOP_NONE; } +/* Check if binary assertion passes. Returns true if assertion succeeds. */ +static bool S_assertbin_check(pTHX_ enum BinopType binoptype, SV *lhs, SV *rhs) +{ + switch(binoptype) { + case BINOP_NUM_EQ: return sv_numeq(lhs, rhs); + case BINOP_NUM_NE: return !sv_numeq(lhs, rhs); + case BINOP_NUM_LT: return sv_numcmp(lhs, rhs) == -1; + case BINOP_NUM_GT: return sv_numcmp(lhs, rhs) == 1; + case BINOP_NUM_LE: return sv_numcmp(lhs, rhs) != 1; + case BINOP_NUM_GE: return sv_numcmp(lhs, rhs) != -1; + case BINOP_STR_EQ: return sv_streq(lhs, rhs); + case BINOP_STR_NE: return !sv_streq(lhs, rhs); + case BINOP_STR_LT: return sv_cmp(lhs, rhs) == -1; + case BINOP_STR_GT: return sv_cmp(lhs, rhs) == 1; + case BINOP_STR_LE: return sv_cmp(lhs, rhs) != 1; + case BINOP_STR_GE: return sv_cmp(lhs, rhs) != -1; + case BINOP_ISA: return sv_isa_sv(lhs, rhs); + default: return FALSE; /* unreachable */ + } +} +#define assertbin_check(binoptype, lhs, rhs) S_assertbin_check(aTHX_ binoptype, lhs, rhs) + +/* Get operator string for error message */ +static const char *binop_to_str(enum BinopType binoptype) +{ + switch(binoptype) { + case BINOP_NUM_EQ: return "=="; + case BINOP_NUM_NE: return "!="; + case BINOP_NUM_LT: return "<"; + case BINOP_NUM_GT: return ">"; + case BINOP_NUM_LE: return "<="; + case BINOP_NUM_GE: return ">="; + case BINOP_STR_EQ: return "eq"; + case BINOP_STR_NE: return "ne"; + case BINOP_STR_LT: return "lt"; + case BINOP_STR_GT: return "gt"; + case BINOP_STR_LE: return "le"; + case BINOP_STR_GE: return "ge"; + case BINOP_ISA: return "isa"; + default: return "??"; /* unreachable */ + } +} + static XOP xop_assertbin; static OP *pp_assertbin(pTHX) { @@ -103,134 +160,60 @@ static OP *pp_assertbin(pTHX) SV *lhs = POPs; enum BinopType binoptype = PL_op->op_private; - const char *op_str; - - switch(binoptype) { - case BINOP_NUM_EQ: - if(sv_numeq(lhs, rhs)) - goto ok; - - op_str = "=="; - break; - - case BINOP_NUM_NE: - if(!sv_numeq(lhs, rhs)) - goto ok; - - op_str = "!="; - break; - - case BINOP_NUM_LT: - if(sv_numcmp(lhs, rhs) == -1) - goto ok; - - op_str = "<"; - break; - - case BINOP_NUM_GT: - if(sv_numcmp(lhs, rhs) == 1) - goto ok; - - op_str = ">"; - break; - - case BINOP_NUM_LE: - if(sv_numcmp(lhs, rhs) != 1) - goto ok; - - op_str = "<="; - break; - - case BINOP_NUM_GE: - if(sv_numcmp(lhs, rhs) != -1) - goto ok; - - op_str = ">="; - break; - - case BINOP_STR_EQ: - if(sv_streq(lhs, rhs)) - goto ok; - - op_str = "eq"; - break; - - case BINOP_STR_NE: - if(!sv_streq(lhs, rhs)) - goto ok; - - op_str = "ne"; - break; - - case BINOP_STR_LT: - if(sv_cmp(lhs, rhs) == -1) - goto ok; - - op_str = "lt"; - break; - - case BINOP_STR_GT: - if(sv_cmp(lhs, rhs) == 1) - goto ok; - - op_str = "gt"; - break; - - case BINOP_STR_LE: - if(sv_cmp(lhs, rhs) != 1) - goto ok; - - op_str = "le"; - break; - - case BINOP_STR_GE: - if(sv_cmp(lhs, rhs) != -1) - goto ok; - - op_str = "ge"; - break; - - case BINOP_ISA: - if(sv_isa_sv(lhs, rhs)) - goto ok; - - op_str = "isa"; - break; - - default: - croak("ARGH unreachable"); - } + if(assertbin_check(binoptype, lhs, rhs)) + RETURN; SV *msg = sv_2mortal(newSVpvs("Assertion failed (")); - sv_catsv_unqq(msg, lhs); - sv_catpvf(msg, " %s ", op_str); + sv_catpvf(msg, " %s ", binop_to_str(binoptype)); sv_catsv_unqq(msg, rhs); sv_catpvs(msg, ")"); croak_sv(msg); - -ok: - RETURN; } + static int build_assert(pTHX_ OP **out, XSParseKeywordPiece *args[], size_t nargs, void *hookdata) { - OP *argop = args[0]->op; + // assert(EXPR, EXPR) + // + // assert($x == 1) + // assert($x == 1, "x is not 1"); + // + // first EXPR is the condition, second is the message. + // error message is optional. + // if the condition is false, the message is printed and the program dies. + OP *condop = args[0]->op; + OP *msgop = args[2] ? args[2]->op : NULL; + if (assert_enabled) { - enum BinopType binoptype = classify_binop(argop->op_type); - if (binoptype) { - argop->op_type = OP_CUSTOM; - argop->op_ppaddr = &pp_assertbin; - argop->op_private = binoptype; - *out = argop; + 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); } else { - *out = newUNOP_CUSTOM(&pp_assert, 0, argop); + // Without custom message: check if binary operator for better error + enum BinopType binoptype = classify_binop(condop->op_type); + if (binoptype) { + // Binary operator: use pp_assertbin for detailed error message + condop->op_type = OP_CUSTOM; + condop->op_ppaddr = &pp_assertbin; + condop->op_private = binoptype; + + *out = condop; + } + else { + // Other expressions: use pp_assert + *out = newUNOP_CUSTOM(&pp_assert, 0, condop); + } } } else { // do nothing. - op_free(argop); + op_free(condop); + if (msgop) { + op_free(msgop); + } *out = newOP(OP_NULL, 0); } @@ -265,6 +248,11 @@ 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); + register_xs_parse_keyword("assert", &hooks_assert, NULL); { diff --git a/t/01_assert/custom_message.t b/t/01_assert/custom_message.t new file mode 100644 index 0000000..f58538b --- /dev/null +++ b/t/01_assert/custom_message.t @@ -0,0 +1,126 @@ +use Test2::V0; +use Syntax::Keyword::Assert; + +use lib 't/lib'; +use TestUtil; + +subtest 'basic custom message' => sub { + like dies { assert(0, "Something went wrong") }, + qr/Something went wrong/; + like dies { assert(undef, "Value is undef") }, + qr/Value is undef/; + like dies { assert('', "Empty string") }, + qr/Empty string/; + like dies { assert('0', "String zero") }, + qr/String zero/; +}; + +subtest 'success cases with custom message' => sub { + ok lives { assert(1, "This should not appear") }; + ok lives { assert("hello", "This should not appear") }; + ok lives { assert(100, "This should not appear") }; +}; + +subtest 'custom message with numeric comparison' => sub { + like dies { assert(1 == 0, "1 should equal 0") }, + qr/1 should equal 0/; + like dies { assert(5 != 5, "5 should not equal 5") }, + qr/5 should not equal 5/; + like dies { assert(5 < 3, "5 should be less than 3") }, + qr/5 should be less than 3/; + like dies { assert(2 > 10, "2 should be greater than 10") }, + qr/2 should be greater than 10/; + like dies { assert(10 <= 5, "10 should be <= 5") }, + qr/10 should be <= 5/; + like dies { assert(3 >= 10, "3 should be >= 10") }, + qr/3 should be >= 10/; + + # success cases + ok lives { assert(1 == 1, "This should not appear") }; + ok lives { assert(5 > 3, "This should not appear") }; + ok lives { assert(3 < 5, "This should not appear") }; +}; + +subtest 'custom message with string comparison' => sub { + like dies { assert("foo" eq "bar", "strings should match") }, + qr/strings should match/; + like dies { assert("same" ne "same", "strings should differ") }, + qr/strings should differ/; + like dies { assert("z" lt "a", "z should be lt a") }, + qr/z should be lt a/; + like dies { assert("a" gt "z", "a should be gt z") }, + qr/a should be gt z/; + like dies { assert("z" le "a", "z should be le a") }, + qr/z should be le a/; + like dies { assert("a" ge "z", "a should be ge z") }, + qr/a should be ge z/; + + # success cases + ok lives { assert("foo" eq "foo", "This should not appear") }; + ok lives { assert("a" lt "b", "This should not appear") }; +}; + +subtest 'custom message with variables' => sub { + subtest 'basic' => sub { + my $x = 0; + my $msg = "Variable x is falsy"; + like dies { assert($x, $msg) }, + qr/Variable x is falsy/; + + my $y = undef; + like dies { assert($y, "Value is undef") }, + qr/Value is undef/; + + my $empty = ''; + like dies { assert($empty, "Empty string") }, + qr/Empty string/; + + # success + my $z = 1; + ok lives { assert($z, "This should not appear") }; + }; + + subtest 'numeric comparison' => sub { + my $a = 10; + my $b = 20; + like dies { assert($a == $b, "values should be equal(a:$a, b:$b)") }, + qr/values should be equal\(a:10, b:20\)/; + + my $x = 5; + my $y = 5; + like dies { assert($x != $y, "$x should not equal $y") }, + qr/5 should not equal 5/; + + like dies { assert($x < 3, "$x should be less than 3") }, + qr/5 should be less than 3/; + + like dies { assert($x > 10, "$x should be greater than 10") }, + qr/5 should be greater than 10/; + + # success + ok lives { assert($a < $b, "This should not appear") }; + ok lives { assert($b > $a, "This should not appear") }; + }; + + subtest 'string comparison' => sub { + my $str1 = "hello"; + my $str2 = "world"; + like dies { assert($str1 eq $str2, "strings should match") }, + qr/strings should match/; + + my $same = "foo"; + like dies { assert($same ne $same, "$same should differ from itself") }, + qr/foo should differ from itself/; + + my $a = "z"; + my $b = "a"; + like dies { assert($a lt $b, "$a should be lt $b") }, + qr/z should be lt a/; + + # success + ok lives { assert($str1 ne $str2, "This should not appear") }; + ok lives { assert($b lt $a, "This should not appear") }; + }; +}; + +done_testing;