Upgrade to Devel::PPPort 3.13

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

diff --git a/pp_ctl.c b/pp_ctl.c
index a09d44e..a822614 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3098,9 +3098,44 @@ PP(pp_require)
                    SVfARG(vnormal(sv)), SVfARG(vnormal(PL_patchlevel)));
        }
        else {
-           if ( vcmp(sv,PL_patchlevel) > 0 )
-               DIE(aTHX_ "Perl %"SVf" required--this is only %"SVf", stopped",
-                   SVfARG(vnormal(sv)), SVfARG(vnormal(PL_patchlevel)));
+           if ( vcmp(sv,PL_patchlevel) > 0 ) {
+               I32 first = 0;
+               AV *lav;
+               SV * const req = SvRV(sv);
+               SV * const pv = *hv_fetchs((HV*)req, "original", FALSE);
+
+               /* get the left hand term */
+               lav = (AV *)SvRV(*hv_fetchs((HV*)req, "version", FALSE));
+
+               first  = SvIV(*av_fetch(lav,0,0));
+               if (   first > (int)PERL_REVISION    /* probably 'use 6.0' */
+                   || hv_exists((HV*)req, "qv", 2 ) /* qv style */
+                   || av_len(lav) > 1               /* FP with > 3 digits */
+                   || strstr(SvPVX(pv),".0")        /* FP with leading 0 */
+                  ) {
+                   DIE(aTHX_ "Perl %"SVf" required--this is only "
+                       "%"SVf", stopped", SVfARG(vnormal(req)),
+                       SVfARG(vnormal(PL_patchlevel)));
+               }
+               else { /* probably 'use 5.10' or 'use 5.8' */
+                   SV * hintsv = newSV(0);
+                   I32 second = 0;
+
+                   if (av_len(lav)>=1) 
+                       second = SvIV(*av_fetch(lav,1,0));
+
+                   second /= second >= 600  ? 100 : 10;
+                   hintsv = Perl_newSVpvf(aTHX_ "v%d.%d.%d",
+                       (int)first, (int)second,0);
+                   upg_version(hintsv, TRUE);
+
+                   DIE(aTHX_ "Perl %"SVf" required (did you mean %"SVf"?)"
+                       "--this is only %"SVf", stopped",
+                       SVfARG(vnormal(req)),
+                       SVfARG(vnormal(hintsv)),
+                       SVfARG(vnormal(PL_patchlevel)));
+               }
+           }
        }
 
        /* If we request a version >= 5.9.5, load feature.pm with the
@@ -3149,7 +3184,8 @@ PP(pp_require)
            if (*svp != &PL_sv_undef)
                RETPUSHYES;
            else
-               DIE(aTHX_ "Compilation failed in require");
+               DIE(aTHX_ "Attempt to reload %s aborted.\n"
+                           "Compilation failed in require", unixname);
        }
     }
 
@@ -4031,12 +4067,12 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
                            RETPUSHNO;
                    }
                    else {
-                       hv_store_ent(seen_this,
-                           sv_2mortal(newSViv(PTR2IV(*this_elem))),
-                           &PL_sv_undef, 0);
-                       hv_store_ent(seen_other,
-                           sv_2mortal(newSViv(PTR2IV(*other_elem))),
-                           &PL_sv_undef, 0);
+                       (void)hv_store_ent(seen_this,
+                               sv_2mortal(newSViv(PTR2IV(*this_elem))),
+                               &PL_sv_undef, 0);
+                       (void)hv_store_ent(seen_other,
+                               sv_2mortal(newSViv(PTR2IV(*other_elem))),
+                               &PL_sv_undef, 0);
                        PUSHs(*this_elem);
                        PUSHs(*other_elem);