diff options
| -rwxr-xr-x | cflags.SH | 4 | ||||
| -rw-r--r-- | dump.c | 5 | ||||
| -rw-r--r-- | ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm | 3 | ||||
| -rw-r--r-- | gv.c | 7 | ||||
| -rw-r--r-- | inline.h | 27 | ||||
| -rw-r--r-- | mg.c | 4 | ||||
| -rw-r--r-- | miniperlmain.c | 1 | ||||
| -rw-r--r-- | op.c | 16 | ||||
| -rw-r--r-- | perl.h | 2 | ||||
| -rw-r--r-- | pp.c | 26 | ||||
| -rw-r--r-- | pp_ctl.c | 7 | ||||
| -rw-r--r-- | pp_pack.c | 14 | ||||
| -rw-r--r-- | pp_sys.c | 3 | ||||
| -rw-r--r-- | regcomp.c | 8 | ||||
| -rw-r--r-- | regexec.c | 3 | ||||
| -rw-r--r-- | regexp.h | 31 | ||||
| -rw-r--r-- | sv.c | 8 | ||||
| -rw-r--r-- | toke.c | 5 | ||||
| -rw-r--r-- | utf8.c | 2 |
19 files changed, 85 insertions, 91 deletions
@@ -176,6 +176,10 @@ Intel*) ;; # # Is that you, Intel C++? esac rm -f _cflags.c _cflags$_exe +# XXX There is something wrong in the below: furious editing on ccflags, +# but that ccflags will be overwritten by the source of config.sh in the +# extracted cflags. + case "$gccversion" in '') ;; *) @@ -2379,6 +2379,7 @@ I32 Perl_debop(pTHX_ const OP *o) { dVAR; + int count; PERL_ARGS_ASSERT_DEBOP; @@ -2410,9 +2411,6 @@ Perl_debop(pTHX_ const OP *o) PerlIO_printf(Perl_debug_log, "(NULL)"); break; - { - int count; - case OP_PADSV: case OP_PADAV: case OP_PADHV: @@ -2446,7 +2444,6 @@ Perl_debop(pTHX_ const OP *o) PerlIO_printf(Perl_debug_log, ")"); } break; - } default: break; diff --git a/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm b/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm index cede3180f8..99276fc4c7 100644 --- a/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm +++ b/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm @@ -8,7 +8,7 @@ use vars qw($VERSION @ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(writemain); -$VERSION = '1.01'; +$VERSION = '1.02'; # blead will run this with miniperl, hence we can't use autodie or File::Temp my $temp; @@ -191,7 +191,6 @@ main(int argc, char **argv, char **env) #endif /* PERL_GLOBAL_STRUCT */ exit(exitstatus); - return exitstatus; } /* Register any extra external extensions */ @@ -352,7 +352,7 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag case SVt_PVIO: Perl_croak(aTHX_ "Cannot convert a reference to %s to typeglob", sv_reftype(has_constant, 0)); - break; + default: NOOP; } SvRV_set(gv, NULL); @@ -2969,7 +2969,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) case regexp_amg: /* FAIL safe */ return NULL; /* Delegate operation to standard mechanisms. */ - break; + case to_sv_amg: case to_av_amg: case to_hv_amg: @@ -2977,7 +2977,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) case to_cv_amg: /* FAIL safe */ return left; /* Delegate operation to standard mechanisms. */ - break; + default: goto not_found; } @@ -3044,7 +3044,6 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) case to_cv_amg: /* FAIL safe */ return left; /* Delegate operation to standard mechanisms. */ - break; } if (ocvp && (cv=ocvp[nomethod_amg])) { /* Call report method */ notfound = 1; lr = -1; @@ -320,6 +320,33 @@ S_should_warn_nl(const char *pv) { #endif +/* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */ + +#define MAX_CHARSET_NAME_LENGTH 2 + +PERL_STATIC_INLINE const char * +get_regex_charset_name(const U32 flags, STRLEN* const lenp) +{ + /* Returns a string that corresponds to the name of the regex character set + * given by 'flags', and *lenp is set the length of that string, which + * cannot exceed MAX_CHARSET_NAME_LENGTH characters */ + + *lenp = 1; + switch (get_regex_charset(flags)) { + case REGEX_DEPENDS_CHARSET: return DEPENDS_PAT_MODS; + case REGEX_LOCALE_CHARSET: return LOCALE_PAT_MODS; + case REGEX_UNICODE_CHARSET: return UNICODE_PAT_MODS; + case REGEX_ASCII_RESTRICTED_CHARSET: return ASCII_RESTRICT_PAT_MODS; + case REGEX_ASCII_MORE_RESTRICTED_CHARSET: + *lenp = 2; + return ASCII_MORE_RESTRICT_PAT_MODS; + } + /* The NOT_REACHED; hides an assert() which has a rather complex + * definition in perl.h. */ + NOT_REACHED; /* NOTREACHED */ + return "?"; /* Unknown */ +} + /* * Local variables: * c-indentation-style: bsd @@ -348,9 +348,9 @@ Perl_mg_size(pTHX_ SV *sv) /* FIXME */ default: Perl_croak(aTHX_ "Size magic not implemented"); - break; + } - return 0; + NOT_REACHED; /* NOTREACHED */ } /* diff --git a/miniperlmain.c b/miniperlmain.c index f22dcbba8d..e748523414 100644 --- a/miniperlmain.c +++ b/miniperlmain.c @@ -162,7 +162,6 @@ main(int argc, char **argv, char **env) #endif /* PERL_GLOBAL_STRUCT */ exit(exitstatus); - return exitstatus; } /* Register any extra external extensions */ @@ -1071,7 +1071,6 @@ Perl_op_contextualize(pTHX_ OP *o, I32 context) default: Perl_croak(aTHX_ "panic: op_contextualize bad context %ld", (long) context); - return o; } } @@ -9818,7 +9817,7 @@ Perl_rv2cv_op_cv(pTHX_ OP *cvop, U32 flags) } break; default: { return NULL; - } break; + } NOT_REACHED; /* NOTREACHED */ } if (SvTYPE((SV*)cv) != SVt_PVCV) return NULL; @@ -9995,7 +9994,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) break; case '[': case ']': goto oops; - break; + case '\\': proto++; arg++; @@ -10010,7 +10009,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) else goto oops; goto again; - break; + case ']': if (contextclass) { const char *p = proto; @@ -10704,6 +10703,8 @@ Perl_rpeep(pTHX_ OP *o) OP** defer_queue[MAX_DEFERRED]; /* small queue of deferred branches */ int defer_base = 0; int defer_ix = -1; + OP *fop; + OP *sop; if (!o || o->op_opt) return; @@ -11277,10 +11278,6 @@ Perl_rpeep(pTHX_ OP *o) break; - { - OP *fop; - OP *sop; - #define HV_OR_SCALARHV(op) \ ( (op)->op_type == OP_PADHV || (op)->op_type == OP_RV2HV \ ? (op) \ @@ -11366,8 +11363,7 @@ Perl_rpeep(pTHX_ OP *o) if ((fop = HV_OR_SCALARHV(cLOGOP->op_first))) fop->op_private |= OPpTRUEBOOL; #undef HV_OR_SCALARHV - /* GERONIMO! */ - } + /* GERONIMO! */ /* FALLTHROUGH */ case OP_MAPWHILE: case OP_GREPWHILE: @@ -3781,6 +3781,8 @@ Gid_t getegid (void); "\", line %d", STRINGIFY(what), __LINE__), \ (void) 0))) +/* assert() gets defined if DEBUGGING (and I_ASSERT). + * If no DEBUGGING, the <assert.h> has not been included. */ #ifndef assert # define assert(what) Perl_assert(what) #endif @@ -226,8 +226,9 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict, SvREFCNT_inc_void_NN(sv); sv = MUTABLE_SV(gv); } - else if (!isGV_with_GP(sv)) - return (SV *)Perl_die(aTHX_ "Not a GLOB reference"); + else if (!isGV_with_GP(sv)) { + Perl_die(aTHX_ "Not a GLOB reference"); + } } else { if (!isGV_with_GP(sv)) { @@ -257,8 +258,9 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict, SvSETMAGIC(sv); goto wasref; } - if (PL_op->op_flags & OPf_REF || strict) - return (SV *)Perl_die(aTHX_ PL_no_usym, "a symbol"); + if (PL_op->op_flags & OPf_REF || strict) { + Perl_die(aTHX_ PL_no_usym, "a symbol"); + } if (ckWARN(WARN_UNINITIALIZED)) report_uninit(sv); return &PL_sv_undef; @@ -271,14 +273,14 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict, return &PL_sv_undef; } else { - if (strict) - return - (SV *)Perl_die(aTHX_ - S_no_symref_sv, - sv, - (SvPOKp(sv) && SvCUR(sv)>32 ? "..." : ""), - "a symbol" - ); + if (strict) { + Perl_die(aTHX_ + S_no_symref_sv, + sv, + (SvPOKp(sv) && SvCUR(sv)>32 ? "..." : ""), + "a symbol" + ); + } if ((PL_op->op_private & (OPpLVAL_INTRO|OPpDONT_INIT_GV)) == OPpDONT_INIT_GV) { /* We are the target of a coderef assignment. Return @@ -1357,9 +1357,8 @@ Perl_block_gimme(pTHX) return G_ARRAY; default: Perl_croak(aTHX_ "panic: bad gimme: %d\n", cxstack[cxix].blk_gimme); - assert(0); /* NOTREACHED */ - return 0; } + NOT_REACHED; /* NOTREACHED */ } I32 @@ -4336,8 +4335,8 @@ PP(pp_leaveeval) SvPVX_const(namesv), SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv), G_DISCARD); - retop = Perl_die(aTHX_ "%"SVf" did not return a true value", - SVfARG(namesv)); + Perl_die(aTHX_ "%"SVf" did not return a true value", SVfARG(namesv)); + NOT_REACHED; /* NOTREACHED */ /* die_unwind() did LEAVE, or we won't be here */ } else { @@ -448,7 +448,7 @@ S_measure_struct(pTHX_ tempsym_t* symptr) case e_star: Perl_croak(aTHX_ "Within []-length '*' not allowed in %s", _action( symptr ) ); - break; + default: /* e_no_len and e_number */ len = symptr->length; @@ -567,7 +567,7 @@ S_group_end(pTHX_ const char *patptr, const char *patend, char ender) } Perl_croak(aTHX_ "No group ending character '%c' found in template", ender); - return 0; + NOT_REACHED; /* NOTREACHED */ } @@ -934,7 +934,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c cuv = 0; cdouble = 0; continue; - break; + case '(': { tempsym_t savsym = *symptr; @@ -1060,7 +1060,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c break; case '/': Perl_croak(aTHX_ "'/' must follow a numeric type in unpack"); - break; + case 'A': case 'Z': case 'a': @@ -2083,6 +2083,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) bool found = next_symbol(symptr); bool utf8 = (symptr->flags & FLAG_PARSE_UTF8) ? 1 : 0; bool warn_utf8 = ckWARN(WARN_UTF8); + char* from; PERL_ARGS_ASSERT_PACK_REC; @@ -2163,8 +2164,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) (int) TYPE_NO_MODIFIERS(datumtype)); case '%': Perl_croak(aTHX_ "'%%' may not be used in pack"); - { - char *from; + case '.' | TYPE_IS_SHRIEKING: case '.': if (howlen == e_star) from = start; @@ -2213,7 +2213,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) goto shrink; } break; - } + case '(': { tempsym_t savsym = *symptr; U32 group_modifiers = TYPE_MODIFIERS(datumtype & ~symptr->flags); @@ -519,7 +519,8 @@ PP(pp_die) exsv = newSVpvs_flags("Died", SVs_TEMP); } } - return die_sv(exsv); + die_sv(exsv); + NOT_REACHED; /* NOTREACHED */ } /* I/O. */ @@ -9472,6 +9472,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) bool is_open = 0; I32 freeze_paren = 0; I32 after_freeze = 0; + I32 num; /* numeric backreferences */ char * parse_start = RExC_parse; /* MJD */ char * const oregcomp_parse = RExC_parse; @@ -9789,8 +9790,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) nextchar(pRExC_state); return ret; /*notreached*/ - { /* named and numeric backreferences */ - I32 num; + /* named and numeric backreferences */ case '&': /* (?&NAME) */ parse_start = RExC_parse - 1; named_recursion: @@ -9872,7 +9872,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) *flagp |= POSTPONED; nextchar(pRExC_state); return ret; - } /* named and numeric backreferences */ + assert(0); /* NOT REACHED */ case '?': /* (??...) */ @@ -11245,6 +11245,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) char *parse_start = RExC_parse; U8 op; int invert = 0; + U8 arg; GET_RE_DEBUG_FLAGS_DECL; @@ -11361,7 +11362,6 @@ tryagain: literal text handling code. */ switch ((U8)*++RExC_parse) { - U8 arg; /* Special Escapes */ case 'A': RExC_seen_zerolen++; @@ -2258,7 +2258,6 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, break; default: Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c)); - break; } return 0; got_it: @@ -2455,7 +2454,6 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, /* Be paranoid... */ if (prog == NULL || stringarg == NULL) { Perl_croak(aTHX_ "NULL regexp parameter"); - return 0; } DEBUG_EXECUTE_r( @@ -4618,7 +4616,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) break; default: Perl_croak(aTHX_ "panic: Unexpected FLAGS %u in op %u", FLAGS(scan), OP(scan)); - break; } } /* Note requires that all BOUNDs be lower than all NBOUNDs in @@ -355,37 +355,6 @@ and check for NULL. # error "RXf_SPLIT does not match RXf_PMf_SPLIT" #endif -/* Manually decorate this function with gcc-style attributes just to - * avoid having to restructure the header files and their called order, - * as proto.h would have to be included before this file, and isn't */ - -PERL_STATIC_INLINE const char * -get_regex_charset_name(const U32 flags, STRLEN* const lenp) - __attribute__warn_unused_result__; - -#define MAX_CHARSET_NAME_LENGTH 2 - -PERL_STATIC_INLINE const char * -get_regex_charset_name(const U32 flags, STRLEN* const lenp) -{ - /* Returns a string that corresponds to the name of the regex character set - * given by 'flags', and *lenp is set the length of that string, which - * cannot exceed MAX_CHARSET_NAME_LENGTH characters */ - - *lenp = 1; - switch (get_regex_charset(flags)) { - case REGEX_DEPENDS_CHARSET: return DEPENDS_PAT_MODS; - case REGEX_LOCALE_CHARSET: return LOCALE_PAT_MODS; - case REGEX_UNICODE_CHARSET: return UNICODE_PAT_MODS; - case REGEX_ASCII_RESTRICTED_CHARSET: return ASCII_RESTRICT_PAT_MODS; - case REGEX_ASCII_MORE_RESTRICTED_CHARSET: - *lenp = 2; - return ASCII_MORE_RESTRICT_PAT_MODS; - default: - return "?"; /* Unknown */ - } -} - /* Do we have some sort of anchor? */ #define RXf_IS_ANCHORED (1<<(RXf_BASE_SHIFT+0)) #define RXf_UNUSED1 (1<<(RXf_BASE_SHIFT+1)) @@ -4215,7 +4215,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) else Perl_croak(aTHX_ "Bizarre copy of %s", type); } - break; + NOT_REACHED; /* NOTREACHED */ case SVt_REGEXP: upgregexp: @@ -11346,10 +11346,10 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p { char *ptr = ebuf + sizeof ebuf; bool tempalt = uv ? alt : FALSE; /* Vectors can't change alt */ + unsigned dig; zeros = 0; switch (base) { - unsigned dig; case 16: p = (char *)((c == 'X') ? PL_hexdigit + 16 : PL_hexdigit); do { @@ -14677,7 +14677,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv, return varname(gv, '$', 0, NULL, (I8)obase->op_private, FUV_SUBSCRIPT_ARRAY); } - break; + NOT_REACHED; /* NOTREACHED */ case OP_EXISTS: o = cUNOPx(obase)->op_first; @@ -14779,7 +14779,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv, ? '@' : '%', o->op_targ, NULL, 0, FUV_SUBSCRIPT_WITHIN); } - break; + NOT_REACHED; /* NOTREACHED */ } case OP_AASSIGN: @@ -5233,8 +5233,10 @@ Perl_yylex(pTHX) goto just_a_word_zero_gv; } s++; + { + OP *attrs; + switch (PL_expect) { - OP *attrs; case XOPERATOR: if (!PL_in_my || PL_lex_state != LEX_NORMAL) break; @@ -5374,6 +5376,7 @@ Perl_yylex(pTHX) } TOKEN(COLONATTR); } + } if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_CLOSING) { s--; TOKEN(0); @@ -2453,7 +2453,7 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m Perl_croak(aTHX_ "Can't find Unicode property definition \"%"SVf"\"", SVfARG(retval)); - Perl_croak(aTHX_ "SWASHNEW didn't return an HV ref"); + NOT_REACHED; /* NOTREACHED */ } } /* End of calling the module to find the swash */ |