summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--dump.c5
-rw-r--r--op.h2
-rw-r--r--pp_ctl.c41
-rwxr-xr-xt/comp/use.t14
4 files changed, 56 insertions, 6 deletions
diff --git a/dump.c b/dump.c
index 26373b5f15..dce863098c 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 f7ab172b13..ae8c7f8d13 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 673e324dc2..f67326d0f1 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 41f3bde764..a43bbeb44c 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 ($@, '');