Change 32003: [PATCH] was Re: Freeze ?

[Rafael Garcia-Suarez]

Change 32003 by [EMAIL PROTECTED] on 2007/10/02 11:56:28

        Subject: [PATCH] was Re: Freeze ?
        From: John Peacock <[EMAIL PROTECTED]>
        Date: Tue, 02 Oct 2007 05:28:31 -0400
        Message-ID: <[EMAIL PROTECTED]>

Affected files ...

... //depot/perl/dump.c#274 edit
... //depot/perl/op.h#189 edit
... //depot/perl/pp_ctl.c#627 edit
... //depot/perl/t/comp/use.t#31 edit

Differences ...

==== //depot/perl/dump.c#274 (text) ====
Index: perl/dump.c
--- perl/dump.c#273~32001~      2007-10-01 05:13:36.000000000 -0700
+++ perl/dump.c 2007-10-02 04:56:28.000000000 -0700
@@ -1879,7 +1879,10 @@
 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

==== //depot/perl/op.h#189 (text) ====
Index: perl/op.h
--- perl/op.h#188~31933~        2007-09-20 12:34:51.000000000 -0700
+++ perl/op.h   2007-10-02 04:56:28.000000000 -0700
@@ -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;         \

==== //depot/perl/pp_ctl.c#627 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#626~31978~    2007-09-26 05:46:53.000000000 -0700
+++ perl/pp_ctl.c       2007-10-02 04:56:28.000000000 -0700
@@ -3105,9 +3105,44 @@
                    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

==== //depot/perl/t/comp/use.t#31 (xtext) ====
Index: perl/t/comp/use.t
--- perl/t/comp/use.t#30~31799~ 2007-09-06 06:21:34.000000000 -0700
+++ perl/t/comp/use.t   2007-10-02 04:56:28.000000000 -0700
@@ -6,7 +6,7 @@
     $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 @@
 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 ($@, '');
 
End of Patch.