# Before `make install' is performed this script should be runnable with
# `make test'.
# After `make install' it should work as `perl Parse-Readelf.t'
# Without Makefile it could be called with `perl -I../lib
# Parse-Readelf.t'. This is also the command needed to find out what
# specific tests failed in a `make test' as the later only gives you a
# number and not the description of the test.
#########################################################################
use strict;
use Test::More tests => 141;
use File::Spec;
use File::Temp 'tempfile';
require_ok 'Parse::Readelf';
# for successful run with test coverage use:
# cover -delete
# HARNESS_PERL_SWITCHES=-MDevel::Cover=-silent,on,-summary,off make test
# cover
#########################################################################
# identical part of messages:
my $re_msg_tail = qr/at .*Parse-Readelf\.(?:t|pm) line \d{2,}\.?$/;
#########################################################################
# prepare testing with recorded data:
my ($volume, $directories, ) = File::Spec->splitpath($0);
$directories = '.' unless $directories;
my $path = File::Spec->catpath($volume, $directories, '');
{
no warnings 'once';
$Parse::Readelf::Debug::Line::command = $^O eq 'MSWin32' ? 'type' : 'cat';
$Parse::Readelf::Debug::Info::command = $^O eq 'MSWin32' ? 'type' : 'cat';
}
#########################################################################
# output catcher:
sub check_stdout($&@)
{
my $test = shift(@_);
my $rSub = shift(@_);
# redirect stdout to temporary IO-channel:
open my $oldout, '>&STDOUT' or die "Can't dup STDOUT ($test): $!\n";
my $tmp = tempfile() or die "Can't open temporary ($test): $!\n";
open STDOUT, '>&'.fileno($tmp)
or die "Can't dup temporary ($test): $!\n";
# call subroutine:
&$rSub();
# restore stdout:
open STDOUT, '>&'.fileno($oldout)
or die "Can't restore STDOUT ($test): $!\n";
seek $tmp, 0, 0 or die "Can't rewind temporary ($test): $!\n";
my $line = 0;
while (<$tmp>)
{
chomp;
like($_, $_[$line], $test.' - '.$line);
$line++;
}
close $tmp or die "Can't close temporary ($test): $!\n";
is($line, @_, $test.' - all done');
}
#########################################################################
# failing tests:
eval { my $x = Parse::Readelf::new() };
like($@,
qr/^bad call to new of Parse::Readelf $re_msg_tail/,
'bad creation fails');
eval {
my $filepath = File::Spec->catfile($path, 'data', 'xxx.xxx');
my $x = new Parse::Readelf($filepath);
};
like($@,
qr|^Parse::Readelf can't find .* $re_msg_tail|,
'bad file name fails');
#########################################################################
# first "real" tests:
my $filepath = File::Spec->catfile($path, 'data', 'debug_info_4.lst');
my $readelf_data = new Parse::Readelf($filepath);
is(ref($readelf_data), 'Parse::Readelf', 'created Parse::Readelf object');
check_stdout('l_cObject2b',
sub { $readelf_data->print_structure_layout('l_cObject2b'); },
qr'^O\s+STRUCTURE\s+TYPE \(SIZE\)\s+$',
qr'^0\s+l_cObject2b\s+const Structure2& \(16\)\s+$'
);
check_stdout('l_object2a',
sub { $readelf_data->print_structure_layout('l_object2a'); },
qr'^O\s+STRUCTURE\s+TYPE \(SIZE\)\s+$',
qr'^0\s+l_object2a\s+Structure2 \(16\)\s+$',
qr'^0\s+Structure2\s+\(16\)\s+$',
qr'^0\s+m_00_char\s+char \(1\)\s+$',
qr'^8\s+m_01_long_long\s+long long int \(8\)\s+$'
);
check_stdout
('l_object2a + loc',
sub { $readelf_data->print_structure_layout('l_object2a', 1); },
qr'^O\s+STRUCTURE\s+TYPE \(SIZE\)\s+SOURCE LOCATION\s*$',
qr'^0\s+l_object2a\s+Structure2 \(16\)\s+StructureLayoutTest\.cpp:\d+\s*$',
qr'^0\s+Structure2\s+\(16\)\s+StructureLayoutTest\.cpp:\d+\s*$',
qr'^0\s+m_00_char\s+char \(1\)\s+StructureLayoutTest\.cpp:\d+\s*$',
qr'^8\s+m_01_long_long\s+long long int \(8\)\s+StructureLayoutTest\.cpp:\d+\s*$'
);
check_stdout('l_object3',
sub { $readelf_data->print_structure_layout('l_object3'); },
qr'^O\s+STRUCTURE\s+TYPE \(SIZE\)\s+$',
qr'^0\s+l_object3\s+Structure3 \(4\)\s+$',
qr'^0\s+Structure3\s+\(4\)\s+$',
qr'^0\s+m_00_short\s+short int \(2\)\s+$',
qr'^2\s+m_01_short\s+short int \(2\)\s+$'
);
check_stdout('l_object4',
sub { $readelf_data->print_structure_layout('l_object4'); },
qr'^OF\s+STRUCTURE\s+TYPE \(SIZE\)\s+$',
qr'^00\s+l_object4\s+<anonymous struct> \(24\)\s+$',
qr'^00\s+<anonymous struct>\s+\(24\)\s+$',
qr'^00\s+m_00_int\s+int \(4\)\s+$',
qr'^08\s+m_string\s+string \(8\)\s+$',
qr'^16\s+m_01_int\s+int \(4\)\s+$'
);
check_stdout
('l_object1',
sub { $readelf_data->print_structure_layout('l_object1'); },
qr'^OFFSE\s+STRUCTURE\s+TYPE \(SIZE\)\s+$',
qr'^00\s+l_object1\s+Structure1 \(48\)\s+$',
qr'^00\s+Structure1\s+\(48\)\s+$',
qr'^00\s+m_00_long\s+long int \(8\)\s+$',
qr'^08\s+m_01_char_followed_by_filler_for_short\s+char \(1\)\s+$',
qr'^10\s+m_02_short\s+short int \(2\)\s+$',
qr'^12\s+m_03_char_array_6\[6\]\s+char \(6\)\s+$',
qr'^24\s+m_04_pointer\s+void\* \(8\)\s+$',
qr'^32\s+m_06_char_followed_by_filler_for_bit_array\s+char \(1\)\s+$',
qr'^32\.18\s+m_07_02_3_int_bits\s+unsigned int \(3 in 4\)\s+$',
qr'^32\.21\s+m_07_01_2_int_bits\s+unsigned int \(2 in 4\)\s+$',
qr'^32\.23\s+m_07_00_1_int_bit\s+unsigned int \(1 in 4\)\s+$',
qr'^34\s+m_08_char_between_bit_arrays_followed_by_filler\s+char \(1\)\s+$',
qr'^35.2\s+m_09_02_3_char_bits\s+unsigned char \(3 in 1\)\s+$',
qr'^35.5\s+m_09_01_2_char_bits\s+unsigned char \(2 in 1\)\s+$',
qr'^35.7\s+m_09_00_1_char_bit\s+unsigned char \(1 in 1\)\s+$',
qr'^36\s+m_10_substructure\s+<anonymous struct> \(4\)\s+$',
qr'^36\s+<anonymous struct>\s+\(4\)\s+$',
qr'^36\s+m_10_00_char\s+char \(1\)\s+$',
qr'^38\s+m_10_01_short\s+short int \(2\)\s+$',
qr'^40\s+m_11_final_char\s+char \(1\)\s+$'
);
check_stdout('^l_',
sub { $readelf_data->print_structure_layout('^l_'); },
qr'^OFFSE\s+STRUCTURE\s+TYPE \(SIZE\)\s+$',
(qr'^00') x 5,
qr'^08',
(qr'^[1-3][024]\s') x 4,
(qr'^32\.\d{2}\s') x 3,
qr'^34',
(qr'^35\.\d\s') x 3,
(qr'^36') x 3,
qr'^38',
qr'^40',
(qr'^00') x 3,
qr'^08',
(qr'^00') x 3,
qr'^08',
(qr'^00') x 3,
qr'^08',
(qr'^00') x 3,
qr'^08',
(qr'^00') x 3,
qr'^02',
(qr'^00') x 3,
qr'^08',
qr'^16',
(qr'^00') x 5,
qr'^08',
(qr'^00') x 4,
qr'^00\.0',
qr'^00\.12',
(qr'^02') x 4,
qr'^04',
(qr'^08') x 3,
qr'^12\.8',
);
#########################################################################
# special test for Dwarf-4 (different file lookup):
$filepath = File::Spec->catfile($path, 'data', 'debug_info_6.lst');
$readelf_data = new Parse::Readelf($filepath);
is(ref($readelf_data), 'Parse::Readelf', 'created 2nd Parse::Readelf object');
check_stdout
('l_object2a + loc in Dwarf-4',
sub { $readelf_data->print_structure_layout('l_object2a', 1); },
qr'^O\s+STRUCTURE\s+TYPE \(SIZE\)\s+SOURCE LOCATION\s*$',
qr'^0\s+l_object2a\s+Structure2 \(16\)\s+StructureLayoutTest\.cpp:\d+\s*$',
qr'^0\s+Structure2\s+\(16\)\s+StructureLayoutTest\.cpp:\d+\s*$',
qr'^0\s+m_00_char\s+char \(1\)\s+StructureLayoutTest\.cpp:\d+\s*$',
qr'^8\s+m_01_long_long\s+long long int \(8\)\s+StructureLayoutTest\.cpp:\d+\s*$'
);
#########################################################################
# some more tests for special C features:
$filepath = File::Spec->catfile($path, 'data', 'debug_info_0.lst');
$readelf_data = new Parse::Readelf($filepath);
is(ref($readelf_data), 'Parse::Readelf', 'created 3rd Parse::Readelf object');
check_stdout('l_object4',
sub { $readelf_data->print_structure_layout('l_objectAT'); },
qr'^O\s+STRUCTURE\s+TYPE \(SIZE\)\s+$',
qr'^0\s+l_objectATE\s+AnonTypedefEnum \(4\)\s+$',
qr'^0\s+AnonTypedefEnum\s+\(4\)\s+$',
qr'^0\s+\(4\)\s+$',
qr'^0\s+l_objectATU\s+AnonTypedefUnion \(8\)\s+$',
qr'^0\s+AnonTypedefUnion\s+\(8\)\s+$'
);
#########################################################################
# finally some tests with a cloned object:
my $stderr = '';
$SIG{__WARN__} = sub { $stderr .= join('', @_) };
$readelf_data = $readelf_data->new($filepath);
delete $SIG{__WARN__};
like($stderr,
qr/^cloning of a Parse::Readelf object is not supported $re_msg_tail/,
'cloning gives a warning');
is(ref($readelf_data), 'Parse::Readelf', 'created new Parse::Readelf object');