UTF8f
authorFather Chrysostomos <sprout@cpan.org>
Tue, 18 Jun 2013 20:40:18 +0000 (13:40 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 18 Jun 2013 20:40:50 +0000 (13:40 -0700)
This new format string allows char*s to be interpolated with the
utf8ness and length specified as well:

Perl_croak(aTHX_ "Couldn't twiggle the twoggle in \"%"UTF8f"\"",
                  is_utf8, len, s);

This commit changes one function call in gv.c to use UTF8f (it should
go faster now) as an example of its use.

This was brought up in ticket #113824.  This commit does not fix
#113824, but provides groundwork that makes it easier to fix.

gv.c
perl.h
sv.c
t/porting/diag.t

index b89181e..eeeb245 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1043,10 +1043,10 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
                }
 
                Perl_croak(aTHX_
-                          "Can't locate object method \"%"SVf"\" via package \"%"SVf"\""
+                          "Can't locate object method \"%"UTF8f
+                          "\" via package \"%"SVf"\""
                           " (perhaps you forgot to load \"%"SVf"\"?)",
-                          SVfARG(newSVpvn_flags(name, nend - name,
-                                SVs_TEMP | is_utf8)),
+                          is_utf8, nend - name, name,
                            SVfARG(packnamesv), SVfARG(packnamesv));
            }
        }
diff --git a/perl.h b/perl.h
index 613fd3c..df24486 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3038,6 +3038,11 @@ typedef pthread_key_t    perl_key;
 
 #define HEKfARG(p) ((void*)(p))
 
+/* Takes three arguments: is_utf8, length, str */
+#ifndef UTF8f
+#  define UTF8f "u%"UVuf"%4p"
+#endif
+
 #ifdef PERL_CORE
 /* not used; but needed for backward compatibility with XS code? - RMB */
 #  undef VDf
diff --git a/sv.c b/sv.c
index 4cd318d..52af1d2 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -10477,7 +10477,8 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                %-<num>p        include an SV with precision <num>      
                %2p             include a HEK
                %3p             include a HEK with precision of 256
-               %<num>p         (where num != 2 or 3) reserved for future
+               %4p             char* preceded by utf8 flag and length
+               %<num>p         (where num is 1 or > 4) reserved for future
                                extensions
 
        Robin Barker 2005-07-14 (but modified since)
@@ -10489,6 +10490,13 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            STRLEN n = 0;
            if (*q == '-')
                sv = *q++;
+           else if (strnEQ(q, UTF8f, sizeof(UTF8f)-1)) { /* UTF8f */
+               is_utf8 = cBOOL(va_arg(*args, UV));
+               elen = va_arg(*args, STRLEN);
+               eptr = va_arg(*args, char *);
+               q += sizeof(UTF8f)-1;
+               goto string;
+           }
            n = expect_number(&q);
            if (*q++ == 'p') {
                if (sv) {                       /* SVf */
index dc9a688..3315433 100644 (file)
@@ -162,6 +162,7 @@ my %specialformats = (IVdf => 'd',
                      NVgf => 'f',
                      HEKf256=>'s',
                      HEKf => 's',
+                     UTF8f=> 's',
                      SVf256=>'s',
                      SVf32=> 's',
                      SVf  => 's');