From: Vincent Pit Date: Fri, 25 Sep 2015 10:00:36 +0000 (+0200) Subject: Add support for ops of class UNOP_AUX X-Git-Tag: rt107294~4 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=7afdaf8f49acc22b13ccfcee9bc03045d0a88036;p=perl%2Fmodules%2FVariable-Magic.git Add support for ops of class UNOP_AUX This class has been added in commit 2f7c6295, which was publicly available in perl 5.21.7. --- diff --git a/Magic.xs b/Magic.xs index 33fc60e..40b438f 100644 --- a/Magic.xs +++ b/Magic.xs @@ -391,6 +391,9 @@ typedef enum { OPc_COP, #if VMG_HAS_PERL(5, 21, 5) OPc_METHOP, +#endif +#if VMG_HAS_PERL(5, 21, 7) + OPc_UNOP_AUX, #endif OPc_MAX } opclass; @@ -410,6 +413,9 @@ static const char *const vmg_opclassnames[] = { "B::COP", #if VMG_HAS_PERL(5, 21, 5) "B::METHOP", +#endif +#if VMG_HAS_PERL(5, 21, 7) + "B::UNOP_AUX", #endif NULL }; @@ -486,6 +492,10 @@ static opclass vmg_opclass(const OP *o) { #if VMG_HAS_PERL(5, 21, 5) case OA_METHOP: return OPc_METHOP; +#endif +#if VMG_HAS_PERL(5, 21, 7) + case OA_UNOP_AUX: + return OPc_UNOP_AUX; #endif } diff --git a/t/18-opinfo.t b/t/18-opinfo.t index aed437a..ff66315 100644 --- a/t/18-opinfo.t +++ b/t/18-opinfo.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 17 * (3 + 4) + 5 + 1; +use Test::More tests => 18 * (3 + 4) + 5 + 1; use Config qw<%Config>; @@ -18,34 +18,38 @@ my $aelem = "$]" <= 5.008_003 ? 'aelem' ? 'aelemfast' : 'sassign'; my $aelemf = ("$]" < 5.013 or $is_5130_release) ? 'aelemfast' : 'sassign'; -my $aelemf_op = $aelemf eq 'sassign' +my $aelemf_op = ($aelemf eq 'sassign') ? 'B::BINOP' : $Config{useithreads} ? 'B::PADOP' : 'B::SVOP'; my $meth_op = ("$]" < 5.021_005) ? 'B::SVOP' : 'B::METHOP'; +my $deref = ("$]" < 5.021_007) ? 'helem' : 'multideref'; +my $deref_op = ($deref eq 'multideref') ? 'B::UNOP_AUX' : 'B::UNOP'; our @o; my @tests = ( - [ 'len', '@c', 'my @c', 'my $x = @c', [ 'padav', 'B::OP' ] ], - [ 'get', '$c[0]', 'my @c', 'my $x = $c[0]', [ $aelem, 'B::OP' ] ], - [ 'get', '$o[0]', 'local @o', 'my $x = $o[0]', [ $aelemf, $aelemf_op ] ], - [ 'get', '$c', 'my $c = 1', '++$c', [ 'preinc', 'B::UNOP' ] ], - [ 'get', '$c', 'my $c = 1', '$c ** 2', [ 'pow', 'B::BINOP' ] ], - [ 'get', '$c', 'my $c = 1', 'my $x = $c', [ 'sassign', 'B::BINOP' ] ], - [ 'get', '$c', 'my $c = 1', '1 if $c', [ 'and', 'B::LOGOP' ] ], - [ 'get', '$c', 'my $c = []','ref $c', [ 'ref', 'B::UNOP' ] ], - [ 'get', '$c', 'my $c = $0','-f $c', [ 'ftfile', 'B::UNOP' ] ], + [ 'len', '@c', 'my @c', 'my $x = @c', [ 'padav', 'B::OP' ] ], + [ 'get', '$c[0]', 'my @c', 'my $x = $c[0]', [ $aelem, 'B::OP' ] ], + [ 'get', '$o[0]', 'local @o', 'my $x = $o[0]', [ $aelemf, $aelemf_op ] ], + [ 'get', '$x->{a}', 'my $x', 'my $y = $x->{a}{b}', + [ $deref, $deref_op ] ], + [ 'get', '$c', 'my $c = 1', '++$c', [ 'preinc', 'B::UNOP' ] ], + [ 'get', '$c', 'my $c = 1', '$c ** 2', [ 'pow', 'B::BINOP' ] ], + [ 'get', '$c', 'my $c = 1', 'my $x = $c', [ 'sassign', 'B::BINOP' ] ], + [ 'get', '$c', 'my $c = 1', '1 if $c', [ 'and', 'B::LOGOP' ] ], + [ 'get', '$c', 'my $c = []', 'ref $c', [ 'ref', 'B::UNOP' ] ], + [ 'get', '$c', 'my $c = $0', '-f $c', [ 'ftfile', 'B::UNOP' ] ], [ 'get', '$c', 'my $c = "Z"', 'my $i = 1; Z:goto $c if $i--', [ 'goto', 'B::UNOP' ] ], - [ 'set', '$c', 'my $c = 1', 'bless \$c, "main"', + [ 'set', '$c', 'my $c = 1', 'bless \$c, "main"', [ 'bless', 'B::LISTOP' ] ], - [ 'get', '$c', 'my $c = ""','$c =~ /x/', [ 'match', 'B::PMOP' ] ], + [ 'get', '$c', 'my $c = ""', '$c =~ /x/', [ 'match', 'B::PMOP' ] ], [ 'get', '$c', 'my $c = "Variable::Magic::TestPkg"', - '$c->foo()', [ 'method_named', $meth_op ] ], - [ 'get', '$c', 'my $c = ""','$c =~ y/x/y/', [ 'trans', 'B::PVOP' ] ], - [ 'get', '$c', 'my $c = 1', '1 for 1 .. $c', + '$c->foo()', [ 'method_named', $meth_op ] ], + [ 'get', '$c', 'my $c = ""', '$c =~ y/x/y/', [ 'trans', 'B::PVOP' ] ], + [ 'get', '$c', 'my $c = 1', '1 for 1 .. $c', [ 'enteriter', 'B::LOOP' ] ], - [ 'free','$c', 'my $c = 1', 'last', [ 'last', 'B::OP' ] ], - [ 'free','$c', 'L:{my $c = 1', 'last L}', [ 'last', 'B::OP' ] ], + [ 'free','$c', 'my $c = 1', 'last', [ 'last', 'B::OP' ] ], + [ 'free','$c', 'L:{my $c = 1', 'last L}', [ 'last', 'B::OP' ] ], ); our $done;