Add a new test for overloading.pm

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

diff --git a/perl.c b/perl.c
index e963c0b..34bbbab 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -461,6 +461,10 @@ perl_construct(pTHXx)
     PL_timesbase.tms_cstime = 0;
 #endif
 
+    PL_registered_mros = newHV();
+    /* Start with 1 bucket, for DFS.  It's unlikely we'll need more.  */
+    HvMAX(PL_registered_mros) = 0;
+
     ENTER;
 }
 
@@ -849,6 +853,8 @@ perl_destruct(pTHXx)
     PL_exitlist = NULL;
     PL_exitlistlen = 0;
 
+    SvREFCNT_dec(PL_registered_mros);
+
     /* jettison our possibly duplicated environment */
     /* if PERL_USE_SAFE_PUTENV is defined environ will not have been copied
      * so we certainly shouldn't free it here
@@ -1898,9 +1904,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #else
                    sv_catpvs(opts_prog,"\"\\nCharacteristics of this binary (from libperl): \\n");
 #endif
-#ifdef PERL_PATCHNUM
-                   sv_catpvs(opts_prog, "  Git Description: " STRINGIFY(PERL_PATCHNUM) "\\n");
-#endif
                    sv_catpvs(opts_prog,"  Compile-time options: $_\\n\",");
 
 #if defined(LOCAL_PATCH_COUNT)
@@ -1911,7 +1914,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                        for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
                            if (PL_localpatches[i])
                                Perl_sv_catpvf(aTHX_ opts_prog,"q%c\t%s\n%c,",
-                                              0, PL_localpatches[i], 0);
+                                   0, PL_localpatches[i], 0);
                        }
                    }
 #endif
@@ -3303,11 +3306,29 @@ Perl_moreswitches(pTHX_ const char *s)
        if (!sv_derived_from(PL_patchlevel, "version"))
            upg_version(PL_patchlevel, TRUE);
 #if !defined(DGUX)
-       PerlIO_printf(PerlIO_stdout(),
+       {
+           SV* level= vstringify(PL_patchlevel);
+#ifdef PERL_PATCHNUM
+           SV* num= newSVpvn(STRINGIFY(PERL_PATCHNUM),sizeof(STRINGIFY(PERL_PATCHNUM))-1);
+#ifdef PERL_GIT_UNCOMMITTED_CHANGES
+           sv_catpvs(num, "*");
+#endif
+
+           if (sv_len(num)>=sv_len(level) && strnEQ(SvPV_nolen(num),SvPV_nolen(level),sv_len(level))) {
+               SvREFCNT_dec(level);
+               level= num;
+           } else {
+               Perl_sv_catpvf(aTHX_ level, " (%"SVf")", num);
+               SvREFCNT_dec(num);
+           }
+ #endif
+           PerlIO_printf(PerlIO_stdout(),
                "\nThis is perl, %"SVf
                " built for %s",
-               SVfARG(vstringify(PL_patchlevel)),
+               level,
                ARCHNAME);
+           SvREFCNT_dec(level);
+       }
 #else /* DGUX */
 /* Adjust verbose output as in the perl that ships with the DG/UX OS from EMC */
        PerlIO_printf(PerlIO_stdout(),
@@ -3320,10 +3341,6 @@ Perl_moreswitches(pTHX_ const char *s)
                        Perl_form(aTHX_ "        OS Specific Release: %s\n",
                                        OSVERS));
 #endif /* !DGUX */
-#ifdef PERL_PATCHNUM
-       PerlIO_printf(PerlIO_stdout(), "\nGit Description: %s", STRINGIFY(PERL_PATCHNUM));
-#endif
-
 #if defined(LOCAL_PATCH_COUNT)
        if (LOCAL_PATCH_COUNT > 0)
            PerlIO_printf(PerlIO_stdout(),