view release on metacpan or  search on metacpan

hax/make_argcheck_ops.c.inc  view on Meta::CPAN

#if HAVE_PERL_VERSION(5, 26, 0)
#  define HAVE_OP_ARGCHECK

#  include "make_argcheck_aux.c.inc"
#endif

#define make_argcheck_ops(required, optional, slurpy, subname)  S_make_argcheck_ops(aTHX_ required, optional, slurpy, subname)
static OP *S_make_argcheck_ops(pTHX_ int required, int optional, char slurpy, SV *subname)
{
  int params = required + optional;

#ifdef HAVE_OP_ARGCHECK
  UNOP_AUX_item *aux = make_argcheck_aux(params, optional, slurpy);

  return op_prepend_elem(OP_LINESEQ, newSTATEOP(0, NULL, NULL),
      op_prepend_elem(OP_LINESEQ, newUNOP_AUX(OP_ARGCHECK, 0, NULL, aux), NULL));
#else
  /* Older perls lack the convenience of OP_ARGCHECK so we'll have to build an
   * optree ourselves. For now we only support required + optional, no slurpy
   *
   * This code heavily inspired by Perl_parse_subsignature() in toke.c from perl 5.24
   */

  OP *ret = NULL;

  if(required > 0) {
    SV *message = newSVpvf("Too few arguments for subroutine '%" SVf "'", subname);
    /* @_ >= required or die ... */
    OP *checkop = 
      newSTATEOP(0, NULL,
        newLOGOP(OP_OR, 0,
          newBINOP(OP_GE, 0,
            /* scalar @_ */
            op_contextualize(newUNOP(OP_RV2AV, 0, newGVOP(OP_GV, 0, PL_defgv)), G_SCALAR),
            newSVOP(OP_CONST, 0, newSViv(required))),
          make_croak_op(message)));

    ret = op_append_list(OP_LINESEQ, ret, checkop);