This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
utf8.c: Extract some code into macros
authorKarl Williamson <khw@cpan.org>
Tue, 8 Dec 2015 18:19:40 +0000 (11:19 -0700)
committerKarl Williamson <khw@cpan.org>
Wed, 9 Dec 2015 02:01:28 +0000 (19:01 -0700)
This is in preparation for a future commit, where they will be used in
more than one place.

utf8.c

diff --git a/utf8.c b/utf8.c
index 7834023..5766d79 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -103,6 +103,29 @@ For details, see the description for L</uvchr_to_utf8_flags>.
 =cut
 */
 
+#define HANDLE_UNICODE_SURROGATE(uv, flags)                         \
+    STMT_START {                                                    \
+        if (flags & UNICODE_WARN_SURROGATE) {                       \
+            Perl_ck_warner_d(aTHX_ packWARN(WARN_SURROGATE),        \
+                                "UTF-16 surrogate U+%04"UVXf, uv);  \
+        }                                                           \
+        if (flags & UNICODE_DISALLOW_SURROGATE) {                   \
+            return NULL;                                            \
+        }                                                           \
+    } STMT_END;
+
+#define HANDLE_UNICODE_NONCHAR(uv, flags)                           \
+    STMT_START {                                                    \
+        if (flags & UNICODE_WARN_NONCHAR) {                         \
+            Perl_ck_warner_d(aTHX_ packWARN(WARN_NONCHAR),          \
+                "Unicode non-character U+%04"UVXf" is not "        \
+                 "recommended for open interchange", uv);           \
+        }                                                           \
+        if (flags & UNICODE_DISALLOW_NONCHAR) {                     \
+            return NULL;                                            \
+        }                                                           \
+    } STMT_END;
+
 U8 *
 Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
 {
@@ -120,14 +143,11 @@ Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
 
     /* The first problematic code point is the first surrogate */
         if (uv >= UNICODE_SURROGATE_FIRST) {
-            if (UNLIKELY(UNICODE_IS_SURROGATE(uv))) {
-                if (flags & UNICODE_WARN_SURROGATE) {
-                    Perl_ck_warner_d(aTHX_ packWARN(WARN_SURROGATE),
-                                                "UTF-16 surrogate U+%04"UVXf, uv);
-                }
-                if (flags & UNICODE_DISALLOW_SURROGATE) {
-                    return NULL;
-                }
+            if (UNLIKELY(UNICODE_IS_NONCHAR(uv))) {
+                HANDLE_UNICODE_NONCHAR(uv, flags);
+            }
+            else if (UNLIKELY(UNICODE_IS_SURROGATE(uv))) {
+                HANDLE_UNICODE_SURROGATE(uv, flags);
             }
     else if (UNLIKELY(UNICODE_IS_SUPER(uv))) {
         if (   UNLIKELY(uv > MAX_NON_DEPRECATED_CP)
@@ -155,16 +175,6 @@ Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
             return NULL;
         }
     }
-    else if (UNLIKELY(UNICODE_IS_NONCHAR(uv))) {
-        if (flags & UNICODE_WARN_NONCHAR) {
-            Perl_ck_warner_d(aTHX_ packWARN(WARN_NONCHAR),
-             "Unicode non-character U+%04"UVXf" is not recommended for open interchange",
-             uv);
-        }
-        if (flags & UNICODE_DISALLOW_NONCHAR) {
-            return NULL;
-        }
-    }
     }
 
 #if defined(EBCDIC)