Test-HexDifferences-1.001/0000744000000000000000000000000013126652501014007 5ustar rootrootTest-HexDifferences-1.001/t/0000744000000000000000000000000013126652473014262 5ustar rootrootTest-HexDifferences-1.001/t/11_eq_or_dump_diff.t0000644000000000000000000000316313126631100020057 0ustar rootroot#!perl -T use strict; use warnings; use Test::Tester tests => 2 + 4 * 7; use Test::More; use Test::NoWarnings; BEGIN { use_ok( 'Test::HexDifferences' ); } check_test( sub { eq_or_dump_diff(undef, 1, 'got undef'); }, { ok => 0, depth => 1, name => 'got undef', diag => <<'EOT', +---+-------+----------+ | Ln|Got |Expected | +---+-------+----------+ * 1|undef |1 * +---+-------+----------+ EOT }, ); check_test( sub { eq_or_dump_diff(1, undef, 'expected undef'); }, { ok => 0, depth => 1, name => 'expected undef', diag => <<'EOT', +---+-----+----------+ | Ln|Got |Expected | +---+-----+----------+ * 1|1 |undef * +---+-----+----------+ EOT }, ); check_test( sub { eq_or_dump_diff(1, 1, 'equal'); }, { ok => 1, depth => 1, name => 'equal', diag => q{}, }, ); check_test( sub { eq_or_dump_diff('12345678', '1234567', '12345678 ne 1234567'); }, { ok => 0, depth => 1, name => '12345678 ne 1234567', diag => <<'EOT', +---+---------------------------+---------------------------+ | Ln|Got |Expected | +---+---------------------------+---------------------------+ | 1|0000 : 31 32 33 34 : 1234 |0000 : 31 32 33 34 : 1234 | * 2|0004 : 35 36 37 38 : 5678 |0004 : 35 36 37 : 567 * +---+---------------------------+---------------------------+ EOT }, ); Test-HexDifferences-1.001/t/03_all_formats.t0000644000000000000000000000261313126631106017246 0ustar rootroot#!perl -T use strict; use warnings; use Test::More tests => 2 + 1; use Test::NoWarnings; use Test::Differences; BEGIN { use_ok('Test::HexDifferences::HexDump'); } my $bytes = <<"EOT"; \x11 \x21\x22\x21\x22\x21\x22 \x21\x22\x21\x22 \x41\x42\x43\x44\x41\x42\x43\x44\x41\x42\x43\x44 \x41\x42\x43\x44\x41\x42\x43\x44 \x81\x82\x83\x84\x85\x86\x87\x88 \x81\x82\x83\x84\x85\x86\x87\x88 \x81\x82\x83\x84\x85\x86\x87\x88 EOT $bytes =~ s{\n}{}xmsg; my $format = <<"EOT"; 1 byte: %a %C\n%1x% 2 byte: %a %S %S< %S>\n%1x% 2 byte: %a %v %n\n%1x% 4 byte: %a %L %L< %L>\n%1x% 4 byte: %a %V %N\n%1x% 8 byte: %a %Q\n%1x% 8 byte: %a %Q<\n%1x% 8 byte: %a %Q>\n%1x% EOT # big-endian (network order) or little-endian my $result = ( pack 'S', 1 ) eq ( pack 'n', 1 ) ? <<'EOT' : <<'EOT'; 1 byte: 0000 11 2 byte: 0001 2122 2221 2122 2 byte: 0007 2221 2122 4 byte: 000B 41424344 44434241 41424344 4 byte: 0017 44434241 41424344 8 byte: 001F 8182838485868788 8 byte: 0027 8887868584838281 8 byte: 002F 8182838485868788 EOT 1 byte: 0000 11 2 byte: 0001 2221 2221 2122 2 byte: 0007 2221 2122 4 byte: 000B 44434241 44434241 41424344 4 byte: 0017 44434241 41424344 8 byte: 001F 8887868584838281 8 byte: 0027 8887868584838281 8 byte: 002F 8182838485868788 EOT eq_or_diff( hex_dump( $bytes, { format => $format }, ), $result, 'all formats', ); Test-HexDifferences-1.001/t/chars.t0000644000000000000000000000635113126631054015546 0ustar rootroot#!perl -T use strict; use warnings; use Cwd qw(getcwd); use File::Find; use Test::More; $ENV{AUTHOR_TESTING} or plan( skip_all => 'Author test. Set $ENV{AUTHOR_TESTING} to a true value to run.' ); my $UNTAINT_FILENAME_PATTERN = qr{\A ( (?: (?: [A-Z] : ) | // )? [0-9A-Z_\-/\. ]+ ) \z}xmsi; my ($PATH) = getcwd() =~ $UNTAINT_FILENAME_PATTERN; $PATH =~ s{\\}{/}xmsg; my @list; find( { untaint_pattern => $UNTAINT_FILENAME_PATTERN, untaint => 1, wanted => sub { -d and return; $File::Find::name =~ m{ / \.svn / | / \.git / | / \.gitignore \z }xms and return; $File::Find::name =~ m{ ( (?: /lib/ | /example/ | /t/ ) | /Build\.PL \z | /Changes \z | /README \z | /MANIFEST\.SKIP \z ) }xms or return; push @list, $File::Find::name; }, }, $PATH, ); plan( tests => 6 * scalar @list ); my @ignore_non_ascii = ( ); for my $file_name (sort @list) { my @lines; { open my $file, '< :raw', $file_name or die "Cannnot open file $file_name"; local $/ = (); my $text = <$file>; # repair last line without \n ok( ! ( $text =~ s{([^\x0D\x0A]) \z}{$1\x0D\x0A}xms ), "$file_name has newline at EOF", ); @lines = split m{\x0A}, $text; } my $find_line_numbers = sub { my ($test_description, $test_reason, $regex, $regex_negation) = @_; my $line_number = 0; my @line_numbers = map { ++$line_number; ($regex_negation xor $_ =~ $regex) ? $line_number : (); } @lines; ok(! @line_numbers, $test_description); if (@line_numbers) { if (@line_numbers > 10) { $#line_numbers = 10; $line_numbers[10] = '...'; } my $line_numbers = join q{, }, @line_numbers; diag("Check line $line_numbers in file $file_name for $test_reason."); } return; }; $find_line_numbers->( "$file_name has network line endings (LFCR)", 'line endings', qr{\x0D \z}xms, 1, ); $find_line_numbers->( "$file_name has no TABs", 'TABs', qr{\x09}xms, ); $find_line_numbers->( "$file_name has no control chars", 'control chars', qr{[\x00-\x08\x0B\x0C\x0E-\x1F\x7F]}xms, ); NON_ASCII: { for my $regex (@ignore_non_ascii) { if ( $file_name =~ $regex ) { ok(1, 'dummy'); next NON_ASCII; } } $find_line_numbers->( "$file_name has no nonASCII chars", 'nonASCII chars', qr{[\x80-\xA6\xA8-\xFF]}xms, # A7 is § ); } $find_line_numbers->( "$file_name has no trailing space", 'trailing space', qr{[ ] (?: \x0D? \x0A | \z )}xms, ); } Test-HexDifferences-1.001/t/12_dumped_eq_dump_or_diff.t0000644000000000000000000000365713126631071021435 0ustar rootroot#!perl -T use strict; use warnings; use Test::Tester tests => 2 + 4 * 7; use Test::More; use Test::NoWarnings; BEGIN { use_ok( 'Test::HexDifferences' ); } check_test( sub { dumped_eq_dump_or_diff(undef, 1, 'got undef'); }, { ok => 0, depth => 1, name => 'got undef', diag => <<'EOT', +---+-------+----------+ | Ln|Got |Expected | +---+-------+----------+ * 1|undef |1 * +---+-------+----------+ EOT }, ); check_test( sub { dumped_eq_dump_or_diff(1, undef, 'expected undef'); }, { ok => 0, depth => 1, name => 'expected undef', diag => <<'EOT', +---+--------------------------+----------+ | Ln|Got |Expected | +---+--------------------------+----------+ * 1|0000 : 31 : 1\n |undef * +---+--------------------------+----------+ EOT }, ); check_test( sub { dumped_eq_dump_or_diff( 1, "0000 : 31 : 1\n", 'equal', ); }, { ok => 1, depth => 1, name => 'equal', diag => q{}, }, ); check_test( sub { dumped_eq_dump_or_diff( '12345678', <<'EOT', 0000 : 31 32 33 34 : 1234 0004 : 35 36 37 : 567 EOT '12345678 ne 1234567', ); }, { ok => 0, depth => 1, name => '12345678 ne 1234567', diag => <<'EOT', +---+---------------------------+---------------------------+ | Ln|Got |Expected | +---+---------------------------+---------------------------+ | 1|0000 : 31 32 33 34 : 1234 |0000 : 31 32 33 34 : 1234 | * 2|0004 : 35 36 37 38 : 5678 |0004 : 35 36 37 : 567 * +---+---------------------------+---------------------------+ EOT }, ); Test-HexDifferences-1.001/t/02_hex_dump.t0000644000000000000000000000137113126631115016553 0ustar rootroot#!perl -T use strict; use warnings; use Test::More tests => 4 + 1; use Test::NoWarnings; use Test::Differences; BEGIN { use_ok('Test::HexDifferences::HexDump'); } eq_or_diff( hex_dump("\x00"), "0000 : 00" . ( q{ } x 3 x (4 - 1) ) . " : .\n", 'char NUL, default format', ); eq_or_diff( hex_dump( "E", { address => 0xABCD, format => "%4a : %1C : %d\n%*x", }, ), "ABCD : 45 : E\n", 'char E, single byte format', ); eq_or_diff( hex_dump( "\x00\x01 .abc", { format => <<"EOT", %a %2C\n%1x% %a %5C %d\n%2x% EOT }, ), <<'EOT', 0000 00 01 0002 20 2E 61 62 63 ..abc EOT '2 lines', ); Test-HexDifferences-1.001/t/21_test_examples.t0000644000000000000000000000126013126631062017616 0ustar rootroot#!perl use strict; use warnings; use Test::More; use Cwd qw(getcwd chdir); use English qw(-no_match_vars $CHILD_ERROR); $ENV{AUTHOR_TESTING} or plan( skip_all => 'Set $ENV{AUTHOR_TESTING} to run this test.' ); plan(tests => 2); for my $test ( qw(01_eq_or_dump_diff.t 02_dumped_eq_dump_or_diff.t) ) { my $dir = getcwd(); chdir "$dir/example"; my $result = qx{prove -I../lib -T $test 2>&1}; $CHILD_ERROR && $CHILD_ERROR != 256 and die "Couldn't run $test (status $CHILD_ERROR)"; chdir $dir; like( $result, qr{\QFailed 2/3 subtests\E | \Qfailed 2 tests of 3\E }xms, "prove example $test", ); } Test-HexDifferences-1.001/t/01_format_iterator.t0000644000000000000000000000246313126631127020150 0ustar rootroot#!perl -T use strict; use warnings; use Test::More tests => 4 + 1; use Test::NoWarnings; use Test::Differences; BEGIN { use_ok('Test::HexDifferences::HexDump'); } *next_format = \&Test::HexDifferences::HexDump::_next_format; { my $data_pool = { format => "%4a : %1C : %d\n%*x", }; next_format($data_pool); my $format_block = $data_pool->{format_block}; next_format($data_pool); $format_block .= $data_pool->{format_block}; eq_or_diff( $format_block, "%4a : %1C : %d\n" . "%4a : %1C : %d\n", 'read format* 2 times', ); } { my $data_pool = { format => "%a %2C\n%1x" . "%a %5C %d\n%2x", }; next_format($data_pool); my $format_block = $data_pool->{format_block}; next_format($data_pool); $format_block .= $data_pool->{format_block}; next_format($data_pool); $format_block .= $data_pool->{format_block}; eq_or_diff( $format_block, "%a %2C\n" . "%a %5C %d\n" . "%a %5C %d\n", 'read format + format', ); next_format($data_pool); $format_block = $data_pool->{format_block}; eq_or_diff( $format_block, "%a : %4C : %d\n", 'read none existing format', ); } Test-HexDifferences-1.001/t/pod.t0000644000000000000000000000027213126631030015216 0ustar rootroot#!perl -T use strict; use warnings; use Test::More; eval 'use Test::Pod 1.14; 1' or plan( skip_all => 'Test::Pod 1.14 required for testing POD' ); all_pod_files_ok(); Test-HexDifferences-1.001/t/perl_critic.t0000644000000000000000000000050113126631041016730 0ustar rootroot#!perl use strict; use warnings; use Test::More; eval 'use Test::Perl::Critic -severity => 1; 1' or plan( skip_all => 'Test::Perl::Critic required' ); $ENV{AUTHOR_TESTING} or plan( skip_all => 'Author test. Set $ENV{AUTHOR_TESTING} to a true value to run.' ); all_critic_ok( qw( lib ) ); Test-HexDifferences-1.001/t/prereq_build.t0000644000000000000000000000101113126631006017104 0ustar rootroot#!perl use strict; use warnings; use Test::More; $ENV{RELEASE_TESTING} or plan( skip_all => 'Author test. Set $ENV{RELEASE_TESTING} to a true value to run.' ); eval 'use Test::Prereq::Build; 1' or plan( skip_all => 'Test::Prereq::Build not installed' ); # These modules should not go into Build.PL my @skip_devel_only = qw( Test::Kwalitee Test::Perl::Critic Test::Prereq::Build ); my @skip = ( @skip_devel_only, ); prereq_ok( undef, undef, \@skip ); Test-HexDifferences-1.001/t/pod_coverage.t0000644000000000000000000000033213126631016017072 0ustar rootroot#!perl -T use strict; use warnings; use Test::More; eval 'use Test::Pod::Coverage 1.04; 1' or plan( skip_all => 'Test::Pod::Coverage 1.04 required for testing POD coverage' ); all_pod_coverage_ok(); Test-HexDifferences-1.001/Changes0000644000000000000000000000234013126632045015304 0ustar rootrootRevision history for Perl extension Test::HexDifferences. 1.001 Tue Jul 4 08:22:06 2017 - build dist with nmake instead of Module::Build 1.000 Sun Jul 5 15:43:06 2015 - use Test::Diff directly - added prototypes - test output has changed 0.009 Sat Jul 4 14:56:30 2015 - fixed https://rt.cpan.org/Public/Bug/Display.html?id=100489 by checking version of Test::Differences 0.008 Sat Mar 22 08:46:13 2014 - Sub::Exporter instead of Perl6::Export::Attrs 0.007 Wed Aug 28 08:17:34 2013 - removed Build.PL from distribution 0.006 Tue Mar 20 07:50:41 2012 - changed dependence of Test::Differences because problems with undef before 0.60 0.005 Fri Mar 16 07:15:22 2012 - Makefile.PL repaired 0.004 Sun Jan 29 09:29:11 2012 - Tests run now on a little-endian machine correctly. Some more Pod. 0.003 Wed Jan 25 22:39:08 2012 - https://rt.cpan.org/Public/Bug/Display.html?id=74230 Some formats needed Perl 5.10 others a 64 bit machine to unpack the data. Moved this dependencies from unpack to module code. 0.002 Sun Jan 15 20:15:45 2012 - renamed submodule and subroutines incompatible - new test subroutine dumped_eq_dump_or_diff 0.001 Sat Jan 14 09:17:58 2012 - first release Test-HexDifferences-1.001/META.json0000644000000000000000000000224213126652501015432 0ustar rootroot{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.16, CPAN::Meta::Converter version 2.150005", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Test-HexDifferences", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Hash::Util" : "0", "Sub::Exporter" : "0", "Test::Builder::Module" : "0.99", "Test::Differences" : "0.60", "Test::More" : "0", "Test::NoWarnings" : "0", "Test::Tester" : "0", "Text::Diff" : "0", "version" : "0" } } }, "release_status" : "stable", "version" : "1.001", "x_serialization_backend" : "JSON::PP version 2.27400" } Test-HexDifferences-1.001/MANIFEST0000644000000000000000000000062613126652461015153 0ustar rootrootChanges example/01_eq_or_dump_diff.t example/02_dumped_eq_dump_or_diff.t lib/Test/HexDifferences.pm lib/Test/HexDifferences/HexDump.pm MANIFEST This list of files README t/01_format_iterator.t t/02_hex_dump.t t/03_all_formats.t t/11_eq_or_dump_diff.t t/12_dumped_eq_dump_or_diff.t t/21_test_examples.t t/chars.t t/perl_critic.t t/pod.t t/pod_coverage.t t/prereq_build.t Makefile.PL META.yml META.json Test-HexDifferences-1.001/README0000644000000000000000000000117313126632121014667 0ustar rootrootTest::HexDifferences version 1.001 ================================== Test binary as hexadecimal string. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: Hash::Util Sub::Exporter Test::Builder::Module Text::Diff COPYRIGHT AND LICENCE Copyright (c) 2012 - 2015, Steffen Winkler steffenw at cpan.org. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Test-HexDifferences-1.001/Makefile.PL0000644000000000000000000000133113126652461015766 0ustar rootroot# Note: this file was auto-generated by Module::Build::Compat version 0.4218 require 5.006; use ExtUtils::MakeMaker; WriteMakefile ( 'PREREQ_PM' => { 'version' => 0, 'Text::Diff' => 0, 'Test::Differences' => '0.60', 'Hash::Util' => 0, 'Sub::Exporter' => 0, 'Test::More' => 0, 'Test::Builder::Module' => '0.99', 'Test::NoWarnings' => 0, 'Test::Tester' => 0 }, 'NAME' => 'Test::HexDifferences', 'PL_FILES' => {}, 'VERSION_FROM' => 'lib/Test/HexDifferences.pm', 'EXE_FILES' => [], 'INSTALLDIRS' => 'site' ) ; Test-HexDifferences-1.001/lib/0000744000000000000000000000000013126652472014564 5ustar rootrootTest-HexDifferences-1.001/lib/Test/0000744000000000000000000000000013126652473015504 5ustar rootrootTest-HexDifferences-1.001/lib/Test/HexDifferences/0000744000000000000000000000000013126652472020365 5ustar rootrootTest-HexDifferences-1.001/lib/Test/HexDifferences/HexDump.pm0000644000000000000000000002535613126631214022301 0ustar rootrootpackage Test::HexDifferences::HexDump; ## no critic (TidyCode) use strict; use warnings; our $VERSION = '0.008'; use Hash::Util qw(lock_keys); use Sub::Exporter -setup => { exports => [ qw(hex_dump), ], groups => { default => [ qw(hex_dump) ], }, }; my $default_format = "%a : %4C : %d\n"; sub hex_dump { my ($data, $attr_ref) = @_; defined $data or return $data; ref $data and return $data; $attr_ref = ref $attr_ref eq 'HASH' ? $attr_ref : {}; my $data_pool = { # global data => $data, format => $attr_ref->{format} || "$default_format%*x", address => $attr_ref->{address} || 0, output => q{}, # to format a block format_block => undef, data_length => undef, is_multibyte_error => undef, }; lock_keys %{$data_pool}; BLOCK: while ( length $data_pool->{data} ) { _next_format($data_pool); _format_items($data_pool); } return $data_pool->{output}; } sub _next_format { my $data_pool = shift; my $is_match = $data_pool->{format} =~ s{ \A ( .*? [^%] ) # format of the block % ( 0* [1-9] \d* | [*] ) x # repetition factor } { my $new_count = $2 eq q{*} ? q{*} : $2 - 1; $data_pool->{format_block} = $1; $new_count ? "$1\%${new_count}x" : q{}; }xmse; if ( $data_pool->{is_multibyte_error} || ! $is_match ) { $data_pool->{format} = "$default_format%*x"; $data_pool->{format_block} = $default_format; $data_pool->{is_multibyte_error} = 0; return; } return; } sub _format_items { my $data_pool = shift; $data_pool->{data_length} = 0; RUN: { # % written as %% $data_pool->{format_block} =~ s{ \A % ( % ) } { do { $data_pool->{output} .= $1; q{}; } }xmse and redo RUN; # \n written as %\n will be ignored $data_pool->{format_block} =~ s{ \A % [\n] }{}xms and redo RUN; # address _format_address($data_pool) and redo RUN; # words _format_word($data_pool) and redo RUN; # display ASCII _format_ascii($data_pool) and redo RUN; # display any other char $data_pool->{format_block} =~ s{ \A (.) } { do { $data_pool->{output} .= $1; q{}; } }xmse and redo RUN; if ( $data_pool->{data_length} ) { # clear already displayed data substr $data_pool->{data}, 0, $data_pool->{data_length}, q{}; $data_pool->{data_length} = 0; } } return; } sub _format_address { my $data_pool = shift; return $data_pool->{format_block} =~ s{ \A % ( 0* [48]? ) a } { do { my $length = $1 || 4; $data_pool->{output} .= sprintf "%0${length}X", $data_pool->{address}; q{}; } }xmse; } my $big_endian = q{>}; my $little_endian = q{<}; my $machine_endian = ( pack 'S', 1 ) eq ( pack 'n', 1 ) ? $big_endian # network order : $little_endian; my %format_of = ( 'C' => { # unsigned char bytes => 1, endian => $big_endian, }, 'S' => { # unsigned 16-bit, endian depends on machine bytes => 2, endian => $machine_endian, }, 'S<' => { # unsigned 16-bit, little-endian bytes => 2, endian => $little_endian, }, 'S>' => { # unsigned 16-bit, big-endian bytes => 2, endian => $big_endian, }, 'v' => { # unsigned 16-bit, little-endian bytes => 2, endian => $little_endian, }, 'n' => { # unsigned 16-bit, big-endian bytes => 2, endian => $big_endian, }, 'L' => { # unsigned 32-bit, endian depends on machine bytes => 4, endian => $machine_endian, }, 'L<' => { # unsigned 32-bit, little-endian bytes => 4, endian => $little_endian, }, 'L>' => { # unsigned 32-bit, big-endian bytes => 4, endian => $big_endian, }, 'V' => { # unsigned 32-bit, little-endian bytes => 4, endian => $little_endian, }, 'N' => { # unsigned 32-bit, big-endian bytes => 4, endian => $big_endian, }, 'Q' => { # unsigned 64-bit, endian depends on machine bytes => 8, endian => $machine_endian, }, 'Q<' => { # unsigned 64-bit, little-endian bytes => 8, endian => $little_endian, }, 'Q>' => { # unsigned 64-bit, big-endian bytes => 8, endian => $big_endian, }, ); sub _format_word { my $data_pool = shift; return $data_pool->{format_block} =~ s{ \A % ( 0* [1-9] \d* )? ( [LSQ] [<>] | [CVNvnLSQ] ) } { do { my ($byte_length, $endian) = @{ $format_of{$2} }{ qw(bytes endian) }; $data_pool->{output} .= join q{ }, map { ( length $data_pool->{data} >= $data_pool->{data_length} + $byte_length ) ? do { my @unpacked = unpack q{C} x $byte_length, substr $data_pool->{data}, $data_pool->{data_length}, $byte_length; if ( $endian eq q{<} ) { @unpacked = reverse @unpacked; } my $hex = sprintf '%02X' x $byte_length, @unpacked; $data_pool->{data_length} += $byte_length; $data_pool->{address} += $byte_length; $hex; } : do { if ( $byte_length > 1 ) { $data_pool->{is_multibyte_error}++; } q{ } x 2 x $byte_length; }; } 1 .. ( $1 || 1 ); q{}; } }xmse; } sub _format_ascii { my $data_pool = shift; return $data_pool->{format_block} =~ s{ \A %d } { do { my $data = substr $data_pool->{data}, 0, $data_pool->{data_length}; $data =~ s{ ( ['"\\] ) | ( [!-~] ) | . } { defined $1 ? q{.} : defined $2 ? $2 : q{.} }xmsge; $data_pool->{output} .= $data; q{}; } }xmse; } # $Id$ 1; __END__ =head1 NAME Test::HexDifferences::HexDump - Format binary to hexadecimal strings =head1 VERSION 0.008 =head1 SYNOPSIS use Test::HexDifferences::HexDump; $string = hex_dump( $binary, ); $string = hex_dump( $binary, { address => $start_address, format => "%a : %4C : %d\n", } ); =head2 Format elements Every format element in the format string is starting with % like sprintf. If the given format is shorter defined as needed for the data length the remaining data are displayed in default format. If the given format is longer defined as the data length the output will filled with space and it stops before next repetition. =head3 Data format It is not very clever to use little-endian formats for tests. There is a fallback to bytes if multibyte formats can not displayed. %C - unsigned char %S - unsigned 16-bit, endian depends on machine %S< - unsigned 16-bit, little-endian %S> - unsigned 16-bit, big-endian %v - unsigned 16-bit, little-endian %n - unsigned 16-bit, big-endian %L - unsigned 32-bit, endian depends on machine %L< - unsigned 32-bit, little-endian %L> - unsigned 32-bit, big-endian %V - unsigned 32-bit, little-endian %N - unsigned 32-bit, big-endian %Q - unsigned 64-bit, endian depends on machine %Q< - unsigned 64-bit, little-endian %Q> - unsigned 64-bit, big-endian "pack" and "unpack" before Perl v5.10 do not allow "<" and ">" to mark the byte order. This is allowed here for all Perl versions. "pack" and "unpack" on a 32 bit machine do not allow the "Q" formats. This is allowed here for all machines. =head3 Address format %a - 16 bit address %4a - 16 bit address %8a - 32 bit address =head3 ASCII format It can not display all chars. First it must be a printable ASCII char. It can not be anything of space, q{.}, q{'}, q{"} or q{\}. Otherwise q{.} will be printed. %d - display ASCII =head3 Repetition %*x - repetition endless %1x - repetition 1 time %2x - repetition 2 times ... =head3 Special formats %\n - ignore \n =head2 Default format The default format is: "%a : %4C : %d\n" or fully written as "%a : %4C : %d\n%*x" =head2 Complex formats The %...x allows to write mixed formats e.g. Format: %a : %N %4C : %d\n%1x% %a : %n %2C : %d\n%*x Input: \0x01\0x23\0x45\0x67\0x89\0xAB\0xCD\0xEF \0x01\0x23\0x45\0x67 \0x89\0xAB\0xCD\0xEF Output: 0000 : 01234567 89 AB CD EF : .#-Eg... 0008 : 0123 45 67 : .#-E 000C : 89AB CD EF : g... =head1 EXAMPLE Inside of this Distribution is a directory named example. Run this *.t files. =head1 DESCRIPTION This is a formatter for binary data. =head1 SUBROUTINES/METHODS =head2 subroutine hex_dump $string = hex_dump( $binary, { address => $display_start_address, format => $format_string, } ); =head1 DIAGNOSTICS nothing =head1 CONFIGURATION AND ENVIRONMENT nothing =head1 DEPENDENCIES L L =head1 INCOMPATIBILITIES none =head1 BUGS AND LIMITATIONS none =head1 SEE ALSO L L inspired by =head1 AUTHOR Steffen Winkler =head1 LICENSE AND COPYRIGHT Copyright (c) 2012 - 2014, Steffen Winkler C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Test-HexDifferences-1.001/lib/Test/HexDifferences.pm0000644000000000000000000001307213126632077020727 0ustar rootrootpackage Test::HexDifferences; ## no critic (TidyCode) use strict; use warnings; use Sub::Exporter -setup => { exports => [ qw(eq_or_dump_diff dumped_eq_dump_or_diff), ], groups => { default => [ qw(eq_or_dump_diff dumped_eq_dump_or_diff) ], }, }; use Test::Builder::Module; use Test::HexDifferences::HexDump qw(hex_dump); use Text::Diff qw(diff); our $VERSION = '1.001'; my $builder = Test::Builder->new; my %diff_arg_of = ( STYLE => 'Table', INDEX_LABEL => 'Ln', FILENAME_A => 'Got', FILENAME_B => 'Expected', ); sub eq_or_dump_diff ($$;$$) { ## no critic (SubroutinePrototypes) my ($got, $expected, @more) = @_; my $attr_ref = ( @more && ref $more[0] eq 'HASH' ) ? shift @more : (); my $both_undefined = ! defined $got && ! defined $expected; my $any_undefined = ! defined $got || ! defined $expected; if ( $both_undefined || $any_undefined ) { my $result = $both_undefined || ! $any_undefined && $got eq $expected; $got = defined $got ? $got : 'undef'; $expected = defined $expected ? $expected : 'undef'; my $ok = $builder->ok($result, $more[0]) or $builder->diag( diff( \$got, \$expected, \%diff_arg_of, ), ); return $ok; } my $ok = $builder->ok($got eq $expected, $more[0]) or $builder->diag( diff( \hex_dump($got, $attr_ref), \hex_dump($expected, $attr_ref), \%diff_arg_of, ), ); return $ok; } sub dumped_eq_dump_or_diff ($$;$$) { ## no critic (SubroutinePrototypes) my ($got, $expected_dump, @more) = @_; my $attr_ref = ( @more && ref $more[0] eq 'HASH' ) ? shift @more : (); $got = defined $got ? hex_dump($got, $attr_ref) : 'undef'; $expected_dump = defined $expected_dump ? $expected_dump : 'undef'; $expected_dump = defined $expected_dump ? $expected_dump : q{}; my $ok = $builder->ok($got eq $expected_dump, $more[0]) or $builder->diag( diff( \$got, \$expected_dump, \%diff_arg_of, ), ); return $ok; } # $Id$ 1; __END__ =head1 NAME Test::HexDifferences - Test binary as hexadecimal string =head1 VERSION 1.001 =head1 SYNOPSIS use Test::HexDifferences; eq_or_dump_diff( $got, $expected, ); eq_or_dump_diff( $got, $expected, $test_name, ); eq_or_dump_diff( $got, $expected, { address => $start_address, format => "%a : %4C : %d\n", } $test_name, ); If C<$got> or C<$expected> is C or a reference, the hexadecimal formatter is off. Then C is a text compare. dumped_eq_dump_or_diff( $got_value, $expected_dump, ); dumped_eq_dump_or_diff( $got_value, $expected_dump, $test_name, ); dumped_eq_dump_or_diff( $got_value, $expected_dump, { address => $start_address, format => "%a : %4C : %d\n", } $test_name, ); See L for the format description. =head1 EXAMPLE Inside of this Distribution is a directory named example. Run this *.t files. =head1 DESCRIPTION The are some special cases for testing binary data. =over =item * The ascii format is not good for e.g. a length byte 0x41 displayed as A. =item * Multibyte values are better shown as 1 value. =item * Structured binary e.g. 2 byte length followed by bytes better are shown as it is. =item * Compare 2 binary or 1 binary and a dump. =back =head1 SUBROUTINES/METHODS =head2 subroutine eq_or_dump_diff eq_or_dump_diff( $got_value, $expected_value, { # optional hash reference address => $display_start_address, # optional format => $format_string, # optional } $test_name, # optional ); =head2 subroutine dumped_eq_dump_or_diff dumped_eq_dump_or_diff( $got_value, $expected_dump, { # optional hash reference address => $display_start_address, # optional format => $format_string, # optional } $test_name, # optional ); =head1 DIAGNOSTICS nothing =head1 CONFIGURATION AND ENVIRONMENT nothing =head1 DEPENDENCIES L L L L =head1 INCOMPATIBILITIES none =head1 BUGS AND LIMITATIONS none =head1 SEE ALSO L =head1 AUTHOR Steffen Winkler =head1 LICENSE AND COPYRIGHT Copyright (c) 2012 - 2015, Steffen Winkler C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Test-HexDifferences-1.001/example/0000744000000000000000000000000013126652472015451 5ustar rootrootTest-HexDifferences-1.001/example/01_eq_or_dump_diff.t0000644000000000000000000000441513126631250021255 0ustar rootroot#!perl -T use strict; use warnings; use Test::More tests => 3; use Test::NoWarnings; use Test::HexDifferences; # use default address and default format eq_or_dump_diff( '12345678', # got '1234567', # expected 'example with defaults', # test name ); # use own format # - 1 byte missing in "got". # - 2nd word for "%2n" can not filled, so filled with space. # - End of format. # - Last byte will be displayd in default format. # - This is the default behaviour in case of errors with multibytes format items. eq_or_dump_diff( '12345678', # got '1234567', # expected { address => 0x1000, # set start address format => <<'EOT', # set own format %a %N %1x% %a %2n %1x% EOT }, 'example with customized address and format', ); __END__ >prove -l example\01_eq_or_dump_diff.t example\01_eq_or_dump_diff.t .. 1/3 # Failed test 'example with defaults' # at example\01_eq_or_dump_diff.t line 11. # +---+---------------------------+---------------------------+ # | Ln|Got |Expected | # +---+---------------------------+---------------------------+ # | 1|0000 : 31 32 33 34 : 1234 |0000 : 31 32 33 34 : 1234 | # * 2|0004 : 35 36 37 38 : 5678 |0004 : 35 36 37 : 567 * # +---+---------------------------+---------------------------+ # Failed test 'example with customized address and format' # at example\01_eq_or_dump_diff.t line 23. # +---+------------------+---+------------------------+ # | Ln|Got | Ln|Expected | # +---+------------------+---+------------------------+ # | 1|1000 31323334 | 1|1000 31323334 | # * 2|1004 3536 3738\n * 2|1004 3536\s\s\s\s\s\n * # | | * 3|1006 : 37 : 7 * # +---+------------------+---+------------------------+ # Looks like you failed 2 tests of 3. example\01_eq_or_dump_diff.t .. Dubious, test returned 2 (wstat 512, 0x200) Failed 2/3 subtests Test Summary Report ------------------- example\01_eq_or_dump_diff.t (Wstat: 512 Tests: 3 Failed: 2) Failed tests: 1-2 Non-zero exit status: 2 Files=1, Tests=3, 0 wallclock secs ( 0.11 usr + 0.00 sys = 0.11 CPU) Result: FAIL Test-HexDifferences-1.001/example/02_dumped_eq_dump_or_diff.t0000644000000000000000000000512313126631245022615 0ustar rootroot#!perl -T use strict; use warnings; use Test::More tests => 3; use Test::NoWarnings; use Test::HexDifferences; # use default address and default format { my $got = '1234567'; my $dump = <<'EOT'; 0000 : 31 32 33 34 : 1234 0004 : 35 36 37 38 : 5678 EOT dumped_eq_dump_or_diff( $got, $dump, 'example with defaults', # test name ); } # use own format # - 1 byte missing in "got". # - 2nd word for "%2n" can not filled, so filled with space. # - End of format. # - Last byte will be displayd in default format. # - This is the default behaviour in case of errors with multibytes format items. { my $got = '1234567'; my $dump = <<'EOT'; 1000 31323334 1004 3536 3738 EOT my $format = <<'EOT'; %a %N %1x% %a %2n %1x% EOT dumped_eq_dump_or_diff( $got, $dump, { address => 0x1000, # set start address format => $format, # set own format }, 'example with customized address and format', ); } __END__ >prove -l example\02_dumped_eq_dump_or_diff.t example\02_dumped_eq_dump_or_diff.t .. example\02_dumped_eq_dump_or_diff.t .. 1/3 # Failed test 'example with defaults' # at example\02_dumped_eq_dump_or_diff.t line 17. # +---+---------------------------+---------------------------+ # | Ln|Got |Expected | # +---+---------------------------+---------------------------+ # | 1|0000 : 31 32 33 34 : 1234 |0000 : 31 32 33 34 : 1234 | # * 2|0004 : 35 36 37 : 567 |0004 : 35 36 37 38 : 5678 * # +---+---------------------------+---------------------------+ example\02_dumped_eq_dump_or_diff.t .. 2/3 # Failed test 'example with customized address and format' # at example\02_dumped_eq_dump_or_diff.t line 42. # +---+------------------------+---+------------------+ # | Ln|Got | Ln|Expected | # +---+------------------------+---+------------------+ # | 1|1000 31323334 | 1|1000 31323334 | # * 2|1004 3536\s\s\s\s\s\n * 2|1004 3536 3738\n * # * 3|1006 : 37 : 7 * | | # +---+------------------------+---+------------------+ # Looks like you failed 2 tests of 3. example\02_dumped_eq_dump_or_diff.t .. Dubious, test returned 2 (wstat 512, 0x200) Failed 2/3 subtests Test Summary Report ------------------- example\02_dumped_eq_dump_or_diff.t (Wstat: 512 Tests: 3 Failed: 2) Failed tests: 1-2 Non-zero exit status: 2 Files=1, Tests=3, 1 wallclock secs ( 0.06 usr + 0.03 sys = 0.09 CPU) Result: FAIL Test-HexDifferences-1.001/META.yml0000644000000000000000000000126513126652476015301 0ustar rootroot--- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.16, CPAN::Meta::Converter version 2.150005' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Test-HexDifferences no_index: directory: - t - inc requires: Hash::Util: '0' Sub::Exporter: '0' Test::Builder::Module: '0.99' Test::Differences: '0.60' Test::More: '0' Test::NoWarnings: '0' Test::Tester: '0' Text::Diff: '0' version: '0' version: '1.001' x_serialization_backend: 'CPAN::Meta::YAML version 0.018'