view release on metacpan or  search on metacpan

lib/ExtUtils/ParseXS/Node.pm  view on Meta::CPAN

        for my $package (
            sort keys %{ $pxs->{map_overloaded_package_to_C_package} })
        {
            # Emit once for each package with overloads:
            # Set ${'Foo::()'} to the fallback value for each overloaded
            # package 'Foo' (or undef if not specified).
            # But see the 'XXX' comments above about fallback and $().

            my $fallback = $pxs->{map_package_to_fallback_string}{$package};
            $fallback = 'UNDEF' unless defined $fallback;
            $fallback = $fallback eq 'TRUE'  ? '&PL_sv_yes'
                                      : $fallback eq 'FALSE' ? '&PL_sv_no'
                                      :                        '&PL_sv_undef';

            print $self->Q(<<"EOF");
                |    /* The magic for overload gets a GV* via gv_fetchmeth as */
                |    /* mentioned above, and looks in the SV* slot of it for */
                |    /* the "fallback" status. */
                |    sv_setsv(
                |        get_sv( "${package}::()", TRUE ),
                |        $fallback
                |    );
EOF
        }
    }

    # Emit any boot code associated with newXS().

    print @$early;

    # Emit closing scope for the 'CV *cv' declaration

    if ($pxs->{need_boot_cv}) {
        print $self->Q(<<"EOF");
            |    $close_brace
EOF
    }

    # Emit any lines derived from BOOT: sections

    if (@$later) {
        print $self->Q(<<"EOF");
            |
            |    /* Initialisation Section */
            |
EOF

        print @$later;

        print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n"
            if $pxs->{config_WantLineNumbers};

        print $self->Q(<<"EOF");
            |
            |    /* End of Initialisation Section */
            |
EOF
    }

    # Emit code to call any UNITCHECK blocks and return true.
    # Since 5.22, this is been put into a separate function.

    print $self->Q(<<"EOF");
        |#if PERL_VERSION_LE(5, 21, 5)
        |#  if PERL_VERSION_GE(5, 9, 0)
        |    if (PL_unitcheckav)
        |        call_list(PL_scopestack_ix, PL_unitcheckav);
        |#  endif
        |    XSRETURN_YES;
        |#else
        |    Perl_xs_boot_epilog(aTHX_ ax);
        |#endif
        |$close_brace
        |
        |#ifdef __cplusplus
        |$close_brace
        |#endif
EOF
}


# ======================================================================

package ExtUtils::ParseXS::Node::xsub;

# Process an entire XSUB definition

BEGIN { $build_subclass->(
    'decl',       # Node::xsub_decl object holding this XSUB's declaration

    # Boolean flags: they indicate that at least one of each specified
    # keyword has been seen in this XSUB
    'seen_ALIAS',
    'seen_INTERFACE',
    'seen_INTERFACE_MACRO',
    'seen_PPCODE',
    'seen_PROTOTYPE',
    'seen_SCOPE',

    # These three fields indicate how many SVs are returned to the caller,
    # and so influence the emitting of 'EXTEND(n)', 'XSRETURN(n)', and
    # potentially, the value of n in 'ST(n) = ...'.
    #
    # XSRETURN_count_basic is 0 or 1 and indicates whether a basic return
    # value is pushed onto the stack. It is usually directly related to
    # whether the XSUB is declared void, but NO_RETURN and CODE_sets_ST0
    # can alter that.
    #
    # XSRETURN_count_extra indicates how many SVs will be returned in
    # addition the basic 0 or 1. These will be params declared as OUTLIST.
    #
    # CODE_sets_ST0 is a flag indicating that something within a CODE
    # block is doing 'ST(0) = ..' or similar. This is a workaround for
    # a bug: see the code comments "Horrible 'void' return arg count hack"
    # in Node::CODE::parse() for more details.
    'CODE_sets_ST0',           # Bool
    'XSRETURN_count_basic',    # Int
    'XSRETURN_count_extra',    # Int

    # These maintain the alias parsing state across potentially multiple