/* This file is part of the Sub::Op Perl module.
 * See http://search.cpan.org/dist/Sub-Op/ */

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#define __PACKAGE__     "Sub::Op::Test"
#define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1)

#include "sub_op.h"

STATIC SV *sub_op_test_cb = NULL;

STATIC OP *sub_op_test_pp(pTHX) {
 dSP;
 dMARK;
 int i, items;

 ENTER;
 SAVETMPS;

 PUSHMARK(MARK);

 items = call_sv(sub_op_test_cb, G_ARRAY);

 SPAGAIN;
 for (i = 0; i < items; ++i)
  SvREFCNT_inc(SP[-i]);
 PUTBACK;

 FREETMPS;
 LEAVE;

 return NORMAL;
}

/* --- XS ------------------------------------------------------------------ */

MODULE = Sub::Op::Test      PACKAGE = Sub::Op::Test

PROTOTYPES: ENABLE

void
_init(SV *name)
PROTOTYPE: $
PREINIT:
 sub_op_keyword k;
PPCODE:
 k.name  = SvPV_const(name, k.len);
 k.check = 0;
 k.pp    = sub_op_test_pp;
 sub_op_register(aTHX_ &k);
 XSRETURN(0);

void
_callback(SV *cb)
PROTOTYPE: $
PPCODE:
 if (SvROK(cb)) {
  cb = SvRV(cb);
  if (SvTYPE(cb) >= SVt_PVCV) {
   SvREFCNT_dec(sub_op_test_cb);
   sub_op_test_cb = SvREFCNT_inc(cb);
  }
 }
 XSRETURN(0);