diff --git a/Changes b/Changes index ad8d4676..5ce6c7d8 100644 --- a/Changes +++ b/Changes @@ -17,6 +17,12 @@ - Removed Data::Types as a test dependency as it was barely used and not necessary + [Bug fixes] + + - PERL-489 references to scalars with both number and string slots internally + would crash on BSON encoding, rather than encode the string part as a + binary. + v0.999.998.1 2014-11-12 15:10:40-05:00 America/New_York (TRIAL RELEASE) [!!! Incompatible Changes !!!] diff --git a/perl_mongo.c b/perl_mongo.c index da0f00b9..0007024f 100644 --- a/perl_mongo.c +++ b/perl_mongo.c @@ -1393,7 +1393,8 @@ append_sv (bson_t * bson, const char * in_key, SV *sv, stackette *stack, int is_ croak ("type (%s) unhandled", HvNAME(SvSTASH(SvRV(sv)))); } } else { - switch (SvTYPE (SvRV (sv))) { + SV *deref = SvRV(sv); + switch (SvTYPE (deref)) { case SVt_PVHV: { /* hash */ bson_t child; @@ -1411,14 +1412,16 @@ append_sv (bson_t * bson, const char * in_key, SV *sv, stackette *stack, int is_ bson_append_array_end(bson, &child); break; } - case SVt_PV: - /* binary */ - - serialize_binary(bson, key, BSON_SUBTYPE_BINARY, SvRV(sv)); - break; - default: - sv_dump(SvRV(sv)); - croak ("type (ref) unhandled"); + default: { + if ( SvPOK(deref) ) { + /* binary */ + serialize_binary(bson, key, BSON_SUBTYPE_BINARY, deref); + } + else { + sv_dump(deref); + croak ("type (ref) unhandled"); + } + } } } } else { diff --git a/t/bson.t b/t/bson.t index 9ae819d1..a3114d02 100644 --- a/t/bson.t +++ b/t/bson.t @@ -404,4 +404,15 @@ subtest "Checking hash key unicode support" => sub { is ( $obj->{$testkey}, 1 ); }; +subtest "PERL-489 ref to PVNV" => sub { + my $value = 42.2; + $value = "hello"; + is( + exception { $c->insert( { value => \$value } ) }, + undef, + "inserting ref to PVNV is not fatal", + ); +}; + + done_testing;