utf8: add tests for behavior change in v5.15.6-407-gc710240, and more

In v5.15.6-407-gc710240 Father Chrysostomos patched utf8::decode() so it
would call SvPV_force_nolen() on its argument. This meant that calling
utf8::decode() with a non-blessed non-overloaded reference would now
coerce the reference scalar to a string, i.e. before we'd do:

    $ ./perl -Ilib -MDevel::Peek -wle 'use strict; print $]; my $s = shift; my $s_ref = \$s; utf8::decode($s_ref); Dump $s_ref; print $$s_ref' ævar
    5.019011
    SV = IV(0x2579fd8) at 0x2579fe8
      REFCNT = 1
      FLAGS = (PADMY,ROK)
      RV = 0x25c33d8
      SV = PV(0x257ab08) at 0x25c33d8
        REFCNT = 2
        FLAGS = (PADMY,POK,pPOK)
        PV = 0x25a1338 "\303\246var"\0
        CUR = 5
        LEN = 16
    ævar

But after calling SvPV_force_nolen(sv) we'd instead do:

    $ ./perl -Ilib -MDevel::Peek -wle 'use strict; print $]; my $s = shift; my $s_ref = \$s; utf8::decode($s_ref); Dump $s_ref; print $$s_ref' ævar
    5.019011
    SV = PVIV(0x140e4b8) at 0x13e7fe8
      REFCNT = 1
      FLAGS = (PADMY,POK,pPOK)
      IV = 0
      PV = 0x140c578 "SCALAR(0x14313d8)"\0
      CUR = 17
      LEN = 24
    Can't use string ("SCALAR(0x14313d8)") as a SCALAR ref while "strict refs" in use at -e line 1.

I think this is arguably the right thing to do, we wouln't actually utf8
decode the containing scalar so this reveals bugs in code that passed
references to utf8::decode(), what you want is to do this instead:

    $ ./perl -CO -Ilib -MDevel::Peek -wle 'use strict; print $]; my $s = shift; my $s_ref = \$s; utf8::decode($$s_ref); Dump $s_ref; print $$s_ref' ævar
    5.019011
    SV = IV(0x1aa8fd8) at 0x1aa8fe8
      REFCNT = 1
      FLAGS = (PADMY,ROK)
      RV = 0x1af23d8
      SV = PV(0x1aa9b08) at 0x1af23d8
        REFCNT = 2
        FLAGS = (PADMY,POK,pPOK,UTF8)
        PV = 0x1ad0338 "\303\246var"\0 [UTF8 "\x{e6}var"]
        CUR = 5
        LEN = 16
    ævar

However I think we should be more consistent here, e.g. we'll die when
utf8::upgrade() gets passed a reference, but utf8::downgrade() just
passes it through. I'll file a bug for that separately.

diff --git a/lib/utf8.t b/lib/utf8.t
index b81b97b..5c03b31 100644 (file)
--- a/lib/utf8.t
+++ b/lib/utf8.t
@@ -461,6 +461,45 @@ SKIP: {
 }
 
 {
+    # What do the utf8::* functions do when given a reference? A test
+    # for a behavior change that made this start dying as of
+    # v5.15.6-407-gc710240 due to a fix for [perl #91852]:
+    #
+    #    ./miniperl -Ilib -wle 'use strict; print $]; my $s = shift; my $s_ref = \$s; utf8::decode($s_ref); print $$s_ref' hlagh
+    my %expected = (
+        'utf8::is_utf8'           => { returns => "hlagh" },
+        'utf8::valid'             => { returns => "hlagh" },
+        'utf8::encode'            => { error => qr/Can't use string .*? as a SCALAR ref/},
+        'utf8::decode'            => { error => qr/Can't use string .*? as a SCALAR ref/},
+        'utf8::upgrade'           => { error => qr/Can't use string .*? as a SCALAR ref/ },
+        'utf8::downgrade'         => { returns => "hlagh" },
+        'utf8::native_to_unicode' => { returns => "hlagh" },
+        'utf8::unicode_to_native' => { returns => "hlagh" },
+    );
+    for my $func (sort keys %expected) { # sort just so it's deterministic wrt diffing *.t output
+        my $code = sprintf q[
+            use strict;
+            my $s = "hlagh";
+            my $r = \$s;
+            %s($r);
+            $$r;
+        ], $func;
+        my $ret = eval $code or my $error = $@;
+        if (my $error_rx = $expected{$func}->{error}) {
+            if (defined $error) {
+                like $error, $error_rx, "The $func function should die with an error matching $error_rx";
+            } else {
+                fail("We were expecting an error when calling the $func function but got a value of '$ret' instead");
+            }
+        } elsif (my $returns = $expected{$func}->{returns}) {
+            is($ret, $returns, "The $func function lives and returns '$returns' as expected");
+        } else {
+            die "PANIC: Internal Error"
+        }
+    }
+}
+
+{
     my $a = "456\xb6";
     utf8::upgrade($a);