-
Notifications
You must be signed in to change notification settings - Fork 138
/
pbc_dump.t
151 lines (117 loc) · 3.46 KB
/
pbc_dump.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
#! perl
# Copyright (C) 2009-2010, Parrot Foundation.
=head1 NAME
t/tools/pbc_dump.t - test the Parrot Bytecode (PBC) Dumper
=head1 SYNOPSIS
% prove t/tools/pbc_dump.t
=head1 DESCRIPTION
Tests the C<pbc_dump> tool by providing it with a number of source
files, and running through it with various commands.
We never actually check the I<full> output of pbc_dump. We simply check
several smaller components to avoid a test file that is far too unwieldy.
=head1 REQUIREMENTS
This test script requires you to build pbc_dump, by typing
"make parrot_utils" (using a suitable make tool for your platform).
If this requirement has not been met, all tests will be skipped.
=cut
use strict;
use warnings;
use lib qw(lib);
use Test::More;
use Parrot::Config;
use Parrot::Test;
use File::Spec;
my $path;
BEGIN {
$path = File::Spec->catfile( ".", "pbc_dump" );
my $exefile = $path . $PConfig{exe};
unless ( -f $exefile ) {
plan skip_all => "pbc_dump hasn't been built. Run make parrot_utils";
exit(0);
}
plan tests => 13;
}
dump_output_like( <<PIR, "pir", [qr/CONSTANT_t/, qr/BYTECODE_t/], 'pbc_dump basic sanity');
.sub main :main
\$I0 = 42
.end
PIR
dump_output_like( <<PIR, "pir", qr/HEADER\s*=>\s*\[.*wordsize.*byteorder.*floattype.*parrot-version.*bytecode-version.*UUID.*\]/ms, 'pbc_dump HEADER sanity');
.sub main :main
\$I0 = 42
.end
PIR
dump_output_like( <<PIR, "pir", qr/DIRECTORY\s*=>\s*\[.*offs.*op_count.*itype.*id.*size.*segments/ms, 'pbc_dump DIRECTORY sanity');
.sub main :main
\$I0 = 42
.end
PIR
dump_output_like( <<PIR, "pir", qr/BYTECODE_t.*=>.*\[.*offs.*op_count.*itype.*id.*size.*mappings/ms, 'pbc_dump BYTECODE sanity');
.sub main :main
\$I0 = 42
.end
PIR
for my $enc ( qw(binary iso-8859-1 utf8 utf16 ucs2 ucs4) ) {
dump_output_like( <<PIR, "pir", qr/ENCODING.*=>.*$enc/ms, "pbc_dump $enc encoding");
.sub main :main
\$S0 = $enc:"abc"
.end
PIR
}
my $longcode = ".sub main :main\n";
for (0 ... 10000) {
$longcode .= "\$I0 = \$I0 + 1234\n";
}
$longcode .= ".end";
dump_output_like( $longcode, "pir", qr/BYTECODE.*_DB.*=>/,
"large pir program doesn't mess up pbc_dump");
open my $INC1, '>', "inc_a.pir";
print $INC1 <<'EOF';
.sub does :vtable
.param string provides
.end
EOF
close $INC1;
open my $INC2, '>', "inc_b.pir";
print $INC2 <<'EOF';
.namespace [ 'TclConst' ]
.sub class_init :anon :load
$P0 = get_class 'String'
.end
EOF
close $INC2;
open my $INC3, '>', "inc_c.pir";
print $INC3 <<'EOF';
.namespace [ 'TclDict' ]
.sub class_init :anon :load
say "wut"
.end
EOF
close $INC3;
#test known-good hard-coded values. These values come from looking at
#pbc_dump's #output and sanity checking with the locations of the various subs.
dump_output_like( <<PIR, "pir", qr/BYTECODE.*_DB.*OFFSET => 0,.*OFFSET => 7.*OFFSET => 13/ms, 'debug segments contain accurate offsets');
.include 'inc_a.pir'
.include 'inc_b.pir'
.include 'inc_c.pir'
PIR
unlink('inc_a.pir');
unlink('inc_b.pir');
unlink('inc_c.pir');
=head1 HELPER SUBROUTINES
=head2 dump_output_like
dump_output_like(<<PASM, "pasm", "some output", "running $file");
Takes 3-4 arguments: a file to run,
the filename-extension of the file (probably "pir" or "pasm"),
an arrayref or single regex string to match within pbc_dump's output,
and the optional test diagnostic.
=cut
sub dump_output_like {
pbc_postprocess_output_like($path, @_ );
}
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4: