1use Test::More tests => 21; 2BEGIN { use_ok( 'B::Flags' ); } 3 4ok B::main_root->flagspv =~ /VOID/, "main_root VOID"; 5ok B::main_root->privatepv =~ /REFCOUNTED/, "main_root->privatepv REFCOUNTED"; 6ok B::svref_2object(\3)->flagspv =~ /READONLY/, "warning 3 READONLY"; 7 8# for AV, CV and GV print its flags combined and splitted 9@Typed::ISA=('main'); 10@a = (0..4); 11use Devel::Peek; 12my $SVt_PVAV = $] < 5.010 ? 10 : 11; 13my $BothFlags = 'REAL'; 14my $AvFlags = $] < 5.010 ? 'REAL' : ''; 15my $SvFlags = $] < 5.010 ? '' : 'REAL'; 16my $av = B::svref_2object( \@a ); 17is $av->flagspv, $BothFlags, "AV default ".$av->flagspv." both flags" 18 or Dump(\@a); 19is $av->flagspv($SVt_PVAV), $AvFlags, "AvFLAGS only ".$av->flagspv($SVt_PVAV); 20is $av->flagspv(0), $SvFlags, "SvFLAGS only ".$av->flagspv(0); 21 22sub mycv { my $n=1; my Typed $x = 0; 1} 23my $cv = B::svref_2object( \&main::mycv ); 24my $pad = ($cv->PADLIST->ARRAY)[1]; 25is $pad->flagspv, $BothFlags, "PAD default ".$pad->flagspv." both flags"; 26is $pad->flagspv($SVt_PVAV), $AvFlags, "PAD AvFLAG only ".$pad->flagspv($SVt_PVAV); 27is $pad->flagspv(0), $SvFlags, "PAD SvFLAGS only ".$pad->flagspv(0). " - fallthrough"; 28 29sub lvalcv:lvalue {my $n=1;} 30my $SVt_PVCV = $] < 5.010 ? 12 : 13; 31my $cv1 = B::svref_2object( \&main::lvalcv ); 32like $cv1->flagspv, qr/LVALUE/, "LVCV SvFLAGS+CvFLAGS"; 33like $cv1->flagspv($SVt_PVCV), qr/^LVALUE/, "LVCV CvFLAGS only"; 34unlike $cv1->flagspv(0), qr/LVALUE/, "LVCV SvFLAGS only"; 35 36my $SVt_PVGV = $] < 5.010 ? 13 : 9; 37my $gv = B::svref_2object( \*mycv ); 38like $gv->flagspv, qr/MULTI/, "GV SvFLAGS+GvFLAGS"; 39like $gv->flagspv($SVt_PVGV), qr/^(MULTI|THINKFIRST,MULTI)/, "GvFLAGS only"; 40unlike $gv->flagspv(0), qr/MULTI/, "SvFLAGS only"; 41 42my $padnl = ($cv->PADLIST->ARRAY)[0]; 43my $result = $] >= 5.022 ? '' 44 : $] >= 5.020 ? 'NAMELIST,REAL' 45 : 'REAL'; 46is $padnl->flagspv, $result, "PADNAMELIST as ".ref($padnl); 47 48my $padn1 = ($padnl->ARRAY)[1]; 49my $padl1 = ($pad->ARRAY)[1]; 50SKIP: { 51 skip "empty PADNAME", 1 if ref $padn1 eq 'B::SPECIAL'; 52 my $pv = ref $padn1 eq 'B::SPECIAL' ? "" : $padn1->PV; 53 $result = $] >= 5.022 ? "" : "POK,pPOK"; 54 is $padn1->flagspv, $result, "PADNAME $pv as ".ref($padn1); 55} 56SKIP: { 57 skip "empty PAD", 1 if ref $padl1 eq 'B::SPECIAL'; 58 $result = $] >= 5.022 ? "PADSTALE" 59 : $] >= 5.016 ? "PADSTALE,PADTMP,PADMY" 60 : $] >= 5.014 ? "PADSTALE,PADMY" 61 : $] >= 5.010 ? "PADMY" 62 : "PADBUSY,PADMY"; 63 is $padl1->flagspv, $result, "PAD as ".ref($padl1); 64} 65 66my $padt = ($padnl->ARRAY)[2]; 67SKIP: { 68 skip "empty typed PADNAME", 1 if !$padt or ref $padt eq 'B::SPECIAL'; 69 my $pv = ref $padt eq 'B::SPECIAL' ? "" : $padt->PV; 70 $result = $] >= 5.022 ? "TYPED" 71 : $] >= 5.016 ? "PADSTALE,PADTMP,POK,pPOK,TYPED" 72 : $] >= 5.010 ? "PADTMP,POK,pPOK,TYPED,VALID" 73 : $] >= 5.008 ? "POK,pPOK,TYPED" 74 : "OBJECT,POK,pPOK"; 75 is $padt->flagspv, $result, "typed PADNAME $pv as ".ref($padt); 76} 77 78my $padl = $cv->PADLIST; 79$result = ($] >= 5.016 and $] < 5.018) ? "REAL" : ""; 80is $padl->flagspv, $result, "PADLIST as ".ref($padl); 81