Remove hardcoded cop.h constants from APItest.pm :-(
Nicholas Clark [Mon, 21 Jan 2008 11:48:22 +0000 (11:48 +0000)]
Add G_WANT. Make call.t use G_WANT.

p4raw-id: //depot/perl@33023

ext/XS/APItest/APItest.pm
ext/XS/APItest/Makefile.PL
ext/XS/APItest/t/call.t

index 76db948..883a15c 100644 (file)
@@ -18,24 +18,13 @@ our @EXPORT = qw( print_double print_int print_long
                  mxpushp mxpushn mxpushi mxpushu
                  call_sv call_pv call_method eval_sv eval_pv require_pv
                  G_SCALAR G_ARRAY G_VOID G_DISCARD G_EVAL G_NOARGS
-                 G_KEEPERR G_NODEBUG G_METHOD
+                 G_KEEPERR G_NODEBUG G_METHOD G_WANT
                  apitest_exception mycroak strtab
                  my_cxt_getint my_cxt_getsv my_cxt_setint my_cxt_setsv
                  sv_setsv_cow_hashkey_core sv_setsv_cow_hashkey_notcore
 );
 
-# from cop.h 
-sub G_SCALAR() {   0 }
-sub G_ARRAY()  {   1 }
-sub G_VOID()   { 128 }
-sub G_DISCARD()        {   2 }
-sub G_EVAL()   {   4 }
-sub G_NOARGS() {   8 }
-sub G_KEEPERR()        {  16 }
-sub G_NODEBUG()        {  32 }
-sub G_METHOD() {  64 }
-
-our $VERSION = '0.12';
+our $VERSION = '0.13';
 
 use vars '$WARNINGS_ON_BOOTSTRAP';
 use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
index 05bcfb0..59d35c9 100644 (file)
@@ -24,8 +24,11 @@ WriteMakefile(
 WriteConstants(
     PROXYSUBS => 1,
     NAME => 'XS::APItest',
-    NAMES => [qw(HV_DELETE HV_DISABLE_UVAR_XKEY G_DISCARD HV_FETCH_ISSTORE
-                HV_FETCH_ISEXISTS HV_FETCH_LVALUE HV_FETCH_JUST_SV)],
-);
+    NAMES => [qw(HV_DELETE HV_DISABLE_UVAR_XKEY HV_FETCH_ISSTORE
+                HV_FETCH_ISEXISTS HV_FETCH_LVALUE HV_FETCH_JUST_SV
+                G_SCALAR G_ARRAY G_VOID G_DISCARD G_EVAL G_NOARGS
+                G_KEEPERR G_NODEBUG G_METHOD G_FAKINGEVAL),
+             {name=>"G_WANT", default=>["IV", "G_ARRAY|G_VOID"]}],
+              );
 
 sub MY::install { "install ::\n"  };
index b4facd7..f06ae88 100644 (file)
@@ -90,31 +90,33 @@ for my $test (
     ok(eq_array( [ call_method('meth', $flags, $obj, @$args) ], $expected),
        "$description call_method('meth')");
 
+    my $returnval = ((($flags & G_WANT) == G_ARRAY) || ($flags & G_DISCARD))
+       ? [0] : [ undef, 1 ];
     for my $keep (0, G_KEEPERR) {
        my $desc = $description . ($keep ? ' G_KEEPERR' : '');
        my $exp_err = $keep ? "before\n\t(in cleanup) its_dead_jim\n"
                            : "its_dead_jim\n";
        $@ = "before\n";
        ok(eq_array( [ call_sv('d', $flags|G_EVAL|$keep, @$args) ],
-                   $flags & (G_ARRAY|G_DISCARD) ? [0] : [ undef, 1 ]),
+                   $returnval),
                    "$desc G_EVAL call_sv('d')");
        is($@, $exp_err, "$desc G_EVAL call_sv('d') - \$@");
 
        $@ = "before\n";
        ok(eq_array( [ call_pv('d', $flags|G_EVAL|$keep, @$args) ], 
-                   $flags & (G_ARRAY|G_DISCARD) ? [0] : [ undef, 1 ]),
+                   $returnval),
                    "$desc G_EVAL call_pv('d')");
        is($@, $exp_err, "$desc G_EVAL call_pv('d') - \$@");
 
        $@ = "before\n";
        ok(eq_array( [ eval_sv('d()', $flags|$keep) ],
-                   $flags & (G_ARRAY|G_DISCARD) ? [0] : [ undef, 1 ]),
+                   $returnval),
                    "$desc eval_sv('d()')");
        is($@, $exp_err, "$desc eval_sv('d()') - \$@");
 
        $@ = "before\n";
        ok(eq_array( [ call_method('d', $flags|G_EVAL|$keep, $obj, @$args) ],
-                   $flags & (G_ARRAY|G_DISCARD) ? [0] : [ undef, 1 ]),
+                   $returnval),
                    "$desc G_EVAL call_method('d')");
        is($@, $exp_err, "$desc G_EVAL call_method('d') - \$@");
     }
@@ -138,7 +140,7 @@ for my $test (
        [ "its_dead_jim\n" ]), "$description eval { call_pv('d') }");
 
     ok(eq_array( [ eval { eval_sv('d', $flags), $@ }, $@ ],
-       [ ($flags & (G_ARRAY|G_DISCARD)) ? (0) : (undef, 1),
+       [ @$returnval,
                "its_dead_jim\n", '' ]),
        "$description eval { eval_sv('d') }");