Add builtin::numify

builtin.c

@@ -167,6 +167,10 @@ XS(XS_builtin_func1_scalar)
             Perl_pp_stringify(aTHX);
             break;
 
+        case OP_NUMIFY:
+            Perl_pp_numify(aTHX);
+            break;
+
         default:
             Perl_die(aTHX_ "panic: unhandled opcode %" IVdf
                            " for xs_builtin_func1_scalar()", (IV) ix);
@@ -532,6 +536,7 @@ static const struct BuiltinFuncDescriptor builtins[] = {
     { "is_tainted", SHORTVER(5,39), &XS_builtin_func1_scalar, &ck_builtin_func1, OP_IS_TAINTED, false },
     { "trim",       SHORTVER(5,39), &XS_builtin_trim,         &ck_builtin_func1, 0,             false },
     { "stringify",       NO_BUNDLE, &XS_builtin_func1_scalar, &ck_builtin_func1, OP_STRINGIFY,  true },
+    { "numify",          NO_BUNDLE, &XS_builtin_func1_scalar, &ck_builtin_func1, OP_NUMIFY,     true },
 
     { "created_as_string", NO_BUNDLE, &XS_builtin_created_as_string, &ck_builtin_func1, 0, true },
     { "created_as_number", NO_BUNDLE, &XS_builtin_created_as_number, &ck_builtin_func1, 0, true },

ext/Opcode/Opcode.pm

@@ -1,4 +1,4 @@
-package Opcode 1.65;
+package Opcode 1.66;
 
 use strict;
 
@@ -313,6 +313,7 @@ invert_opset function.
     preinc i_preinc predec i_predec postinc i_postinc
     postdec i_postdec int hex oct abs pow multiply i_multiply
     divide i_divide modulo i_modulo add i_add subtract i_subtract
+    numify
 
     left_shift right_shift bit_and bit_xor bit_or nbit_and
     nbit_xor nbit_or sbit_and sbit_xor sbit_or negate i_negate not

lib/builtin.pm

@@ -1,4 +1,4 @@
-package builtin 0.012;
+package builtin 0.013;
 
 use strict;
 use warnings;
@@ -21,7 +21,7 @@ builtin - Perl pragma to import built-in utility functions
         weaken unweaken is_weak
         blessed refaddr reftype
         created_as_string created_as_number
-        stringify
+        stringify numify
         ceil floor
         indexed
         trim
@@ -253,7 +253,8 @@ When given a value that is already a string, a copy of this value is returned
 unchanged. False booleans are treated like the empty string.
 
 Numbers are turned into a decimal representation. True booleans are treated
-like the number 1.
+like the number 1. C<undef> is treated as the empty string, provoking a
+warning in the usual way.
 
 References to objects in classes that have L<overload> and define the C<"">
 overload entry will use the delegated method to provide a value here.
@@ -263,6 +264,26 @@ overload will return a string that names the underlying container type of
 the reference, its memory address, and possibly its class name if it is an
 object.
 
+=head2 numify
+
+    $num = numify($val);
+
+Returns a new plain perl number that represents the given argument.
+
+When given a value that is already a number, a copy of this value is returned
+unchanged. False booleans are treated like the number zero.
+
+Strings are turned into a number by attempting to interpret a decimal
+representation, possibly provoking a warning in the usual way. C<undef> is
+treated as the number zero, again with a warning in the usual way.
+
+References to objects in class that have L<overload> and define the C<0+>
+overload entry will use the delegated method to provide a value here.
+
+Non-object references, or references to objects in classes without a C<0+>
+overload will return a number that represents the memory address of the
+referred item.
+
 =head2 ceil
 
     $num = ceil($num);

lib/builtin.t

@@ -194,6 +194,33 @@ package FetchStoreCounter {
     is(stringify(bless [], "WithOverloadedStringify"), "STRING", 'stringify invokes "" overload');
 }
 
+# numify
+{
+    use builtin qw( numify );
+
+    is(numify(123),   123, 'numify an integral number');
+    is(numify(1.23), 1.23, 'numify a floating point number');
+    is(numify("456"), 456, 'numify a string');
+
+    my $aref = [];
+    is(numify($aref), $aref+0, 'numify an array ref');
+
+    use builtin qw( created_as_number );
+    ok(!ref numify($aref),               'numified arrayref is not a ref');
+    ok(created_as_number(numify($aref)), 'numified arrayref is created as num');
+
+    {
+        no warnings 'uninitialized';
+        is(numify(undef), 0, 'numified undef is zero');
+    }
+
+    package WithOverloadedNumify {
+        use overload '0+' => sub { return 987 };
+    }
+
+    is(numify(bless [], "WithOverloadedNumify"), 987, 'numify invokes 0+ overload');
+}
+
 # ceil, floor
 {
     use builtin qw( ceil floor );

pp.c

@@ -7989,6 +7989,21 @@ PP(pp_is_tainted)
     return NORMAL;
 }
 
+PP(pp_numify)
+{
+    dTARGET;
+    SV *ssv = *PL_stack_sp;
+    if(SvNOK(ssv))
+        sv_setnv(TARG, SvNV_nomg(ssv));
+    else if(SvIOK(ssv) && SvIsUV(ssv))
+        sv_setuv(TARG, SvUV_nomg(ssv));
+    else
+        sv_setiv(TARG, SvIV_nomg(ssv));
+    SvSETMAGIC(TARG);
+    rpp_replace_1_1_NN(TARG);
+    return NORMAL;
+}
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */

regen/opcodes

@@ -605,3 +605,5 @@ methstart	method start		ck_null		+
 initfield	initialise field	ck_null		+
 
 classname	class name		ck_classname		0t
+
+numify		number conversion	ck_fun		fsT1	S

t/lib/warnings/builtin

@@ -30,6 +30,24 @@ Built-in function 'builtin::is_bool' is experimental at - line 6.
 Built-in function 'builtin::is_bool' is experimental at - line 9.
 Built-in function 'builtin::is_bool' is experimental at - line 12.
 ########
+# builtin.c - stringify
+use warnings qw(all -experimental::builtin);
+use builtin qw(stringify);
+my $x;
+$x = stringify(undef);
+EXPECT
+Use of uninitialized value in string at - line 5.
+########
+# builtin.c - numify
+use warnings qw(all -experimental::builtin);
+use builtin qw(numify);
+my $x;
+$x = numify(undef);
+$x = numify("hello");
+EXPECT
+Use of uninitialized value in number conversion at - line 5.
+Argument "hello" isn't numeric in number conversion at - line 6.
+########
 # builtin.c - weakrefs
 use strict;
 use warnings qw(all -void);