Re: [PATCH 5.8.7 RC1] lib/Carp.t todo for VMS

[p5sagit/p5-mst-13.2.git] / perl.c

diff --git a/perl.c b/perl.c
index cf8a76e..4ebcefa 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -407,7 +407,7 @@ perl_destruct(pTHXx)
     destruct_level = PL_perl_destruct_level;
 #ifdef DEBUGGING
     {
-       char *s;
+       const char *s;
        if ((s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL"))) {
             const int i = atoi(s);
            if (destruct_level < i)
@@ -875,7 +875,7 @@ perl_destruct(pTHXx)
            for (sv = sva + 1; sv < svend; ++sv) {
                if (SvTYPE(sv) != SVTYPEMASK) {
                    PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p"
-                       " flags=0x08%"UVxf
+                       " flags=0x%"UVxf
                        " refcnt=%"UVuf pTHX__FORMAT "\n"
                        "\tallocated at %s:%d %s %s%s\n",
                        sv, sv->sv_flags, sv->sv_refcnt pTHX__VALUE,
@@ -944,21 +944,21 @@ perl_destruct(pTHXx)
     /* As the absolutely last thing, free the non-arena SV for mess() */
 
     if (PL_mess_sv) {
+       /* we know that type == SVt_PVMG */
+
        /* it could have accumulated taint magic */
-       if (SvTYPE(PL_mess_sv) >= SVt_PVMG) {
-           MAGIC* mg;
-           MAGIC* moremagic;
-           for (mg = SvMAGIC(PL_mess_sv); mg; mg = moremagic) {
-               moremagic = mg->mg_moremagic;
-               if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global
-                                               && mg->mg_len >= 0)
-                   Safefree(mg->mg_ptr);
-               Safefree(mg);
-           }
+       MAGIC* mg;
+       MAGIC* moremagic;
+       for (mg = SvMAGIC(PL_mess_sv); mg; mg = moremagic) {
+           moremagic = mg->mg_moremagic;
+           if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global
+               && mg->mg_len >= 0)
+               Safefree(mg->mg_ptr);
+           Safefree(mg);
        }
+
        /* we know that type >= SVt_PV */
-       SvOOK_off(PL_mess_sv);
-       Safefree(SvPVX(PL_mess_sv));
+       SvPV_free(PL_mess_sv);
        Safefree(SvANY(PL_mess_sv));
        Safefree(PL_mess_sv);
        PL_mess_sv = Nullsv;
@@ -1006,15 +1006,11 @@ perl_free(pTHXx)
 #pragma fini "perl_fini"
 #endif
 
-#if defined(__GNUC__) && defined(__attribute__) 
-/* want to make sure __attribute__ works here even
- * for -Dd_attribut=undef builds.
- */
-#undef __attribute__
+static void
+#if defined(__GNUC__)
+__attribute__((destructor))
 #endif
-
-static void __attribute__((destructor))
-perl_fini()
+perl_fini(void)
 {
     dVAR;
     if (PL_curinterp)
@@ -2173,7 +2169,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
        /* we're trying to emulate pp_entertry() here */
        {
            register PERL_CONTEXT *cx;
-           I32 gimme = GIMME_V;
+           const I32 gimme = GIMME_V;
        
            ENTER;
            SAVETMPS;
@@ -2186,7 +2182,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
            if (flags & G_KEEPERR)
                PL_in_eval |= EVAL_KEEPERR;
            else
-               sv_setpv(ERRSV,"");
+               sv_setpvn(ERRSV,"",0);
        }
        PL_markstack_ptr++;
 
@@ -2197,7 +2193,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
            call_body((OP*)&myop, FALSE);
            retval = PL_stack_sp - (PL_stack_base + oldmark);
            if (!(flags & G_KEEPERR))
-               sv_setpv(ERRSV,"");
+               sv_setpvn(ERRSV,"",0);
            break;
        case 1:
            STATUS_ALL_FAILURE;
@@ -2322,7 +2318,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
        call_body((OP*)&myop,TRUE);
        retval = PL_stack_sp - (PL_stack_base + oldmark);
        if (!(flags & G_KEEPERR))
-           sv_setpv(ERRSV,"");
+           sv_setpvn(ERRSV,"",0);
        break;
     case 1:
        STATUS_ALL_FAILURE;
@@ -2438,13 +2434,16 @@ S_usage(pTHX_ const char *name)         /* XXX move this out into a module ? */
 
     static const char * const usage_msg[] = {
 "-0[octal]       specify record separator (\\0, if no argument)",
+"-A[name]        activate all/given assertions",
 "-a              autosplit mode with -n or -p (splits $_ into @F)",
 "-C[number/list] enables the listed Unicode features",
 "-c              check syntax only (runs BEGIN and CHECK blocks)",
 "-d[:debugger]   run program under debugger",
 "-D[number/list] set debugging flags (argument is a bit mask or alphabets)",
 "-e program      one line of program (several -e's allowed, omit programfile)",
+#ifdef USE_SITECUSTOMIZE
 "-f              don't do $sitelib/sitecustomize.pl at startup",
+#endif
 "-F/pattern/     split() pattern for -a switch (//'s are optional)",
 "-i[extension]   edit <> files in place (makes backup if extension supplied)",
 "-Idirectory     specify @INC/#include directory (several -I's allowed)",
@@ -2530,7 +2529,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
        for (; isALNUM(**s); (*s)++) ;
     }
     else if (givehelp) {
-      const char **p = usage_msgd;
+      char **p = (char **)usage_msgd;
       while (*p) PerlIO_printf(PerlIO_stdout(), "%s\n", *p++);
     }
 #  ifdef EBCDIC
@@ -2548,20 +2547,21 @@ char *
 Perl_moreswitches(pTHX_ char *s)
 {
     dVAR;
-    STRLEN numlen;
     UV rschar;
 
     switch (*s) {
     case '0':
     {
         I32 flags = 0;
+        STRLEN numlen;
 
         SvREFCNT_dec(PL_rs);
         if (s[1] == 'x' && s[2]) {
-             char *e;
+             const char *e = s+=2;
              U8 *tmps;
 
-             for (s += 2, e = s; *e; e++);
+             while (*e)
+               e++;
              numlen = e - s;
              flags = PERL_SCAN_SILENT_ILLDIGIT;
              rschar = (U32)grok_hex(s, &numlen, &flags, NULL);
@@ -2716,6 +2716,7 @@ Perl_moreswitches(pTHX_ char *s)
        }
        if (isDIGIT(*s)) {
             I32 flags = 0;
+           STRLEN numlen;
            PL_ors_sv = newSVpvn("\n",1);
            numlen = 3 + (*s == '0');
            *SvPVX(PL_ors_sv) = (char)grok_oct(s, &numlen, &flags, NULL);
@@ -3060,7 +3061,7 @@ S_init_main_stash(pTHX)
     SvREFCNT_dec(GvHV(gv));
     GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
     SvREADONLY_on(gv);
-    HvNAME(PL_defstash) = savepvn("main", 4);
+    Perl_hv_name_set(aTHX_ PL_defstash, "main", 4, 0);
     PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
     GvMULTI_on(PL_incgv);
     PL_hintgv = gv_fetchpv("\010",TRUE, SVt_PV); /* ^H */
@@ -4801,13 +4802,13 @@ Perl_my_failure_exit(pTHX)
 #else
     int exitstatus;
     if (errno & 255)
-       STATUS_POSIX_SET(errno);
+       STATUS_UNIX_SET(errno);
     else {
-       exitstatus = STATUS_POSIX >> 8;
+       exitstatus = STATUS_UNIX >> 8;
        if (exitstatus & 255)
-           STATUS_POSIX_SET(exitstatus);
+           STATUS_UNIX_SET(exitstatus);
        else
-           STATUS_POSIX_SET(255);
+           STATUS_UNIX_SET(255);
     }
 #endif
     my_exit_jump();
@@ -4855,3 +4856,13 @@ read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
     sv_chop(PL_e_script, nl);
     return 1;
 }
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */