Author: timbo
Date: Wed May 28 07:26:43 2008
New Revision: 11338
Modified:
dbi/trunk/DBI.xs
dbi/trunk/t/18concathash.t
Log:
Fix _concat_hash_sorted (test wasn't testing xs code, mixed hashes needed work)
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Wed May 28 07:26:43 2008
@@ -219,17 +219,19 @@
const void *val1;
const void *val2;
{
- int first, second;
+ UV first = ((struct num_srt_info *)val1)->numeric;
+ UV second = ((struct num_srt_info *)val2)->numeric;
- first = ((struct num_srt_info *)val1)->numeric;
- second = ((struct num_srt_info *)val2)->numeric;
-
- if (first == second)
- return 0;
- else if (first > second)
+ if (first > second)
return 1;
- else
+ if (first < second)
return -1;
+ /* only likely to reach here if numeric sort forced for non-numeric keys */
+ /* fallback to comparing the key strings */
+ return strcmp(
+ ((struct num_srt_info *)val1)->key,
+ ((struct num_srt_info *)val2)->key
+ );
}
static int
@@ -252,22 +254,24 @@
char **keys;
unsigned int idx = 0;
STRLEN tot_len = 0;
- bool numberish = 1;
+ bool has_non_numerics = 0;
struct num_srt_info *numbers;
hv_len = hv_iterinit(hash);
if (!hv_len)
return 0;
- New(0, keys, hv_len, char *);
- New(0, numbers, hv_len, struct num_srt_info);
+ Newz(0, keys, hv_len, char *);
+ Newz(0, numbers, hv_len, struct num_srt_info);
while ((entry = hv_iternext(hash))) {
*(keys+idx) = hv_iterkey(entry, &key_len);
tot_len += key_len;
- if (grok_number(*(keys+idx), key_len, &(numbers+idx)->numeric) !=
IS_NUMBER_IN_UV)
- numberish = 0;
+ if (grok_number(*(keys+idx), key_len, &(numbers+idx)->numeric) !=
IS_NUMBER_IN_UV) {
+ has_non_numerics = 1;
+ (numbers+idx)->numeric = 0;
+ }
(numbers+idx)->key = *(keys+idx);
++idx;
@@ -276,16 +280,16 @@
if (0 != total_length)
*total_length = tot_len;
- if (sort_order <0)
- sort_order = numberish ? 1 : 0;
+ if (sort_order < 0)
+ sort_order = (has_non_numerics) ? 0 : 1;
- if (0 == sort_order || 0 == numberish ) {
+ if (0 == sort_order) {
qsort(keys, hv_len, sizeof(char*), _cmp_str);
- } else {
+ }
+ else {
qsort(numbers, hv_len, sizeof(struct num_srt_info), _cmp_number);
for (idx = 0; idx < hv_len; ++idx)
*(keys+idx) = (numbers+idx)->key;
-/* SvPV_nolen(sv_2mortal(newSViv(numbers[idx]))); */
}
Safefree(numbers);
@@ -305,7 +309,6 @@
I32 hv_len;
STRLEN kv_sep_len, pair_sep_len, hv_val_len, total_len = 0;
char **keys;
- char *value_string;
unsigned int i = 0;
SV **hash_svp;
SV *return_sv;
@@ -330,11 +333,16 @@
continue;
}
- value_string = (not_neat) ?
- (SvOK(*hash_svp) ? SvPV(*hash_svp, hv_val_len) : "") :
- neatsvpv(*hash_svp,0);
- sv_catpvf(return_sv, (not_neat) ? "%s%s'%s'%s" : "%s%s%s%s",
- keys[i], kv_sep, value_string, (i<hv_len-1) ? pair_sep : "");
+ sv_catpvf(return_sv, "%s%s", keys[i], kv_sep);
+ if (not_neat) {
+ if (SvOK(*hash_svp))
+ sv_catpvf(return_sv, "'%s'", SvPV(*hash_svp, hv_val_len));
+ else sv_catpv(return_sv, "undef");
+ }
+ else sv_catpv(return_sv, neatsvpv(*hash_svp,0));
+
+ if (i < hv_len-1)
+ sv_catpv(return_sv, pair_sep);
}
Safefree(keys);
@@ -4385,15 +4393,12 @@
SV *pair_sep_sv
SV *value_format_sv
SV *sort_type_sv
-
PREINIT:
-
STRLEN kv_sep_len, pair_sep_len;
char *kv_sep, *pair_sep;
int not_neat, sort;
CODE:
-
kv_sep = SvPV(kv_sep_sv, kv_sep_len);
pair_sep = SvPV(pair_sep_sv, pair_sep_len);
@@ -4401,10 +4406,8 @@
mg_get(value_format_sv);
not_neat = SvTRUE(value_format_sv);
-
sort = (SvOK(sort_type_sv)) ? SvIV(sort_type_sv) : -1;
-
RETVAL = _join_hash_sorted(hash,kv_sep, pair_sep, not_neat, sort);
OUTPUT:
Modified: dbi/trunk/t/18concathash.t
==============================================================================
--- dbi/trunk/t/18concathash.t (original)
+++ dbi/trunk/t/18concathash.t Wed May 28 07:26:43 2008
@@ -6,9 +6,12 @@
# change 'tests => 1' to 'tests => last_test_to_print';
use strict;
+use Benchmark qw(:all);
+no warnings 'uninitialized';
+
use Test::More tests => 36;
+
BEGIN { use_ok('DBI') };
-no warnings 'uninitialized';
# null and undefs -- segfaults?;
is (DBI::_concat_hash_sorted({ }, "=", ":", 0, undef), "");
@@ -19,26 +22,24 @@
is (DBI::_concat_hash_sorted({ }, "=", undef, 0, undef), "");
is (DBI::_concat_hash_sorted({ }, "=", ":", undef, undef),"");
-# Simple segfault tests?
+# Simple stress tests
ok(DBI::_concat_hash_sorted({bob=>'two', fred=>'one' }, "="x12000, ":", 1,
undef));
ok(DBI::_concat_hash_sorted({bob=>'two', fred=>'one' }, "=", ":"x12000, 1,
undef));
ok(DBI::_concat_hash_sorted({map {$_=>undef} (1..1000)}, "="x12000, ":", 1,
undef));
-ok(DBI::_concat_hash_sorted({map {$_=>undef} (1..10000)}, "=", ":"x12000, 1,
undef), 'test');
+ok(DBI::_concat_hash_sorted({map {$_=>undef} (1..1000)}, "=", ":"x12000, 1,
undef), 'test');
ok(DBI::_concat_hash_sorted({map {$_=>undef} (1..100)}, "="x12000, ":"x12000,
1, undef), 'test');
my $simple_hash = {
bob=>"there",
jack=>12,
- fred=>"there",
- norman=>"there",
+ fred=>"there",
+ norman=>"there",
# sam =>undef
};
my $simple_numeric = {
1=>"there",
2=>"there",
- 3=>"there",
- 32=>"there",
16 => 'yo',
07 => "buddy",
49 => undef,
@@ -47,22 +48,18 @@
my $simple_mixed = {
bob=>"there",
jack=>12,
- fred=>"there",
- norman=>"there",
- sam =>undef,
+ fred=>"there",
+ sam =>undef,
1=>"there",
- 2=>"there",
- 3=>"there",
32=>"there",
16 => 'yo',
07 => "buddy",
- 49 => undef,
+ 49 => undef,
};
my $simple_float = {
1.12 =>"there",
3.1415926 =>"there",
- 2.718281828 =>"there",
32=>"there",
1.6 => 'yo',
0.78 => "buddy",
@@ -106,21 +103,16 @@
sub test_concat_hash {
my ($hash, $neat, $sort_type) = @_;
+ my @args = ($hashes{$hash}, "=", ":",$neats{$neat},
$sort_types{$sort_type});
is (
- #DBI::_concat_hash_sorted(
- _concat_hash_sorted(
- $hashes{$hash}, "=", ":",$neats{$neat}, $sort_types{$sort_type}
- ),
- _concat_hash_sorted(
- $hashes{$hash} , "=", ":",$neats{$neat}, $sort_types{$sort_type}
- ),
+ DBI::_concat_hash_sorted(@args),
+ _concat_hash_sorted(@args),
"$hash - $neat $sort_type"
);
}
if (0) {
eval {
- use Benchmark qw(:all);
cmpthese(200_000, {
Perl => sub {_concat_hash_sorted($simple_hash, "=", ":",0,undef); },
C=> sub {DBI::_concat_hash_sorted($simple_hash, "=", ":",0,1);}
@@ -136,7 +128,6 @@
}
});
};
-
}
#CatHash::_concat_hash_values({ }, ":-",,"::",1,1);
@@ -165,22 +156,20 @@
use Scalar::Util qw(looks_like_number);
sub _get_sorted_hash_keys {
my ($hash_ref, $sort_type) = @_;
- my $sort_guess = 1;
if (not defined $sort_type) {
- #my $first_key = (each %$hash_ref)[0];
- #$sort_type = looks_like_number($first_key);
-
- $sort_guess =
- (1!=looks_like_number($_)) ? 0:$sort_guess for keys %$hash_ref;
- $sort_type = $sort_guess unless (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';
- return [ ($sort_type && $sort_guess)
- ? sort {$a <=> $b} @keys
- : sort @keys
- ];
+ my @sorted = ($sort_type)
+ ? sort { $a <=> $b or $a cmp $b } @keys
+ : sort @keys;
+ warn "$sort_type = @sorted\n";
+ return [EMAIL PROTECTED];
}
1;
