This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add a parameter to a static function
authorKarl Williamson <khw@cpan.org>
Fri, 19 Feb 2016 04:43:14 +0000 (21:43 -0700)
committerKarl Williamson <khw@cpan.org>
Fri, 19 Feb 2016 17:41:43 +0000 (10:41 -0700)
This parameter will be used in a future commit, it changes the output
format of this function that displays the contents of an inversion list
so that it won't have to be parsed later, simplifying the code at that
time.

embed.fnc
embed.h
proto.h
regcomp.c

index af46247..ab881ab 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1539,7 +1539,8 @@ EiMn      |void   |invlist_iterfinish|NN SV* invlist
 EiMRn  |UV     |invlist_highest|NN SV* const invlist
 EMRs   |SV*    |_make_exactf_invlist   |NN RExC_state_t *pRExC_state \
                                        |NN regnode *node
-EsMR   |SV*    |invlist_contents|NN SV* const invlist
+EsMR   |SV*    |invlist_contents|NN SV* const invlist              \
+                                |const bool traditional_style
 #endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_UTF8_C)
 EXmM   |void   |_invlist_intersection  |NN SV* const a|NN SV* const b|NN SV** i
diff --git a/embed.h b/embed.h
index 8a935f2..fa8f0f9 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define handle_possible_posix(a,b,c,d) S_handle_possible_posix(aTHX_ a,b,c,d)
 #define handle_regex_sets(a,b,c,d,e)   S_handle_regex_sets(aTHX_ a,b,c,d,e)
 #define invlist_clone(a)       S_invlist_clone(aTHX_ a)
-#define invlist_contents(a)    S_invlist_contents(aTHX_ a)
+#define invlist_contents(a,b)  S_invlist_contents(aTHX_ a,b)
 #define invlist_extend(a,b)    S_invlist_extend(aTHX_ a,b)
 #define invlist_highest                S_invlist_highest
 #define invlist_is_iterating   S_invlist_is_iterating
diff --git a/proto.h b/proto.h
index e9ed8ac..232086d 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4745,7 +4745,7 @@ PERL_STATIC_INLINE SV*    S_invlist_clone(pTHX_ SV* const invlist)
 #define PERL_ARGS_ASSERT_INVLIST_CLONE \
        assert(invlist)
 
-STATIC SV*     S_invlist_contents(pTHX_ SV* const invlist)
+STATIC SV*     S_invlist_contents(pTHX_ SV* const invlist, const bool traditional_style)
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_INVLIST_CONTENTS      \
        assert(invlist)
index 3f4c015..b3ac045 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -9514,14 +9514,25 @@ S_invlist_highest(SV* const invlist)
 }
 
 SV *
-S_invlist_contents(pTHX_ SV* const invlist)
+S_invlist_contents(pTHX_ SV* const invlist, const bool traditional_style)
 {
     /* Get the contents of an inversion list into a string SV so that they can
-     * be printed out.  It uses the format traditionally done for debug tracing
-     */
+     * be printed out.  If 'traditional_style' is TRUE, it uses the format
+     * traditionally done for debug tracing; otherwise it uses a format
+     * suitable for just copying to the output, with blanks between ranges and
+     * a dash between range components */
 
     UV start, end;
-    SV* output = newSVpvs("\n");
+    SV* output;
+    const char intra_range_delimiter = (traditional_style ? '\t' : '-');
+    const char inter_range_delimiter = (traditional_style ? '\n' : ' ');
+
+    if (traditional_style) {
+        output = newSVpvs("\n");
+    }
+    else {
+        output = newSVpvs("");
+    }
 
     PERL_ARGS_ASSERT_INVLIST_CONTENTS;
 
@@ -9530,17 +9541,26 @@ S_invlist_contents(pTHX_ SV* const invlist)
     invlist_iterinit(invlist);
     while (invlist_iternext(invlist, &start, &end)) {
        if (end == UV_MAX) {
-           Perl_sv_catpvf(aTHX_ output, "%04"UVXf"\tINFINITY\n", start);
+           Perl_sv_catpvf(aTHX_ output, "%04"UVXf"%cINFINITY%c",
+                                          start, intra_range_delimiter,
+                                                 inter_range_delimiter);
        }
        else if (end != start) {
-           Perl_sv_catpvf(aTHX_ output, "%04"UVXf"\t%04"UVXf"\n",
-                   start,       end);
+           Perl_sv_catpvf(aTHX_ output, "%04"UVXf"%c%04"UVXf"%c",
+                                         start,
+                                                   intra_range_delimiter,
+                                                  end, inter_range_delimiter);
        }
        else {
-           Perl_sv_catpvf(aTHX_ output, "%04"UVXf"\n", start);
+           Perl_sv_catpvf(aTHX_ output, "%04"UVXf"%c",
+                                          start, inter_range_delimiter);
        }
     }
 
+    if (SvCUR(output) && ! traditional_style) {/* Get rid of trailing blank */
+        SvCUR_set(output, SvCUR(output) - 1);
+    }
+
     return output;
 }
 
@@ -17533,11 +17553,11 @@ Perl__get_regclass_nonbitmap_data(pTHX_ const regexp *prog,
             if (exclude_list) {
                 SV* clone = invlist_clone(invlist);
                 _invlist_subtract(clone, exclude_list, &clone);
-                sv_catsv(matches_string, invlist_contents(clone));
+                sv_catsv(matches_string, invlist_contents(clone, TRUE));
                 SvREFCNT_dec_NN(clone);
             }
             else {
-                sv_catsv(matches_string, invlist_contents(invlist));
+                sv_catsv(matches_string, invlist_contents(invlist, TRUE));
             }
        }
        *listsvp = matches_string;