-
Notifications
You must be signed in to change notification settings - Fork 138
/
pbc_disassemble.t
147 lines (111 loc) · 3.72 KB
/
pbc_disassemble.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
#! perl
# Copyright (C) 2009-2010, Parrot Foundation.
=head1 NAME
t/tools/pbc_disassemble.t - test the Parrot Bytecode (PBC) Disassembler
=head1 SYNOPSIS
% prove t/tools/pbc_disassemble.t
=head1 DESCRIPTION
Tests the C<pbc_disassemble> 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_disassemble. 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_disassemble, 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 File::Spec;
use Parrot::Test;
my ($path, $exefile);
BEGIN {
$path = File::Spec->catfile( ".", "pbc_disassemble" );
$exefile = $path . $PConfig{exe};
unless ( -f $exefile ) {
plan skip_all => "pbc_disassemble hasn't been built. Run make parrot_utils";
exit(0);
}
plan tests => 10;
}
my $helpregex = <<OUTPUT;
/pbc_disassemble - parrot bytecode disassembler
Usage:
pbc_disassemble .* [[]file.pbc[]]
pbc_disassemble -o file[.]pasm file[.]pbc
\\s+(-.{1},\\s+--.*(["]\\w+["])?\\s+.*
)+/m
OUTPUT
disassemble_raw_output_like( "--help", $helpregex, "pbc_disassemble help message");
disassemble_raw_output_like( "--thisisnotarealoption", $helpregex, "pbc_disassemble bad option");
disassemble_raw_output_like( "-h -b -o - -?", $helpregex, "pbc_disassemble every option");
my $errorregex = <<OUTPUT;
/Error during disassembly\nPackFile_Header_validate: This is not a valid Parrot bytecode file./m
OUTPUT
disassemble_raw_output_like( "-o del.pasm pbc_disassemble$PConfig{exe}", $errorregex, "pbc_disassemble bad bytecode file");
disassemble_output_like( <<PIR, "pir", qr/PMC_CONST.*set_n_nc.*print_n/ms, 'pbc_disassemble numeric ops');
.sub main :main
\$N3 = 3.14159
print \$N3
print "\\n"
.end
PIR
disassemble_output_like( <<PIR, "pir", qr/PMC_CONST.*set_i_ic.*print_i/ms, 'pbc_disassemble integer ops');
.sub main :main
\$I0 = 1982
print \$I0
print "\\n"
.end
PIR
disassemble_output_like( <<PIR, "pir", qr/PMC_CONST.*new_p_sc.*"ResizablePMCArray".*set_p_kic_ic\s*P.*set_i_p_kic\s*I.*/ms, 'pbc_disassemble pmc ops');
.sub main :main
\$P0 = new 'ResizablePMCArray'
\$P0[0] = 42
\$I0 = \$P0[0]
.end
PIR
disassemble_output_like( <<PIR, "pir", qr/PMC_CONST.*set_s_sc\s*S.*print_s\s*S.*print_sc/ms, 'pbc_disassemble string ops');
.sub main :main
\$S0 = "Wheels within wheels"
print \$S0
print "\\n"
.end
PIR
disassemble_output_like( <<PIR, "pir", qr/set_s_sc S0,utf8:"Hello"/ms, 'pbc_disassemble utf8 string');
.sub main :main
\$S0 = utf8:"Hello"
.end
PIR
my $utf16 = pack('S*', unpack('C*', 'Hello'));
$utf16 =~ s/\0/\\\\0/g;
disassemble_output_like( <<PIR, "pir", qr/set_s_sc S0,utf16:"$utf16"/ms, 'pbc_disassemble utf16 string');
.sub main :main
\$S0 = utf16:"Hello"
.end
PIR
=head1 HELPER SUBROUTINES
=head2 disassemble_output_like
disassemble_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_disassemble's output,
and the optional test diagnostic.
=cut
sub disassemble_output_like {
pbc_postprocess_output_like($path, @_ );
}
sub disassemble_raw_output_like {
my ($options, $snippet, $desc) = @_;
my $out = `$exefile $options 2>&1`;
like( $out, $snippet, $desc );
return;
}
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4: