HEKf format

2 files changed, 17 insertions, 2 deletions

diff --git a/perl.h b/perl.h
index 200fd82297..accb96bdd7 100644
--- a/perl.h
+++ b/perl.h
@@ -3208,6 +3208,12 @@ typedef pthread_key_t	perl_key;
 
 #define SVfARG(p) ((void*)(p))
 
+#ifndef HEKf
+#  define HEKf "2p"
+#endif
+
+#define HEKfARG(p) ((void*)(p))
+
 #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 e6323b9135..c8e3c02dff 100644
--- a/sv.c
+++ b/sv.c
@@ -10174,9 +10174,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 		%p		include pointer address (standard)	
 		%-p	(SVf)	include an SV (previously %_)
 		%-<num>p	include an SV with precision <num>	
-		%<num>p		reserved for future extensions
+		%2p		include a HEK
+		%<num>p		(where num != 2) reserved for future
+				extensions
 
-	Robin Barker 2005-07-14
+	Robin Barker 2005-07-14 (but modified since)
 
 		%1p	(VDf)	removed.  RMB 2007-10-19
 */
@@ -10198,6 +10200,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 			is_utf8 = TRUE;
 		    goto string;
 		}
+		else if (n==2) {		/* HEKf */
+		    HEK * const hek = va_arg(*args, HEK *);
+		    eptr = HEK_KEY(hek);
+		    elen = HEK_LEN(hek);
+		    if (HEK_UTF8(hek)) is_utf8 = TRUE;
+		    goto string; /* no modifiers supported */
+		}
 		else if (n) {
 		    Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
 				     "internal %%<num>p might conflict with future printf extensions");