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