From 0dcedf8faa5e7df647cd612d55ef049b3db3821e Mon Sep 17 00:00:00 2001
From: Alex Kotlar <akotlar@bu.edu>
Date: Thu, 16 Nov 2017 13:13:41 -0500
Subject: [PATCH 1/2] added float32 option

---
 lib/Data/MessagePack.pm    |  4 ++--
 lib/Data/MessagePack/PP.pm | 16 +++++++++++++++-
 t/01_pack.t                | 16 +++++++++++++++-
 t/25_single_float.t        | 20 ++++++++++++++++++++
 xs-src/pack.c              | 13 ++++++++++++-
 5 files changed, 64 insertions(+), 5 deletions(-)
 create mode 100644 t/25_single_float.t

diff --git a/lib/Data/MessagePack.pm b/lib/Data/MessagePack.pm
index 9eb6f62..8b95beb 100644
--- a/lib/Data/MessagePack.pm
+++ b/lib/Data/MessagePack.pm
@@ -4,7 +4,6 @@ use warnings;
 use 5.008001;
 
 our $VERSION = '1.00';
-
 sub true () {
     require Data::MessagePack::Boolean;
     no warnings 'once';
@@ -36,7 +35,7 @@ sub new {
     return bless \%args, $class;
 }
 
-foreach my $name(qw(canonical prefer_integer utf8)) {
+foreach my $name(qw(canonical prefer_integer prefer_float32 utf8)) {
     my $setter = sub {
         my($self, $value) = @_;
         $self->{$name} = defined($value) ? $value : 1;
@@ -49,6 +48,7 @@ foreach my $name(qw(canonical prefer_integer utf8)) {
     no strict 'refs';
     *{$name}          = $setter;
     *{'get_' . $name} = $getter;
+
 }
 
 
diff --git a/lib/Data/MessagePack/PP.pm b/lib/Data/MessagePack/PP.pm
index 5d85c31..670984b 100644
--- a/lib/Data/MessagePack/PP.pm
+++ b/lib/Data/MessagePack/PP.pm
@@ -87,11 +87,17 @@ BEGIN {
                 my @v = unpack( 'V2', pack( 'q', $_[0] ) );
                 return pack 'CN2', 0xd3, @v[1,0];
             };
+
             *pack_double = $pack_double_oabi || sub {
                 my @v = unpack( 'V2', pack( 'd', $_[0] ) );
                 return pack 'CN2', 0xcb, @v[1,0];
             };
 
+            *pack_float = sub {
+                my @v = unpack( 'V2', pack( 'f', $_[0] ) );
+                return pack 'CN2', 0xca, @v[1,0];
+            };
+
             *unpack_float = sub {
                 my @v = unpack( 'v2', substr( $_[0], $_[1], 4 ) );
                 return unpack( 'f', pack( 'n2', @v[1,0] ) );
@@ -113,6 +119,7 @@ BEGIN {
         else { # big endian
             *pack_uint64   = sub { return pack 'CQ', 0xcf, $_[0]; };
             *pack_int64    = sub { return pack 'Cq', 0xd3, $_[0]; };
+            *pack_float   =  sub { return pack 'Cf', 0xca, $_[0]; };
             *pack_double   = $pack_double_oabi || sub { return pack 'Cd', 0xcb, $_[0]; };
 
             *unpack_float  = sub { return unpack( 'f', substr( $_[0], $_[1], 4 ) ); };
@@ -139,6 +146,7 @@ BEGIN {
         # pack_int64/uint64 are used only when the perl support quad types
         *pack_uint64   = sub { return pack 'CQ>', 0xcf, $_[0]; };
         *pack_int64    = sub { return pack 'Cq>', 0xd3, $_[0]; };
+        *pack_float   = sub { return pack 'Cf>', 0xca, $_[0]; };
         *pack_double   = $pack_double_oabi || sub { return pack 'Cd>', 0xcb, $_[0]; };
 
         *unpack_float  = sub { return unpack( 'f>', substr( $_[0], $_[1], 4 ) ); };
@@ -175,6 +183,7 @@ sub pack :method {
     Carp::croak('Usage: Data::MessagePack->pack($dat [,$max_depth])') if @_ < 2;
     $_max_depth = defined $max_depth ? $max_depth : 512; # init
 
+    # back-compat
     if(not ref $self) {
         $self = $self->new(
             prefer_integer => $Data::MessagePack::PreferInteger || 0,
@@ -271,7 +280,12 @@ sub _pack {
         return $header . $value;
 
     }
-    elsif( $flags & B::SVp_NOK ) { # double only
+    elsif( $flags & B::SVp_NOK ) {
+        # double unless user prefers single precision
+        if($self->{prefer_float32}) {
+            return pack_float( $value );
+        }
+
         return pack_double( $value );
     }
     elsif ( $flags & B::SVp_IOK ) {
diff --git a/t/01_pack.t b/t/01_pack.t
index 99f0ca0..84deca5 100644
--- a/t/01_pack.t
+++ b/t/01_pack.t
@@ -19,6 +19,13 @@ sub packit_utf8 {
     $_;
 }
 
+sub packit_float32 {
+    local $_ = unpack("H*", Data::MessagePack->new->prefer_float32->pack($_[0]));
+    s/(..)/$1 /g;
+    s/ $//;
+    $_;
+}
+
 sub pis ($$) {
     is packit($_[0]), $_[1], 'dump ' . $_[1];
 }
@@ -27,6 +34,10 @@ sub pis_utf8 ($$) {
     is packit_utf8($_[0]), $_[1], 'dump ' . $_[1];
 }
 
+sub pis_float32 ($$) {
+    is packit_float32($_[0]), $_[1], 'dump ' . $_[1];
+}
+
 my @dat = (
     0,     '00',
     (my $foo="0")+0, '00',
@@ -88,7 +99,7 @@ my @dat_utf8 = (
     'a' x 0x0100, 'da 01 00' . (' 61' x 0x0100),
 );
 
-plan tests => 1*(scalar(@dat)/2) + 1*(scalar(@dat_utf8)/2);
+plan tests => 1*(scalar(@dat)/2) + 1*(scalar(@dat_utf8)/2) + 1;
 
 for (my $i=0; $i<scalar(@dat); ) {
     pis $dat[$i++], $dat[$i++];
@@ -97,3 +108,6 @@ for (my $i=0; $i<scalar(@dat); ) {
 for (my $i=0; $i<scalar(@dat_utf8); ) {
     pis_utf8 $dat_utf8[$i++], $dat_utf8[$i++];
 }
+
+pis_float32 1.0, 'ca 3f 80 00 00';
+
diff --git a/t/25_single_float.t b/t/25_single_float.t
new file mode 100644
index 0000000..c20299f
--- /dev/null
+++ b/t/25_single_float.t
@@ -0,0 +1,20 @@
+#!perl
+use strict;
+use Config;
+use if $Config{nvsize} > 8,
+    'Test::More', skip_all => 'long double is not supported';
+use Test::More;
+use Data::MessagePack;
+
+my $mp = Data::MessagePack->new();
+$mp->prefer_float32();
+
+foreach my $float(0.123, 3.14) {
+    is $mp->unpack($mp->pack($float)), unpack('f', pack('f',$float));
+
+    scalar( $float > 0 );
+
+    is $mp->unpack($mp->pack($float)), unpack('f', pack('f',$float));
+}
+done_testing;
+
diff --git a/xs-src/pack.c b/xs-src/pack.c
index f09a747..7807cb9 100644
--- a/xs-src/pack.c
+++ b/xs-src/pack.c
@@ -19,6 +19,7 @@ typedef struct {
     SV *sv;          /* result scalar */
 
     bool prefer_int;
+    bool prefer_float32;
     bool canonical;
 } enc_t;
 
@@ -191,7 +192,11 @@ STATIC_INLINE void _msgpack_pack_sv(pTHX_ enc_t* const enc, SV* const sv, int co
             }
         }
     } else if (SvNOKp(sv)) {
-        msgpack_pack_double(enc, (double)SvNVX(sv));
+        if(enc->prefer_float32) {
+            msgpack_pack_float(enc, (float)SvNVX(sv));
+        } else {
+            msgpack_pack_double(enc, (double)SvNVX(sv));
+        }
     } else if (SvIOKp(sv)) {
         if(SvUOK(sv)) {
             PACK_UV(enc, SvUVX(sv));
@@ -323,6 +328,7 @@ XS(xs_pack) {
     // setup configuration
     dMY_CXT;
     enc.prefer_int = MY_CXT.prefer_int; // back compat
+    enc.prefer_float32 = false;
     if(SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVHV) {
         HV* const hv = (HV*)SvRV(self);
         SV** svp;
@@ -332,6 +338,11 @@ XS(xs_pack) {
             enc.prefer_int = SvTRUE(*svp) ? true : false;
         }
 
+        svp = hv_fetchs(hv, "prefer_float32", FALSE);
+        if(svp) {
+            enc.prefer_float32 = SvTRUE(*svp) ? true : false;
+        }
+
         svp = hv_fetchs(hv, "canonical", FALSE);
         if(svp) {
             enc.canonical = SvTRUE(*svp) ? true : false;

From b2f40347e6feda091ea514b70208711db2f54758 Mon Sep 17 00:00:00 2001
From: Alex Kotlar <akotlar@bu.edu>
Date: Fri, 17 Nov 2017 22:23:12 -0500
Subject: [PATCH 2/2] updated msgpack-c dependency

---
 Makefile.PL     | 9 +++------
 msgpack-c       | 2 +-
 xs-src/unpack.c | 1 +
 3 files changed, 5 insertions(+), 7 deletions(-)

diff --git a/Makefile.PL b/Makefile.PL
index c796dd7..d5d1880 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -29,9 +29,9 @@ if ( $] >= 5.008005 and want_xs() ) {
         cc_warnings;
         cc_include_paths('include');
         cc_src_paths('xs-src');
-	postamble (qq{
+    postamble (qq{
 xs-src/pack.o : xshelper.h include/msgpack/pack_define.h include/msgpack/pack_template.h include/msgpack/sysdep.h
-xs-src/unpack.o : xshelper.h include/msgpack/unpack_define.h include/msgpack/unpack_template.h include/msgpack/sysdep.h
+xs-src/unpack.o : xshelper.h include/msgpack/unpack.h include/msgpack/unpack_define.h include/msgpack/unpack_template.h include/msgpack/sysdep.h
 });
 
         if($Module::Install::AUTHOR) {
@@ -126,10 +126,7 @@ sub init_msgpack {
 
     my %msgpack_header = (
         'include'                => ['msgpack-c/include/msgpack.h'],
-        'include/msgpack'        => [<msgpack-c/include/msgpack/pack*.h>,
-                                     <msgpack-c/include/msgpack/unpack*.h>,
-                                     'msgpack-c/include/msgpack/sysdep.h',
-                                     'msgpack-c/include/msgpack/predef.h'],
+        'include/msgpack'        => [<msgpack-c/include/msgpack/*.h>],
         'include/msgpack/predef' => ['msgpack-c/include/msgpack/predef'],
     );
 
diff --git a/msgpack-c b/msgpack-c
index cabd8a8..83a4b89 160000
--- a/msgpack-c
+++ b/msgpack-c
@@ -1 +1 @@
-Subproject commit cabd8a8a038c78e569db06d2f3f812da28191cf4
+Subproject commit 83a4b89818d4ed3b84d69cbf36e782c641ffab53
diff --git a/xs-src/unpack.c b/xs-src/unpack.c
index 2cefee4..849dd88 100644
--- a/xs-src/unpack.c
+++ b/xs-src/unpack.c
@@ -1,5 +1,6 @@
 #define NEED_newRV_noinc
 #define NEED_sv_2pv_flags
+#include "msgpack/unpack.h"
 #include "xshelper.h"
 
 #define MY_CXT_KEY "Data::MessagePack::_unpack_guts" XS_VERSION