diff options
Diffstat (limited to 't/05concathash.t')
| -rw-r--r-- | t/05concathash.t | 190 |
1 files changed, 190 insertions, 0 deletions
diff --git a/t/05concathash.t b/t/05concathash.t new file mode 100644 index 0000000..554fc34 --- /dev/null +++ b/t/05concathash.t @@ -0,0 +1,190 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl CatHash.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use strict; +use Benchmark qw(:all); +use Scalar::Util qw(looks_like_number); +no warnings 'uninitialized'; + +use Test::More tests => 41; + +BEGIN { use_ok('DBI') }; + +# null and undefs -- segfaults?; +is (DBI::_concat_hash_sorted(undef, "=", ":", 0, undef), undef); +is (DBI::_concat_hash_sorted({ }, "=", ":", 0, undef), ""); +eval { DBI::_concat_hash_sorted([], "=", ":", 0, undef) }; +like ($@ || "", qr/is not a hash reference/); +is (DBI::_concat_hash_sorted({ }, undef, ":", 0, undef), ""); +is (DBI::_concat_hash_sorted({ }, "=", undef, 0, undef), ""); +is (DBI::_concat_hash_sorted({ }, "=", ":", undef, undef),""); + +# simple cases +is (DBI::_concat_hash_sorted({ 1=>"a", 2=>"b" }, "=", ", ", undef, undef), "1='a', 2='b'"); +# nul byte in key sep and pair sep +# (nul byte in hash not supported) +is DBI::_concat_hash_sorted({ 1=>"a", 2=>"b" }, "=\000=", ":\000:", undef, undef), + "1=\000='a':\000:2=\000='b'", 'should work with nul bytes in kv_sep and pair_sep'; +is DBI::_concat_hash_sorted({ 1=>"a\000a", 2=>"b" }, "=", ":", 1, undef), + "1='a.a':2='b'", 'should work with nul bytes in hash value (neat)'; +is DBI::_concat_hash_sorted({ 1=>"a\000a", 2=>"b" }, "=", ":", 0, undef), + "1='a\000a':2='b'", 'should work with nul bytes in hash value (not neat)'; + +# Simple stress tests +# limit stress when performing automated testing +# eg http://www.nntp.perl.org/group/perl.cpan.testers/2009/06/msg4374116.html +my $stress = $ENV{AUTOMATED_TESTING} ? 1_000 : 10_000; +ok(DBI::_concat_hash_sorted({bob=>'two', fred=>'one' }, "="x$stress, ":", 1, undef)); +ok(DBI::_concat_hash_sorted({bob=>'two', fred=>'one' }, "=", ":"x$stress, 1, undef)); +ok(DBI::_concat_hash_sorted({map {$_=>undef} (1..1000)}, "="x$stress, ":", 1, undef)); +ok(DBI::_concat_hash_sorted({map {$_=>undef} (1..1000)}, "=", ":"x$stress, 1, undef), 'test'); +ok(DBI::_concat_hash_sorted({map {$_=>undef} (1..100)}, "="x$stress, ":"x$stress, 1, undef), 'test'); + +my $simple_hash = { + bob=>"there", + jack=>12, + fred=>"there", + norman=>"there", + # sam =>undef +}; + +my $simple_numeric = { + 1=>"there", + 2=>"there", + 16 => 'yo', + 07 => "buddy", + 49 => undef, +}; + +my $simple_mixed = { + bob=>"there", + jack=>12, + fred=>"there", + sam =>undef, + 1=>"there", + 32=>"there", + 16 => 'yo', + 07 => "buddy", + 49 => undef, +}; + +my $simple_float = { + 1.12 =>"there", + 3.1415926 =>"there", + 32=>"there", + 1.6 => 'yo', + 0.78 => "buddy", + 49 => undef, +}; + +#eval { +# DBI::_concat_hash_sorted($simple_hash, "=",,":",1,12); +#}; +ok(1," Unknown sort order"); +#like ($@, qr/Unknown sort order/, "Unknown sort order"); + + + +## Loopify and Add Neat + + +my %neats = ( + "Neat"=>0, + "Not Neat"=> 1 +); +my %sort_types = ( + guess=>undef, + numeric => 1, + lexical=> 0 +); +my %hashes = ( + Numeric=>$simple_numeric, + "Simple Hash" => $simple_hash, + "Mixed Hash" => $simple_mixed, + "Float Hash" => $simple_float +); + +for my $sort_type (keys %sort_types){ + for my $neat (keys %neats) { + for my $hash (keys %hashes) { + test_concat_hash($hash, $neat, $sort_type); + } + } +} + +sub test_concat_hash { + my ($hash, $neat, $sort_type) = @_; + my @args = ($hashes{$hash}, "=", ":",$neats{$neat}, $sort_types{$sort_type}); + is ( + DBI::_concat_hash_sorted(@args), + _concat_hash_sorted(@args), + "$hash - $neat $sort_type" + ); +} + +if (0) { + eval { + cmpthese(200_000, { + Perl => sub {_concat_hash_sorted($simple_hash, "=", ":",0,undef); }, + C=> sub {DBI::_concat_hash_sorted($simple_hash, "=", ":",0,1);} + }); + + print "\n"; + cmpthese(200_000, { + NotNeat => sub {DBI::_concat_hash_sorted( + $simple_hash, "=", ":",1,undef); + }, + Neat => sub {DBI::_concat_hash_sorted( + $simple_hash, "=", ":",0,undef); + } + }); + }; +} +#CatHash::_concat_hash_values({ }, ":-",,"::",1,1); + + +sub _concat_hash_sorted { + my ( $hash_ref, $kv_separator, $pair_separator, $use_neat, $num_sort ) = @_; + # $num_sort: 0=lexical, 1=numeric, undef=try to guess + + return undef unless defined $hash_ref; + die "hash is not a hash reference" unless ref $hash_ref eq 'HASH'; + my $keys = _get_sorted_hash_keys($hash_ref, $num_sort); + my $string = ''; + for my $key (@$keys) { + $string .= $pair_separator if length $string > 0; + my $value = $hash_ref->{$key}; + if ($use_neat) { + $value = DBI::neat($value, 0); + } + else { + $value = (defined $value) ? "'$value'" : 'undef'; + } + $string .= $key . $kv_separator . $value; + } + return $string; +} + +sub _get_sorted_hash_keys { + my ($hash_ref, $sort_type) = @_; + if (not defined $sort_type) { + my $sort_guess = 1; + $sort_guess = (not looks_like_number($_)) ? 0 : $sort_guess + for keys %$hash_ref; + $sort_type = $sort_guess; + } + + my @keys = keys %$hash_ref; + no warnings 'numeric'; + my @sorted = ($sort_type) + ? sort { $a <=> $b or $a cmp $b } @keys + : sort @keys; + #warn "$sort_type = @sorted\n"; + return \@sorted; +} + +1; |