view release on metacpan or  search on metacpan

lib/Object/PadX/Enum.xs  view on Meta::CPAN

      return FALSE;
   lex_read_unichar(0);
   return TRUE;
}
#define lex_consume_unichar(c) S_lex_consume_unichar(aTHX_ (c))

/* Single-keyword compile-time state. We do not support nested enums; a saved
 * snapshot at entry makes accidental nesting visible as a parse-time error
 * via `item`'s check hook rather than as silent corruption.
 */
static int  inside_enum_depth     = 0;
static SV  *current_enum_classname = NULL;

/* Construct an OP tree that, at runtime, calls a named fully-qualified Perl
 * sub with the given pre-built list of argument OPs.
 *
 * `args_list` must be an OP_LIST op (newLISTOP(OP_LIST, ...)).  Ownership of
 * `args_list` is transferred to the returned op.
 */
static OP *S_make_call_op(pTHX_ const char *subname, OP *args_list)
{
   GV *gv = gv_fetchpv(subname, GV_ADD, SVt_PVCV);
   OP *cv_ref = newCVREF(0, newGVOP(OP_GV, 0, gv));

   args_list = op_append_elem(OP_LIST, args_list, cv_ref);
   return newUNOP(OP_ENTERSUB, OPf_STACKED, args_list);
}
#define make_call_op(name, list)  S_make_call_op(aTHX_ (name), (list))

/* --------------------------------------------------------------------- */
/* `enum NAME { BODY }`                                                  */
/* --------------------------------------------------------------------- */

static int build_enum(pTHX_ OP **out, XSParseKeywordPiece *args[], size_t nargs, void *hookdata)
{
   PERL_UNUSED_ARG(hookdata);
   PERL_UNUSED_ARG(nargs);

   SV *packagename = args[0]->sv;
   int nattrs      = args[1]->i;

   /* Snapshot prior context so a stray nested `enum` won't corrupt state. */
   SV  *saved_classname = current_enum_classname;
   int  saved_depth     = inside_enum_depth;

   current_enum_classname = packagename;
   inside_enum_depth      = 1;

   /* Marshal `[name, value_or_undef]` pairs into a Perl AV ref for the helper. */
   AV *attrs_av = newAV();
   for (int i = 0; i < nattrs; i++) {
      AV *pair = newAV();
      av_push(pair, SvREFCNT_inc(args[2 + i]->attr.name));
      SV *value = args[2 + i]->attr.value;
      av_push(pair, value ? SvREFCNT_inc(value) : newSV(0));
      av_push(attrs_av, newRV_noinc((SV *)pair));
   }
   SV *attrs_ref = sv_2mortal(newRV_noinc((SV *)attrs_av));

   /* Drive Object::Pad::MOP::Class->begin_class via the Perl helper. This
    * sets compclassmeta, registers UNITCHECK auto-seal, and adds $ordinal.
    */
   {
      dSP;
      ENTER;
      SAVETMPS;
      PUSHMARK(SP);
      XPUSHs(packagename);
      XPUSHs(attrs_ref);
      PUTBACK;
      call_pv("Object::PadX::Enum::_begin_enum", G_VOID | G_DISCARD);
      FREETMPS;
      LEAVE;
   }

   lex_read_space(0);
   if (!lex_consume_unichar('{'))
      croak("Expected '{' after 'enum %" SVf "'", SVfARG(packagename));

   ENTER;

   /* Object::Pad's `field`/`method` keywords assert PL_curstname matches
    * compclassmeta's name. begin_class sets compclassmeta but not the
    * package; do that here, mirroring Pad.xs:546-555. SAVE machinery
    * ensures restoration at the matching LEAVE.
    */
   SAVEGENERICSV(PL_curstash);
   save_item(PL_curstname);
   PL_curstash = (HV *)SvREFCNT_inc(gv_stashsv(packagename, GV_ADD));
   sv_setsv(PL_curstname, packagename);

   I32 save_ix = block_start(TRUE);

   OP *body = parse_stmtseq(0);
   body = block_end(save_ix, body);

   if (!lex_consume_unichar('}'))
      croak("Expected '}' at end of 'enum %" SVf "' body", SVfARG(packagename));

   LEAVE;

   inside_enum_depth      = saved_depth;
   current_enum_classname = saved_classname;

   /* Trailing runtime call: Object::PadX::Enum::_finalize_enum("NAME"); */
   OP *finalize_args = newLISTOP(OP_LIST, 0, NULL, NULL);
   finalize_args = op_append_elem(OP_LIST, finalize_args,
      newSVOP(OP_CONST, 0, SvREFCNT_inc(packagename)));

   OP *finalize_call = make_call_op("Object::PadX::Enum::_finalize_enum", finalize_args);
   OP *finalize_stmt = newSTATEOP(0, NULL, finalize_call);

   /* body may be NULL for an empty enum block. */
   OP *combined = body
      ? op_append_elem(OP_LINESEQ, body, finalize_stmt)
      : finalize_stmt;

   /* Wrap in a once-loop so it behaves as a single statement, mirroring
    * Object::Pad's class-block emission (Pad.xs:589-591).
    */
   *out = op_append_elem(OP_LINESEQ,