svpeek.t revision 1.1
1BEGIN {
2    chdir 't' if -d 't';
3    @INC = '../lib';
4    push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
5    require Config; import Config;
6    if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
7        print "1..0 # Skip: XS::APItest was not built\n";
8        exit 0;
9    }
10}
11
12use strict;
13use warnings;
14
15use Test::More tests => 50;
16
17BEGIN { use_ok('XS::APItest') };
18
19$| = 1;
20
21  is (DPeek ($/),    'PVMG("\n"\0)',		'$/');
22  is (DPeek ($\),    'PVMG()',			'$\\');
23  is (DPeek ($.),    'PVMG()',			'$.');
24  is (DPeek ($,),    'PVMG()',			'$,');
25  is (DPeek ($;),    'PV("\34"\0)',		'$;');
26  is (DPeek ($"),    'PV(" "\0)',		'$"');
27  is (DPeek ($:),    'PVMG(" \n-"\0)',		'$:');
28  is (DPeek ($~),    'PVMG()',			'$~');
29  is (DPeek ($^),    'PVMG()',			'$^');
30  is (DPeek ($=),    'PVMG()',			'$=');
31  is (DPeek ($-),    'PVMG()',			'$-');
32like (DPeek ($!), qr'^PVMG\("',			'$!');
33if ($^O eq 'VMS') {
34  # VMS defines COMPLEX_STATUS and upgrades $? to PVLV
35  is (DPeek ($?),    'PVLV()',			'$?');
36} else {
37  is (DPeek ($?),    'PVMG()',			'$?');
38}
39  is (DPeek ($|),    'PVMG(1)',			'$|');
40
41  "abc" =~ m/(b)/;	# Don't know why these magic vars have this content
42like (DPeek ($1), qr'^PVMG\("',			' $1');
43  is (DPeek ($`),    'PVMG()',			' $`');
44  is (DPeek ($&),    'PVMG()',			' $&');
45  is (DPeek ($'),    'PVMG()',			" \$'");
46
47  is (DPeek (undef), 'SV_UNDEF',		'undef');
48  is (DPeek (1),     'IV(1)',			'constant 1');
49  is (DPeek (""),    'PV(""\0)',		'constant ""');
50  is (DPeek (1.),    'NV(1)',			'constant 1.');
51  is (DPeek (\1),    '\IV(1)',			'constant \1');
52  is (DPeek (\\1),   '\\\IV(1)',		'constant \\\1');
53
54  is (DPeek (\@ARGV),	'\AV()',		'\@ARGV');
55  is (DPeek (\@INC),	'\AV()',		'\@INC');
56  is (DPeek (\%INC),	'\HV()',		'\%INC');
57  is (DPeek (*STDOUT),	'GV()',			'*STDOUT');
58  is (DPeek (sub {}),	'\CV(__ANON__)',	'sub {}');
59
60{ our ($VAR, @VAR, %VAR);
61  open VAR, "<", $^X or die "Can't open $^X: $!";
62  sub VAR {}
63  format VAR =
64.
65
66  is (DPeek ( $VAR),	'UNDEF',		' $VAR undef');
67  is (DPeek (\$VAR),	'\UNDEF',		'\$VAR undef');
68  $VAR = 1;
69  is (DPeek ($VAR),	'IV(1)',		' $VAR 1');
70  is (DPeek (\$VAR),	'\IV(1)',		'\$VAR 1');
71  $VAR = "";
72  is (DPeek ($VAR),	'PVIV(""\0)',		' $VAR ""');
73  is (DPeek (\$VAR),	'\PVIV(""\0)',		'\$VAR ""');
74  $VAR = "\xa8";
75  is (DPeek ($VAR),	'PVIV("\250"\0)',	' $VAR "\xa8"');
76  is (DPeek (\$VAR),	'\PVIV("\250"\0)',	'\$VAR "\xa8"');
77  SKIP: {
78      $] <= 5.008001 and skip "UTF8 tests useless in this ancient perl version", 1;
79      $VAR = "a\x0a\x{20ac}";
80      is (DPeek ($VAR), 'PVIV("a\n\342\202\254"\0) [UTF8 "a\n\x{20ac}"]',
81						  ' $VAR "a\x0a\x{20ac}"');
82      }
83  $VAR = sub { "VAR" };
84  is (DPeek ($VAR),	'\CV(__ANON__)',	' $VAR sub { "VAR" }');
85  is (DPeek (\$VAR),	'\\\CV(__ANON__)',	'\$VAR sub { "VAR" }');
86  $VAR = 0;
87
88  is (DPeek (\&VAR),	'\CV(VAR)',		'\&VAR');
89  is (DPeek ( *VAR),	'GV()',			' *VAR');
90
91  is (DPeek (*VAR{GLOB}),	'\GV()',	' *VAR{GLOB}');
92like (DPeek (*VAR{SCALAR}), qr'\\PV(IV|MG)\(0\)',' *VAR{SCALAR}');
93  is (DPeek (*VAR{ARRAY}),	'\AV()',	' *VAR{ARRAY}');
94  is (DPeek (*VAR{HASH}),	'\HV()',	' *VAR{HASH}');
95  is (DPeek (*VAR{CODE}),	'\CV(VAR)',	' *VAR{CODE}');
96  is (DPeek (*VAR{IO}),		'\IO()',	' *VAR{IO}');
97  is (DPeek (*VAR{FORMAT}),$]<5.008?'SV_UNDEF':'\FM()',' *VAR{FORMAT}');
98  }
99
1001;
101