1#!perl
2#
3# Test the XSPP_wrapped() macro.
4#
5# The XS function set_custom_pp_func() modifies the pp_addr value of the
6# op following it to point to a pp function written in the traditional
7# non-refcounted style (POPs etc), but which is declared using
8# XSPP_wrapped(), so on PERL_RC_STACK builds, the ref count handling of
9# the args and return value should still be correct.
10
11use warnings;
12use strict;
13use Test::More;
14use Config;
15use XS::APItest qw(set_custom_pp_func);
16
17my ($count, $ret, $c);
18sub DESTROY { $count++ }
19
20
21$count = 0;
22{
23    my $nine = 9;
24    # set_custom_pp_func() overrides the pp func for the next op,
25    # which is the pp_add
26    ($ret, $c) = (bless(\$nine)+set_custom_pp_func(15), $count);
27}
28
29is($ret,  24, "custom add returns correct value");
30is($c,     0, "custom add: arg not yet freed");
31is($count, 1, "custom add: arg now freed");
32
33
34$count = 0;
35{
36    my $nine =    9;
37    my $ten  =   10;
38    my $eleven = 11;
39    # set_custom_pp_func() overrides the pp func for the next op,
40    # which is the anonlist
41    ($ret, $c) = (
42                    [
43                        bless(\$nine),
44                        bless(\$ten),
45                        set_custom_pp_func(bless(\$eleven)),
46                    ],
47                    $count
48                 );
49}
50
51ok(defined $ret, "custom anonlist returns defined value");
52is(${$ret->[0]},  9, "custom anonlist arg [0]");
53is(${$ret->[1]}, 10, "custom anonlist arg [1]");
54is(${$ret->[2]}, 11, "custom anonlist arg [2]");
55is($c,            0, "custom anonlist args not yet freed");
56is($count,        0, "custom anonlist args not yet freed 2");
57
58undef $ret;
59
60is($count,        3, "custom anonlist args now freed");
61
62
63done_testing();
64