From: John Peacock <jpeacock@rowman.com>
Date: Tue, 2 Oct 2007 05:28:31 +0000 (-0400)
Subject: was Re: Freeze ?
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d1029faac9d1305e60db4bf8c9ec1552b40d4f64;p=p5sagit%2Fp5-mst-13.2.git

was Re: Freeze ?
Message-ID: <47020F3F.9070604@havurah-software.org>

p4raw-id: //depot/perl@32003
---

diff --git a/dump.c b/dump.c
index 26373b5..dce8630 100644
--- a/dump.c
+++ b/dump.c
@@ -1879,7 +1879,10 @@ void
 Perl_sv_dump(pTHX_ SV *sv)
 {
     dVAR;
-    do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
+    if (SvROK(sv))
+	do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
+    else
+	do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
 }
 
 int
diff --git a/op.h b/op.h
index f7ab172..ae8c7f8 100644
--- a/op.h
+++ b/op.h
@@ -58,7 +58,7 @@
     OP*		(CPERLscope(*op_ppaddr))(pTHX);		\
     MADPROP_IN_BASEOP			\
     PADOFFSET	op_targ;		\
-    unsigned	op_type:9;		\
+    opcode	op_type:9;		\
     unsigned	op_opt:1;		\
     unsigned	op_latefree:1;		\
     unsigned	op_latefreed:1;		\
diff --git a/pp_ctl.c b/pp_ctl.c
index 673e324..f67326d 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3105,9 +3105,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
diff --git a/t/comp/use.t b/t/comp/use.t
index 41f3bde..a43bbeb 100755
--- a/t/comp/use.t
+++ b/t/comp/use.t
@@ -6,7 +6,7 @@ BEGIN {
     $INC{"feature.pm"} = 1; # so we don't attempt to load feature.pm
 }
 
-print "1..59\n";
+print "1..63\n";
 
 # Can't require test.pl, as we're testing the use/require mechanism here.
 
@@ -77,6 +77,18 @@ is ($@, '');
 eval "no 5.000;";
 like ($@, qr/Perls since v5\.0\.0 too modern--this is \Q$^V\E, stopped/);
 
+eval "use 5.6;";
+like ($@, qr/Perl v5\.600\.0 required \(did you mean v5\.6\.0\?\)--this is only \Q$^V\E, stopped/);
+
+eval "use 5.8;";
+like ($@, qr/Perl v5\.800\.0 required \(did you mean v5\.8\.0\?\)--this is only \Q$^V\E, stopped/);
+
+eval "use 5.9;";
+like ($@, qr/Perl v5\.900\.0 required \(did you mean v5\.9\.0\?\)--this is only \Q$^V\E, stopped/);
+
+eval "use 5.10;";
+like ($@, qr/Perl v5\.100\.0 required \(did you mean v5\.10\.0\?\)--this is only \Q$^V\E, stopped/);
+
 eval sprintf "use %.6f;", $];
 is ($@, '');