The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

NAME

XS::Framework::Manual::recipe06 - XS::Framework advanced topic

DESCRIPTION

Let's assume the following C++ API:

    struct PointRecipe13: public panda::Refcnt {
        double x;
        double y;
        PointRecipe13(double xx, double yy): x{xx}, y{yy}{}
    };

    using PointRecipe13SP = panda::iptr<PointRecipe13>;

    struct Shape13: public panda::Refcnt {
        size_t point_count() const { return points.size(); }
        PointRecipe13SP get_point(size_t idx) { return points.at(idx); }
        void add_point(PointRecipe13SP pt) { points.push_back(pt); }
    private:
        std::vector<PointRecipe13SP> points;
    };

i.e. there is a Shape class, which stores points; they are stored as pointers (with shared ownership). The pointers are needed to allow further Point class extension, i.e. potentially allowing to use some derived class. (In the classical OOP-books points are stored by pointer, i.e. ownership is transferred to the Shape class completely; as it was previously explained this is not possible to have, then, the same point in Perl and in some C++ container, because ownership is not shared).

Let's assume that the common typemaps and xs-adapters are written for the both classes, e.g.:

    namespace xs {
        template <>
        struct Typemap<PointRecipe13*> : TypemapObject<PointRecipe13*, PointRecipe13*, ObjectTypeRefcntPtr, ObjectStorageMGBackref> {
            //                                                                                                      (1)
            static std::string package () { return "MyTest::Cookbook::PointRecipe13"; }
        };

        template <>
        struct Typemap<Shape13*> : TypemapObject<Shape13*, Shape13*, ObjectTypeRefcntPtr, ObjectStorageMG> {
            static std::string package () { return "MyTest::Cookbook::Shape13"; }
        };
    }

Let's forget for a moment that ObjectStorageMGBackref storage policy is used (1) and assume that common ObjectStorageMG is used there. Let's execute the following Perl test:

    my $shape = MyTest::Cookbook::Shape13->new;
    my $pt1 = MyTest::Cookbook::PointRecipe13->new(5, 10);
    $shape->add_point($pt1);
    my $pt1_back = $shape->get_point(0);
    is $pt1_back->x, $pt1->x;
    is $pt1_back->y, $pt1->y;
    is $pt1, $pt1_back;

It will give us the results:

    ok 1
    ok 2
    not ok 3
    #   Failed test at t/cookbook/recipe13.t line 30.
    #          got: 'MyTest::Cookbook::PointRecipe13=SCALAR(0xdc53f8)'
    #     expected: 'MyTest::Cookbook::PointRecipe13=SCALAR(0xdc54a0)'

What happened here? The two Perl objects are equal, i.e. they have the same value, and actually they refer the same C++ object, but not identical. This happens as xs::out uses TypemapObject without backrefs-support and new perl SV* wrapper is created on each call.

Seems not a big deal, huh? Let's try to extend the point to let it stores arbitrary metainformation:

    package MyTest::Cookbook::CustomPointRecipe13 {
    use base qw/MyTest::Cookbook::PointRecipe13/;

    sub new {
        my ($class, $x, $y, $meta) = @_;
        my $obj = $class->SUPER::new($x, $y);
        XS::Framework::obj2hv($obj);
        $obj->{meta} = $meta;
        return $obj;
    }

    sub meta { return shift->{meta}; }

    }

and a simple test for it:

    my $pt2 = MyTest::Cookbook::CustomPointRecipe13->new(6, 11, { direction => 'north'});
    $shape->add_point($pt2);
    my $pt2_back = $shape->get_point(1);
    is $pt2_back->x, $pt2->x;
    is $pt2_back->y, $pt2->y;
    isa_ok($pt2_back, 'MyTest::Cookbook::CustomPointRecipe13');
    is $pt2, $shape->get_point(1);

Let's run it:

    ok 4
    ok 5
    not ok 6 - An object of class 'MyTest::Cookbook::PointRecipe13' isa 'MyTest::Cookbook::CustomPointRecipe13'
    #   Failed test 'An object of class 'MyTest::Cookbook::PointRecipe13' isa 'MyTest::Cookbook::CustomPointRecipe13''
    #   at t/cookbook/recipe13.t line 37.
    #     The object of class 'MyTest::Cookbook::PointRecipe13' isn't a 'MyTest::Cookbook::CustomPointRecipe13'
    not ok 7
    #   Failed test at t/cookbook/recipe13.t line 38.
    #          got: 'MyTest::Cookbook::CustomPointRecipe13=HASH(0x3607b98)'
    #     expected: 'MyTest::Cookbook::PointRecipe13=SCALAR(0x3607ef8)'

Ooops! What happened? It seems, as if our derived point class has been downgraded to base point class, and layer of additional information has been erased. Despite the fact that C++ Shape class does supports derived classes, it does not supports Perl derived classes.

To fix that situation, i.e. to keep Perl object type and data identity the Backref notion comes into play: it makes it possible to keep in derived C++ class the original Perl SV* and return it back on demand.

To let backrefs work, the following requirements have to be met:

1) C++ container should support to store derived classes.

2) Typemap's storage policy should be ObjectStorageMGBackref.

3) The special derived C++ class should be stored in C++ container. It should either inerit xs::Backref, or just the derived class instance can be created on fly via xs::make_backref helper function.

Let's show full code for Point xs-adapter.

    MODULE = MyTest                PACKAGE = MyTest::Cookbook::PointRecipe13
    PROTOTYPES: DISABLE

    double PointRecipe13::x(SV* new_val = nullptr) : ALIAS(y = 1) {
        double* val = nullptr;
        switch(ix) {
            case 1: val = &THIS->y; break;
            default: val = &THIS->x; break;
        }
        if (new_val) {
            *val = SvNV(new_val);
        }
        RETVAL = *val;
    }

    PointRecipe13* PointRecipe13::new(double x = 0, double y = 0) {
        RETVAL = make_backref<PointRecipe13>(x, y);     // (2)
    }

The key point is (2), where it returns the special child class instance for Point, which supports backrefs. After fixing it, all failed tests above start to pass.

Please note, that usage of xs::make_backref is not always possible, e.g. in case of virtual inheritance, when virtual base class does not has default constructor: the helper just does not know how and what of arguments forward to it. In that case the class have to inherit from xs::Backref and in the class destructor the Backref::dtor must be invoked to release SV* wrapper; generally this cannot be done in in Backref destructor, as this can be too late as this pointer is no longer points to the original value, stored in Perl SV* wrapper.

Short summary: to keep Perl object data and class identity, when it is moved to C++ container and back, XS::Framework backrefs support should be used ( ObjectStorageMGBackref storage policy and derived class should inherit xs::Backref).