view release on metacpan or  search on metacpan

lib/Data/Checks.xs  view on Meta::CPAN

      newSVOP(OP_CONST, 0, SvREFCNT_inc(checker->assertmess)),
      NULL));

  if(want_void) {
    /* Wrap it in a full enter/leave pair so it unstacks correctly */
    o->op_flags |= OPf_PARENS;
    o = op_contextualize(op_scope(o), OPf_WANT_VOID);
  }

  return o;
}

static OP *S_DataChecks_make_assertop_v0(pTHX_ struct DataChecks_Checker *checker, OP *argop)
{
  return S_DataChecks_make_assertop(aTHX_ checker, 0, argop);
}

static bool S_DataChecks_check_value(pTHX_ struct DataChecks_Checker *checker, SV *value)
{
  if(checker->constraint) {
    return (*checker->constraint->func)(aTHX_ checker->constraint, value);
  }

  dSP;

  ENTER;
  SAVETMPS;

  EXTEND(SP, 2);
  PUSHMARK(SP);
  if(checker->arg0)
    PUSHs(sv_mortalcopy(checker->arg0));
  PUSHs(value); /* Yes we're pushing the SV itself */
  PUTBACK;

  call_sv((SV *)checker->cv, G_SCALAR);

  SPAGAIN;

  bool ok = SvTRUEx(POPs);

  PUTBACK;

  FREETMPS;
  LEAVE;

  return ok;
}

static void S_DataChecks_assert_value(pTHX_ struct DataChecks_Checker *checker, SV *value)
{
  if(check_value(checker, value))
    return;

  croak_sv(checker->assertmess);
}

MODULE = Data::Checks    PACKAGE = Data::Checks::Debug

void stringify_constraint(SV *sv)
  PPCODE:
    /* Prevent XSUB from double-mortalising it */
    PUSHs(stringify_constraint_sv(extract_constraint(sv)));
    XSRETURN(1);

MODULE = Data::Checks    PACKAGE = Data::Checks::Constraint

void DESTROY(SV *self)
  CODE:
  {
    struct Constraint *c = (struct Constraint *)SvPVX(SvRV(self));
    for(int i = c->n - 1; i >= 0; i--)
      SvREFCNT_dec(c->args[i]);
  }

bool check(SV *self, SV *value)
  CODE:
    struct Constraint *c = (struct Constraint *)SvPVX(SvRV(self));
    RETVAL = (c->func)(aTHX_ c, value);
  OUTPUT:
    RETVAL

MODULE = Data::Checks    PACKAGE = Data::Checks

BOOT:
  sv_setiv(*hv_fetchs(PL_modglobal, "Data::Checks/ABIVERSION_MIN", GV_ADD), 0);
  sv_setiv(*hv_fetchs(PL_modglobal, "Data::Checks/ABIVERSION_MAX", GV_ADD), DATACHECKS_ABI_VERSION);

  sv_setuv(*hv_fetchs(PL_modglobal, "Data::Checks/make_checkdata()@0", GV_ADD),
    PTR2UV(&S_DataChecks_make_checkdata));
  sv_setuv(*hv_fetchs(PL_modglobal, "Data::Checks/free_checkdata()@0", GV_ADD),
    PTR2UV(&S_DataChecks_free_checkdata));
  sv_setuv(*hv_fetchs(PL_modglobal, "Data::Checks/gen_assertmess()@0", GV_ADD),
    PTR2UV(&S_DataChecks_gen_assertmess));
  sv_setuv(*hv_fetchs(PL_modglobal, "Data::Checks/make_assertop()@0", GV_ADD),
    PTR2UV(&S_DataChecks_make_assertop_v0));
  sv_setuv(*hv_fetchs(PL_modglobal, "Data::Checks/make_assertop()@1", GV_ADD),
    PTR2UV(&S_DataChecks_make_assertop));
  sv_setuv(*hv_fetchs(PL_modglobal, "Data::Checks/check_value()@0", GV_ADD),
    PTR2UV(&S_DataChecks_check_value));
  sv_setuv(*hv_fetchs(PL_modglobal, "Data::Checks/assert_value()@0", GV_ADD),
    PTR2UV(&S_DataChecks_assert_value));

  boot_Data_Checks__constraints(aTHX);

  XopENTRY_set(&xop_invoke_checkfunc, xop_name, "invoke_checkfunc");
  XopENTRY_set(&xop_invoke_checkfunc, xop_desc, "invoke checkfunc");
  XopENTRY_set(&xop_invoke_checkfunc, xop_class, OA_UNOP_AUX);
  Perl_custom_op_register(aTHX_ &pp_invoke_checkfunc, &xop_invoke_checkfunc);