Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
25 changes: 25 additions & 0 deletions hax/newBINOP_CUSTOM.c.inc
Original file line number Diff line number Diff line change
@@ -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;
}
223 changes: 109 additions & 114 deletions lib/Syntax/Keyword/Assert.xs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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)
{
Expand All @@ -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 *arg0, void *hookdata)

static int build_assert(pTHX_ OP **out, XSParseKeywordPiece *args[], size_t nargs, void *hookdata)
{
OP *argop = arg0->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);
}

Expand All @@ -239,8 +222,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
Expand All @@ -258,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);

{
Expand Down
2 changes: 2 additions & 0 deletions t/01_assert.t
Original file line number Diff line number Diff line change
Expand Up @@ -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');
Expand Down
Loading
Loading