This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
embed.fnc: 'm' and 'p' flags don't make sense together
authorKarl Williamson <khw@cpan.org>
Sat, 14 Sep 2019 20:26:05 +0000 (14:26 -0600)
committerKarl Williamson <khw@cpan.org>
Sun, 15 Sep 2019 16:39:56 +0000 (10:39 -0600)
This is a macro, so doesn't have a Perl_ long form function call.
Also forbid 'm' and 'S', but there weren't any current uses of that.

embed.fnc
proto.h
regen/embed.pl

index 1f481a7..f5bd7a4 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -661,7 +661,7 @@ Ap  |bool   |do_close       |NULLOK GV* gv|bool not_implicit
 p      |bool   |do_eof         |NN GV* gv
 
 #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
-pm     |bool|do_exec   |NN const char* cmd
+pM     |bool|do_exec   |NN const char* cmd
 #else
 p      |bool|do_exec   |NN const char* cmd
 #endif
@@ -1023,7 +1023,7 @@ EXTp      |UV        |_to_fold_latin1|const U8 c|NN U8 *p|NN STRLEN *lenp|const unsig
 p      |UV     |_to_upper_title_latin1|const U8 c|NN U8 *p|NN STRLEN *lenp|const char S_or_s
 #endif
 Cp     |UV     |to_uni_lower   |UV c|NN U8 *p|NN STRLEN *lenp
-Cmp    |UV     |to_uni_fold    |UV c|NN U8 *p|NN STRLEN *lenp
+Cm     |UV     |to_uni_fold    |UV c|NN U8 *p|NN STRLEN *lenp
 Cp     |UV     |_to_uni_fold_flags|UV c|NN U8 *p|NN STRLEN *lenp|U8 flags
 CbDpR  |bool   |is_uni_alnum_lc|UV c
 CbDpR  |bool   |is_uni_alnumc_lc|UV c
@@ -1670,7 +1670,7 @@ Apda      |char*  |savesharedsvpv |NN SV *sv
 Apda   |char*  |savesvpv       |NN SV* sv
 Ap     |void   |savestack_grow
 Ap     |void   |savestack_grow_cnt     |I32 need
-Amp    |void   |save_aelem     |NN AV* av|SSize_t idx|NN SV **sptr
+Am     |void   |save_aelem     |NN AV* av|SSize_t idx|NN SV **sptr
 Ap     |void   |save_aelem_flags|NN AV* av|SSize_t idx|NN SV **sptr \
                                 |const U32 flags
 Ap     |I32    |save_alloc     |I32 size|I32 pad
@@ -1693,7 +1693,7 @@ Ap        |void   |save_shared_pvref|NN char** str
 Adp    |void   |save_gp        |NN GV* gv|I32 empty
 Apdh   |HV*    |save_hash      |NN GV* gv
 Ap     |void   |save_hints
-Amp    |void   |save_helem     |NN HV *hv|NN SV *key|NN SV **sptr
+Am     |void   |save_helem     |NN HV *hv|NN SV *key|NN SV **sptr
 Ap     |void   |save_helem_flags|NN HV *hv|NN SV *key|NN SV **sptr|const U32 flags
 Apdh   |void   |save_hptr      |NN HV** hptr
 Ap     |void   |save_I16       |NN I16* intp
@@ -3185,7 +3185,7 @@ Amd       |STRLEN |sv_utf8_upgrade_flags|NN SV *const sv|const I32 flags
 Adp    |STRLEN |sv_utf8_upgrade_flags_grow|NN SV *const sv|const I32 flags|STRLEN extra
 Apd    |char*  |sv_pvn_force_flags|NN SV *const sv|NULLOK STRLEN *const lp|const I32 flags
 AdpMb  |void   |sv_copypv      |NN SV *const dsv|NN SV *const ssv
-Apmd   |void   |sv_copypv_nomg |NN SV *const dsv|NN SV *const ssv
+Amd    |void   |sv_copypv_nomg |NN SV *const dsv|NN SV *const ssv
 Apd    |void   |sv_copypv_flags        |NN SV *const dsv|NN SV *const ssv|const I32 flags
 Cpo    |char*  |my_atof2       |NN const char *orig|NN NV* value
 Cp     |char*  |my_atof3       |NN const char *orig|NN NV* value|const STRLEN len
diff --git a/proto.h b/proto.h
index 85ca5d0..fe9b9a0 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3321,7 +3321,7 @@ PERL_CALLCONV void        Perl_save_I8(pTHX_ I8* bytep);
 PERL_CALLCONV void     Perl_save_adelete(pTHX_ AV *av, SSize_t key);
 #define PERL_ARGS_ASSERT_SAVE_ADELETE  \
        assert(av)
-/* PERL_CALLCONV void  Perl_save_aelem(pTHX_ AV* av, SSize_t idx, SV **sptr); */
+/* PERL_CALLCONV void  save_aelem(pTHX_ AV* av, SSize_t idx, SV **sptr); */
 #define PERL_ARGS_ASSERT_SAVE_AELEM
 PERL_CALLCONV void     Perl_save_aelem_flags(pTHX_ AV* av, SSize_t idx, SV **sptr, const U32 flags);
 #define PERL_ARGS_ASSERT_SAVE_AELEM_FLAGS      \
@@ -3375,7 +3375,7 @@ PERL_CALLCONV HV* Perl_save_hash(pTHX_ GV* gv);
 PERL_CALLCONV void     Perl_save_hdelete(pTHX_ HV *hv, SV *keysv);
 #define PERL_ARGS_ASSERT_SAVE_HDELETE  \
        assert(hv); assert(keysv)
-/* PERL_CALLCONV void  Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr); */
+/* PERL_CALLCONV void  save_helem(pTHX_ HV *hv, SV *key, SV **sptr); */
 #define PERL_ARGS_ASSERT_SAVE_HELEM
 PERL_CALLCONV void     Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags);
 #define PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS      \
@@ -3746,7 +3746,7 @@ PERL_CALLCONV void        Perl_sv_copypv(pTHX_ SV *const dsv, SV *const ssv);
 PERL_CALLCONV void     Perl_sv_copypv_flags(pTHX_ SV *const dsv, SV *const ssv, const I32 flags);
 #define PERL_ARGS_ASSERT_SV_COPYPV_FLAGS       \
        assert(dsv); assert(ssv)
-/* PERL_CALLCONV void  Perl_sv_copypv_nomg(pTHX_ SV *const dsv, SV *const ssv); */
+/* PERL_CALLCONV void  sv_copypv_nomg(pTHX_ SV *const dsv, SV *const ssv); */
 #define PERL_ARGS_ASSERT_SV_COPYPV_NOMG
 PERL_CALLCONV void     Perl_sv_dec(pTHX_ SV *const sv);
 #define PERL_ARGS_ASSERT_SV_DEC
@@ -4246,7 +4246,7 @@ PERL_CALLCONV OP *        Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv, c
        assert(methname); assert(sp); assert(sv); assert(mg)
 PERL_CALLCONV SSize_t  Perl_tmps_grow_p(pTHX_ SSize_t ix);
 #define PERL_ARGS_ASSERT_TMPS_GROW_P
-/* PERL_CALLCONV UV    Perl_to_uni_fold(pTHX_ UV c, U8 *p, STRLEN *lenp); */
+/* PERL_CALLCONV UV    to_uni_fold(pTHX_ UV c, U8 *p, STRLEN *lenp); */
 #define PERL_ARGS_ASSERT_TO_UNI_FOLD
 PERL_CALLCONV UV       Perl_to_uni_lower(pTHX_ UV c, U8 *p, STRLEN *lenp);
 #define PERL_ARGS_ASSERT_TO_UNI_LOWER  \
@@ -5193,8 +5193,9 @@ PERL_CALLCONV OP *        Perl_op_refcnt_inc(pTHX_ OP *o);
 #define PERL_ARGS_ASSERT_OP_REFCNT_INC
 #endif
 #if defined(PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION)
-/* PERL_CALLCONV bool  Perl_do_exec(pTHX_ const char* cmd); */
-#define PERL_ARGS_ASSERT_DO_EXEC
+PERL_CALLCONV bool     Perl_do_exec(pTHX_ const char* cmd);
+#define PERL_ARGS_ASSERT_DO_EXEC       \
+       assert(cmd)
 #endif
 #if defined(PERL_DONT_CREATE_GVSV)
 #ifndef NO_MATHOMS
index a5570d1..8546051 100755 (executable)
@@ -101,7 +101,9 @@ my ($embed, $core, $ext, $api) = setup_embed();
        }
 
        die_at_end "$plain_func: S flag is mutually exclusive from the i and p plags"
-                                           if $flags =~ /S/ && $flags =~ /[ip]/;
+                                       if $flags =~ /S/ && $flags =~ /([ip])/;
+       die_at_end "$plain_func: m and $1 flags are mutually exclusive"
+                                       if $flags =~ /m/ && $flags =~ /([pS])/;
 
        die_at_end "$plain_func: u flag only usable with m" if $flags =~ /u/ && $flags !~ /m/;