Initial implementation and unit-tests of created_as_{string,number}

3 files changed, 105 insertions, 3 deletions

diff --git a/builtin.c b/builtin.c
index 648f4c6965..9df6630082 100644
--- a/builtin.c
+++ b/builtin.c
@@ -255,6 +255,36 @@ XS(XS_builtin_func1_void)
     XSRETURN(0);
 }
 
+XS(XS_builtin_created_as_string)
+{
+    dXSARGS;
+
+    if(items != 1)
+        croak_xs_usage(cv, "arg");
+
+    SV *arg = ST(0);
+    SvGETMAGIC(arg);
+
+    /* SV was created as string if it has POK and isn't bool */
+    ST(0) = boolSV(SvPOK(arg) && !SvIsBOOL(arg));
+    XSRETURN(1);
+}
+
+XS(XS_builtin_created_as_number)
+{
+    dXSARGS;
+
+    if(items != 1)
+        croak_xs_usage(cv, "arg");
+
+    SV *arg = ST(0);
+    SvGETMAGIC(arg);
+
+    /* SV was created as number if it has NOK or IOK but not POK and is not bool */
+    ST(0) = boolSV(SvNIOK(arg) && !SvPOK(arg) && !SvIsBOOL(arg));
+    XSRETURN(1);
+}
+
 static OP *ck_builtin_func1(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 {
     const struct BuiltinFuncDescriptor *builtin = NUM2PTR(const struct BuiltinFuncDescriptor *, SvUV(ckobj));
@@ -268,6 +298,10 @@ static OP *ck_builtin_func1(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 
     entersubop = ck_entersub_args_proto(entersubop, namegv, prototype);
 
+    OPCODE opcode = builtin->ckval;
+    if(!opcode)
+        return entersubop;
+
     OP *parent = entersubop, *pushop, *argop;
 
     pushop = cUNOPx(entersubop)->op_first;
@@ -286,8 +320,6 @@ static OP *ck_builtin_func1(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 
     op_free(entersubop);
 
-    OPCODE opcode = builtin->ckval;
-
     return newUNOP(opcode, wantflags, argop);
 }
 
@@ -359,6 +391,9 @@ static const struct BuiltinFuncDescriptor builtins[] = {
     { "builtin::floor",    &XS_builtin_func1_scalar, &ck_builtin_func1, OP_FLOOR    },
     { "builtin::trim",     &XS_builtin_trim, NULL, 0 },
 
+    { "builtin::created_as_string", &XS_builtin_created_as_string, &ck_builtin_func1, 0 },
+    { "builtin::created_as_number", &XS_builtin_created_as_number, &ck_builtin_func1, 0 },
+
     /* list functions */
     { "builtin::indexed", &XS_builtin_indexed, &ck_builtin_funcN, 0 },
     { 0 }
diff --git a/lib/builtin.pm b/lib/builtin.pm
index d198fe68dd..975c3ef97c 100644
--- a/lib/builtin.pm
+++ b/lib/builtin.pm
@@ -1,4 +1,4 @@
-package builtin 0.004;
+package builtin 0.005;
 
 use strict;
 use warnings;
diff --git a/lib/builtin.t b/lib/builtin.t
index 4a3a7d978f..e601d9ec5b 100644
--- a/lib/builtin.t
+++ b/lib/builtin.t
@@ -94,6 +94,73 @@ package FetchStoreCounter {
     is(blessed(bless [], "0") ? "YES" : "NO", "NO", 'blessed in boolean context handles "0" cornercase');
 }
 
+# created_as_...
+{
+    use builtin qw( created_as_string created_as_number );
+
+    # some literal constants
+    ok(!created_as_string(undef), 'undef created as !string');
+    ok(!created_as_number(undef), 'undef created as !number');
+
+    ok( created_as_string("abc"), 'abc created as string');
+    ok(!created_as_number("abc"), 'abc created as number');
+
+    ok(!created_as_string(123),   '123 created as !string');
+    ok( created_as_number(123),   '123 created as !number');
+
+    ok(!created_as_string(1.23),   '1.23 created as !string');
+    ok( created_as_number(1.23),   '1.23 created as !number');
+
+    ok(!created_as_string([]),    '[] created as !string');
+    ok(!created_as_number([]),    '[] created as !number');
+
+    ok(!created_as_string(builtin::true), 'true created as !string');
+    ok(!created_as_number(builtin::true), 'true created as !number');
+
+    ok(builtin::is_bool(created_as_string(0)), 'created_as_string returns bool');
+    ok(builtin::is_bool(created_as_number(0)), 'created_as_number returns bool');
+
+    # variables
+    my $just_pv = "def";
+    ok( created_as_string($just_pv), 'def created as string');
+    ok(!created_as_number($just_pv), 'def created as number');
+
+    my $just_iv = 456;
+    ok(!created_as_string($just_iv), '456 created as string');
+    ok( created_as_number($just_iv), '456 created as number');
+
+    my $just_nv = 4.56;
+    ok(!created_as_string($just_nv), '456 created as string');
+    ok( created_as_number($just_nv), '456 created as number');
+
+    # variables reused
+    my $originally_pv = "1";
+    my $pv_as_iv = $originally_pv + 0;
+    ok( created_as_string($originally_pv), 'PV reused as IV created as string');
+    ok(!created_as_number($originally_pv), 'PV reused as IV created as !number');
+    ok(!created_as_string($pv_as_iv), 'New number from PV created as !string');
+    ok( created_as_number($pv_as_iv), 'New number from PV created as number');
+
+    my $originally_iv = 1;
+    my $iv_as_pv = "$originally_iv";
+    ok(!created_as_string($originally_iv), 'IV reused as PV created as !string');
+    ok( created_as_number($originally_iv), 'IV reused as PV created as number');
+    ok( created_as_string($iv_as_pv), 'New string from IV created as string');
+    ok(!created_as_number($iv_as_pv), 'New string from IV created as !number');
+
+    my $originally_nv = 1.1;
+    my $nv_as_pv = "$originally_nv";
+    ok(!created_as_string($originally_nv), 'NV reused as PV created as !string');
+    ok( created_as_number($originally_nv), 'NV reused as PV created as number');
+    ok( created_as_string($nv_as_pv), 'New string from NV created as string');
+    ok(!created_as_number($nv_as_pv), 'New string from NV created as !number');
+
+    # magic
+    local $1;
+    "hello" =~ m/(.*)/;
+    ok(created_as_string($1), 'magic string');
+}
+
 # ceil, floor
 {
     use builtin qw( ceil floor );