view release on metacpan or  search on metacpan

t/4023-object-demolish.t  view on Meta::CPAN

}

package main;

object::define('WithDemolish',
    'name:Str',
);

{
    my $obj = WithDemolish->new(name => "test");
    is(scalar @destroyed, 0, 'DEMOLISH not called while object alive');
}
is(scalar @destroyed, 1, 'DEMOLISH called when object destroyed');
like($destroyed[0], qr/WithDemolish::DEMOLISH called/, 'Correct DEMOLISH message');

# Test 2: Class without DEMOLISH has no overhead
package WithoutDemolish;
package main;

object::define('WithoutDemolish', 'value');

xs/object/object.c  view on Meta::CPAN

        count = call_method("new", G_SCALAR);

        SPAGAIN;

        if (count != 1) {
            croak("Singleton new() did not return object");
        }

        obj = POPs;
        SvREFCNT_inc(obj);  /* Keep the object alive */

        PUTBACK;

        /* Check for BUILD method and call it */
        snprintf(full_build, sizeof(full_build), "%s::BUILD", meta->class_name);
        build_gv = gv_fetchpv(full_build, 0, SVt_PVCV);
        if (build_gv && GvCV(build_gv)) {
            PUSHMARK(SP);
            XPUSHs(obj);
            PUTBACK;