In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/520b6fb6871d18601e1bb968982f92f68ad523f5?hp=9de35bb263b4599827a76615d5e6ef08fb7e32c6>
- Log -----------------------------------------------------------------
commit 520b6fb6871d18601e1bb968982f92f68ad523f5
Author: Dagfinn Ilmari Mannsåker <ilm...@ilmari.org>
Date: Thu Jun 1 17:33:15 2017 +0100
Forbid setting $/ to a reference to a non-postive integer
This used to work like setting it to 'undef', but has been deprecated
since Perl 5.20.
In passing, avoid duplicate duplicate uninitialized warning by reusing
the SvIV() result already stored in 'val'.
M mg.c
M pod/perldelta.pod
M pod/perldiag.pod
M t/base/rs.t
M t/lib/warnings/9uninit
M t/lib/warnings/mg
commit 8d37cdf70ae3493748b437390a3fa07a01fd07a9
Author: Dagfinn Ilmari Mannsåker <ilm...@ilmari.org>
Date: Fri Jun 2 10:45:32 2017 +0100
Fix inconsistent whitespace in mg.c
A handful of assignments are lacking a space on the left-hand side,
which is not consistent with the rest of the project style
(perlstyle mandates «Space around most operators»).
Also, a comment was mis-aligned.
M mg.c
commit c6e25b0912953f93b48695f7e584ade418189d1d
Author: Dagfinn Ilmari Mannsåker <ilm...@ilmari.org>
Date: Fri Jun 2 15:47:02 2017 +0100
Forbid use of bare << to mean <<""
It has ben deprecated since perl 5.000.
M pod/perldelta.pod
M pod/perldiag.pod
M t/lib/croak/toke
M t/lib/warnings/toke
M t/op/heredoc.t
M t/op/lex.t
M toke.c
commit 489c16bfa14d460701bd76a4a4f0658f1200509a
Author: Dagfinn Ilmari Mannsåker <ilm...@ilmari.org>
Date: Fri Jun 2 17:30:22 2017 +0100
Disallow opening the same symbol as both a file and directory handle
This has been deprecated since Perl 5.10
M pod/perldelta.pod
M pod/perldiag.pod
M pp_sys.c
M t/lib/croak/pp_sys
M t/lib/warnings/pp_sys
M t/op/chdir.t
M t/op/stat.t
-----------------------------------------------------------------------
Summary of changes:
mg.c | 23 +++++++++-----------
pod/perldelta.pod | 14 ++++++++++++
pod/perldiag.pod | 34 ++++++++++++++---------------
pp_sys.c | 8 +++----
t/base/rs.t | 32 +++++++++++++++++++--------
t/lib/croak/pp_sys | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++
t/lib/croak/toke | 17 +++++++++++++++
t/lib/warnings/9uninit | 12 ++++++----
t/lib/warnings/mg | 20 -----------------
t/lib/warnings/pp_sys | 59 --------------------------------------------------
t/lib/warnings/toke | 18 ---------------
t/op/chdir.t | 23 ++------------------
t/op/heredoc.t | 12 +++++-----
t/op/lex.t | 5 ++---
t/op/stat.t | 29 +------------------------
toke.c | 2 +-
16 files changed, 163 insertions(+), 204 deletions(-)
diff --git a/mg.c b/mg.c
index 99c7aa2c14..c66aa0bb13 100644
--- a/mg.c
+++ b/mg.c
@@ -638,7 +638,7 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
if (PL_curpm) {
REGEXP * const rx = PM_GETRE(PL_curpm);
if (rx) {
- UV uv= (UV)mg->mg_obj;
+ UV uv = (UV)mg->mg_obj;
if (uv == '+') { /* @+ */
/* return the number possible */
return RX_NPARENS(rx);
@@ -674,7 +674,7 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
if (PL_curpm) {
REGEXP * const rx = PM_GETRE(PL_curpm);
if (rx) {
- const UV uv= (UV)mg->mg_obj;
+ const UV uv = (UV)mg->mg_obj;
/* @{^CAPTURE} does not contain $&, so we need to increment by 1 */
const I32 paren = mg->mg_len
+ (uv == '\003' ? 1 : 0);
@@ -2915,10 +2915,9 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
break;
case '/':
{
- SV *tmpsv= sv;
if (SvROK(sv)) {
- SV *referent= SvRV(sv);
- const char *reftype= sv_reftype(referent, 0);
+ SV *referent = SvRV(sv);
+ const char *reftype = sv_reftype(referent, 0);
/* XXX: dodgy type check: This leaves me feeling dirty, but
* the alternative is to copy pretty much the entire
* sv_reftype() into this routine, or to do a full string
@@ -2927,23 +2926,21 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
* without reviewing the corresponding comment in
* sv_reftype(). - Yves */
if (reftype[0] == 'S' || reftype[0] == 'L') {
- IV val= SvIV(referent);
+ IV val = SvIV(referent);
if (val <= 0) {
- tmpsv= &PL_sv_undef;
- Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
- "Setting $/ to a reference to %s as a form of
slurp is deprecated, treating as undef. This will be fatal in Perl 5.28",
- SvIV(SvRV(sv)) < 0 ? "a negative integer" : "zero"
- );
+ sv_setsv(sv, PL_rs);
+ Perl_croak(aTHX_ "Setting $/ to a reference to %s is
forbidden",
+ val < 0 ? "a negative integer" :
"zero");
}
} else {
sv_setsv(sv, PL_rs);
- /* diag_listed_as: Setting $/ to %s reference is forbidden */
+ /* diag_listed_as: Setting $/ to %s reference is forbidden
*/
Perl_croak(aTHX_ "Setting $/ to a%s %s reference is
forbidden",
*reftype == 'A' ? "n" : "", reftype);
}
}
SvREFCNT_dec(PL_rs);
- PL_rs = newSVsv(tmpsv);
+ PL_rs = newSVsv(sv);
}
break;
case '\\':
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 9024a270dd..1e0afc9da8 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -65,6 +65,20 @@ respectively.
This has been deprecated since Perl 5.24.
+=head2 Opening the same symbol as both a file and directory handle is no
longer allowed
+
+Using open() and opendir() to associate both a filehandle and a dirhandle
+to the same symbol (glob or scalar) has been deprecated since Perl 5.10.
+
+=head2 Use of bare C<< << >> to mean C<< <<"" >> is no longer allowed
+
+Use of a bare terminator has been deprecated since Perl 5.000.
+
+=head2 Setting $/ to a reference to a non-positive integer no longer allowed
+
+This used to work like setting it to C<undef>, but has been deprecated
+since Perl 5.20.
+
=head1 Deprecations
XXX Any deprecated features, syntax, modules etc. should be listed here.
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 31ace36725..169e8dc452 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -4275,21 +4275,21 @@ that isn't open. Check your control flow. See also
L<perlfunc/-X>.
(S internal) An internal warning that the grammar is screwed up.
-=item Opening dirhandle %s also as a file. This will be a fatal error in Perl
5.28
+=item Cannot open %s as a filehandle: it is already open as a dirhandle
-(D io, deprecated) You used open() to associate a filehandle to
+(F) You tried to use open() to associate a filehandle to
a symbol (glob or scalar) that already holds a dirhandle.
-Although legal, this idiom might render your code confusing
-and this was deprecated in Perl 5.10. In Perl 5.28, this
-will be a fatal error.
+This idiom might render your code confusing
+and this was deprecated in Perl 5.10. As of Perl 5.28, this
+is a fatal error.
-=item Opening filehandle %s also as a directory. This will be a fatal error in
Perl 5.28
+=item Cannot open %s as a dirhandle: it is already open as a filehandle
-(D io, deprecated) You used opendir() to associate a dirhandle to
+(F) You tried to use opendir() to associate a dirhandle to
a symbol (glob or scalar) that already holds a filehandle.
-Although legal, this idiom might render your code confusing
-and this was deprecated in Perl 5.10. In Perl 5.28, this
-will be a fatal error.
+This idiom might render your code confusing
+and this was deprecated in Perl 5.10. As of Perl 5.28, this
+is a fatal error.
=item Operand with no preceding operator in regex; marked by S<<-- HERE> in
m/%s/
@@ -5550,9 +5550,9 @@ didn't think so.
forget to check the return value of your socket() call? See
L<perlfunc/setsockopt>.
-=item Setting $/ to a reference to %s as a form of slurp is deprecated,
treating as undef. This will be fatal in Perl 5.28
+=item Setting $/ to a reference to %s is forbidden
-(D deprecated) You assigned a reference to a scalar to C<$/> where the
+(F) You assigned a reference to a scalar to C<$/> where the
referenced item is not a positive integer. In older perls this B<appeared>
to work the same as setting it to C<undef> but was in fact internally
different, less efficient and with very bad luck could have resulted in
@@ -5563,8 +5563,8 @@ setting C<$/> to undef, with the exception that this
warning would be
thrown.
You are recommended to change your code to set C<$/> to C<undef> explicitly
-if you wish to slurp the file. In Perl 5.28 assigning C<$/> to a
-reference to an integer which isn't positive will throw a fatal error.
+if you wish to slurp the file. As of Perl 5.28 assigning C<$/> to a
+reference to an integer which isn't positive is a fatal error.
=item Setting $/ to %s reference is forbidden
@@ -6924,14 +6924,14 @@ returns no useful value. See L<perlmod>.
(D deprecated) The C<$[> variable (index of the first element in an array)
is deprecated. See L<perlvar/"$[">.
-=item Use of bare << to mean <<"" is deprecated. Its use will be fatal in Perl
5.28
+=item Use of bare << to mean <<"" is forbidden
-(D deprecated) You are now encouraged to use the explicitly quoted
+(F) You are now required to use the explicitly quoted
form if you wish to use an empty line as the terminator of the
here-document.
Use of a bare terminator was deprecated in Perl 5.000, and
-will be a fatal error in Perl 5.28.
+is a fatal error as of Perl 5.28.
=item Use of /c modifier is meaningless in s///
diff --git a/pp_sys.c b/pp_sys.c
index 98f36453b2..74c89008fa 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -629,8 +629,7 @@ PP(pp_open)
IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
if (IoDIRP(io))
- Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
- "Opening dirhandle %" HEKf " also as a file. This
will be a fatal error in Perl 5.28",
+ Perl_croak(aTHX_ "Cannot open %" HEKf " as a filehandle: it is
already open as a dirhandle",
HEKfARG(GvENAME_HEK(gv)));
mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
@@ -4021,9 +4020,8 @@ PP(pp_open_dir)
IO * const io = GvIOn(gv);
if ((IoIFP(io) || IoOFP(io)))
- Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
- "Opening filehandle %" HEKf " also as a directory.
This will be a fatal error in Perl 5.28",
- HEKfARG(GvENAME_HEK(gv)) );
+ Perl_croak(aTHX_ "Cannot open %" HEKf " as a dirhandle: it is already
open as a filehandle",
+ HEKfARG(GvENAME_HEK(gv)));
if (IoDIRP(io))
PerlDir_close(IoDIRP(io));
if (!(IoDIRP(io) = PerlDir_open(dirname)))
diff --git a/t/base/rs.t b/t/base/rs.t
index f52d8e42ff..37ebb6a198 100644
--- a/t/base/rs.t
+++ b/t/base/rs.t
@@ -1,7 +1,7 @@
#!./perl
# Test $/
-print "1..39\n";
+print "1..41\n";
$test_count = 1;
$teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
@@ -237,17 +237,31 @@ sub test_record {
if ($bar ne "78") {print "not ";}
print "ok $test_count # \$/ = \\\$foo (\$foo = \"2\")\n";
$test_count++;
-
- # Naughty straight number - should get the rest of the file
- # no warnings 'deprecated'; # but not in t/base/*
- { local $SIG{__WARN__} = sub {}; $/ = \0 }
- $bar = <FH>;
- if ($bar ne "90123456789012345678901234567890") {print "not ";}
- print "ok $test_count # \$/ = \\0\n";
- $test_count++;
}
sub test_bad_setting {
+ if (eval {$/ = \0; 1}) {
+ print "not ok ",$test_count++," # \$/ = \\0; should die\n";
+ print "not ok ",$test_count++," # \$/ = \\0; produced expected error
message\n";
+ } else {
+ my $msg= $@ || "Zombie Error";
+ print "ok ",$test_count++," # \$/ = \\0; should die\n";
+ if ($msg!~m!Setting \$\/ to a reference to zero is forbidden!) {
+ print "not ";
+ }
+ print "ok ",$test_count++," # \$/ = \\0; produced expected error
message\n";
+ }
+ if (eval {$/ = \-1; 1}) {
+ print "not ok ",$test_count++," # \$/ = \\-1; should die\n";
+ print "not ok ",$test_count++," # \$/ = \\-1; produced expected error
message\n";
+ } else {
+ my $msg= $@ || "Zombie Error";
+ print "ok ",$test_count++," # \$/ = \\-1; should die\n";
+ if ($msg!~m!Setting \$\/ to a reference to a negative integer is
forbidden!) {
+ print "not ";
+ }
+ print "ok ",$test_count++," # \$/ = \\-1; produced expected error
message\n";
+ }
if (eval {$/ = []; 1}) {
print "not ok ",$test_count++," # \$/ = []; should die\n";
print "not ok ",$test_count++," # \$/ = []; produced expected error
message\n";
diff --git a/t/lib/croak/pp_sys b/t/lib/croak/pp_sys
index 739b7e95af..8b7dc9d53d 100644
--- a/t/lib/croak/pp_sys
+++ b/t/lib/croak/pp_sys
@@ -14,3 +14,62 @@ pipe($fh, $$5)
EXPECT
Bad symbol for filehandle at - line 2.
########
+# NAME open on global dirhandle
+opendir FOO, ".";
+open FOO, "../harness";
+EXPECT
+Cannot open FOO as a filehandle: it is already open as a dirhandle at - line 2.
+########
+# NAME open on lexical dirhandle
+opendir my $foo, ".";
+open $foo, "../harness";
+EXPECT
+Cannot open $foo as a filehandle: it is already open as a dirhandle at - line
2.
+########
+# NAME open on global utf8 dirhandle
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+opendir ＦＯＯ, ".";
+open ＦＯＯ, "../harness";
+EXPECT
+Cannot open ＦＯＯ as a filehandle: it is already open as a dirhandle at -
line 5.
+########
+# NAME open on lexical utf8 dirhandle
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+opendir my $ï½ï½ï½, ".";
+open $ï½ï½ï½, "../harness";
+EXPECT
+Cannot open $ï½ï½ï½ as a filehandle: it is already open as a dirhandle at -
line 5.
+########
+# NAME opendir on global filehandle
+open FOO, "../harness";
+opendir FOO, ".";
+EXPECT
+Cannot open FOO as a dirhandle: it is already open as a filehandle at - line 2.
+########
+# NAME opendir on lexical filehandle
+open my $foo, "../harness";
+opendir $foo, ".";
+EXPECT
+Cannot open $foo as a dirhandle: it is already open as a filehandle at - line
2.
+########
+# NAME opendir on global utf8 filehandle
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+open ＦＯＯ, "../harness";
+opendir ＦＯＯ, ".";
+EXPECT
+Cannot open ＦＯＯ as a dirhandle: it is already open as a filehandle at -
line 5.
+########
+# NAME opendir on lexical utf8 filehandle
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+open my $ï½ï½ï½, "../harness";
+opendir $ï½ï½ï½, ".";
+EXPECT
+Cannot open $ï½ï½ï½ as a dirhandle: it is already open as a filehandle at -
line 5.
diff --git a/t/lib/croak/toke b/t/lib/croak/toke
index 40354955e5..7aa15effc4 100644
--- a/t/lib/croak/toke
+++ b/t/lib/croak/toke
@@ -371,3 +371,20 @@ tr/\o-0//;
EXPECT
Missing braces on \o{} at - line 2, within string
Execution of - aborted due to compilation errors.
+########
+# NAME bare <<
+$a = <<;
+
+EXPECT
+Use of bare << to mean <<"" is forbidden at - line 1.
+########
+# NAME bare <<~
+$a = <<~;
+EXPECT
+Use of bare << to mean <<"" is forbidden at - line 1.
+########
+# NAME bare <<~
+$a = <<~ ;
+
+EXPECT
+Use of bare << to mean <<"" is forbidden at - line 1.
diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit
index 1dc71397b6..774c6ee432 100644
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -404,15 +404,19 @@ use warnings 'uninitialized';
my ($m1);
local $/ =\$m1;
+EXPECT
+Use of uninitialized value $m1 in scalar assignment at - line 4.
+Setting $/ to a reference to zero is forbidden at - line 4.
+########
+use warnings 'uninitialized';
+
my $x = "abc";
chomp $x; chop $x;
my $y;
chomp ($x, $y); chop ($x, $y);
EXPECT
-Use of uninitialized value $m1 in scalar assignment at - line 4.
-Use of uninitialized value $m1 in scalar assignment at - line 4.
-Setting $/ to a reference to zero as a form of slurp is deprecated, treating
as undef. This will be fatal in Perl 5.28 at - line 4.
-Use of uninitialized value $y in chop at - line 8.
+Use of uninitialized value $y in chomp at - line 6.
+Use of uninitialized value $y in chop at - line 6.
########
use warnings 'uninitialized';
my ($m1, @ma, %mh);
diff --git a/t/lib/warnings/mg b/t/lib/warnings/mg
index 7fdefc26b3..589db847b2 100644
--- a/t/lib/warnings/mg
+++ b/t/lib/warnings/mg
@@ -3,8 +3,6 @@
No such signal: SIG%s
$SIG{FRED} = sub {}
- Setting $/ to a reference to zero as a form of slurp is deprecated, treating
as undef. This will be fatal in Perl 5.28
-
SIG%s handler \"%s\" not defined.
$SIG{"INT"} = "ok3"; kill "INT",$$;
@@ -20,24 +18,6 @@ no warnings 'signal' ;
$SIG{FRED} = sub {};
EXPECT
-########
--w
-# warnable code, warnings enabled via command line switch
-$/ = \0;
-EXPECT
-Setting $/ to a reference to zero as a form of slurp is deprecated, treating
as undef. This will be fatal in Perl 5.28 at - line 3.
-########
--w
-# warnable code, warnings enabled via command line switch
-$/ = \-1;
-EXPECT
-Setting $/ to a reference to a negative integer as a form of slurp is
deprecated, treating as undef. This will be fatal in Perl 5.28 at - line 3.
-########
-$/ = \-1;
-no warnings 'deprecated';
-$/ = \-1;
-EXPECT
-Setting $/ to a reference to a negative integer as a form of slurp is
deprecated, treating as undef. This will be fatal in Perl 5.28 at - line 1.
########
# mg.c
use warnings 'signal' ;
diff --git a/t/lib/warnings/pp_sys b/t/lib/warnings/pp_sys
index 9c544e088b..337defdb5e 100644
--- a/t/lib/warnings/pp_sys
+++ b/t/lib/warnings/pp_sys
@@ -761,65 +761,6 @@ chdir() on closed filehandle BAR at - line 21.
chdir() on unopened filehandle $dh at - line 22.
chdir() on closed filehandle $fh at - line 23.
########
-# pp_sys.c [pp_open]
-use warnings;
-opendir FOO, ".";
-opendir my $foo, ".";
-open FOO, "../harness";
-open $foo, "../harness";
-no warnings qw(io deprecated);
-open FOO, "../harness";
-open $foo, "../harness";
-EXPECT
-Opening dirhandle FOO also as a file. This will be a fatal error in Perl 5.28
at - line 5.
-Opening dirhandle $foo also as a file. This will be a fatal error in Perl 5.28
at - line 6.
-########
-
-# pp_sys.c [pp_open]
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
-opendir ＦＯＯ, ".";
-opendir $ï½ï½ï½, ".";
-open ＦＯＯ, "../harness";
-open $ï½ï½ï½, "../harness";
-no warnings qw(io deprecated);
-open ＦＯＯ, "../harness";
-open $ï½ï½ï½, "../harness";
-EXPECT
-Opening dirhandle ＦＯＯ also as a file. This will be a fatal error in Perl
5.28 at - line 8.
-Opening dirhandle $ï½ï½ï½ also as a file. This will be a fatal error in
Perl 5.28 at - line 9.
-########
-# pp_sys.c [pp_open_dir]
-use warnings;
-open FOO, "../harness";
-open my $foo, "../harness";
-opendir FOO, ".";
-opendir $foo, ".";
-no warnings qw(io deprecated);
-opendir FOO, ".";
-opendir $foo, ".";
-EXPECT
-Opening filehandle FOO also as a directory. This will be a fatal error in Perl
5.28 at - line 5.
-Opening filehandle $foo also as a directory. This will be a fatal error in
Perl 5.28 at - line 6.
-########
-
-# pp_sys.c [pp_open_dir]
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
-use warnings;
-open ＦＯＯ, "../harness";
-open $ï½ï½ï½, "../harness";
-opendir ＦＯＯ, ".";
-opendir $ï½ï½ï½, ".";
-no warnings qw(io deprecated);
-opendir ＦＯＯ, ".";
-opendir $ï½ï½ï½, ".";
-EXPECT
-Opening filehandle ＦＯＯ also as a directory. This will be a fatal error
in Perl 5.28 at - line 9.
-Opening filehandle $ï½ï½ï½ also as a directory. This will be a fatal error
in Perl 5.28 at - line 10.
-########
# pp_sys.c [pp_*dir]
use Config ;
BEGIN {
diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index 49fa97ea8e..b9c01c90f5 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -124,24 +124,6 @@ toke.c AOK
__END__
# toke.c
-$a = <<;
-
-no warnings 'deprecated' ;
-$a = <<;
-
-EXPECT
-Use of bare << to mean <<"" is deprecated. Its use will be fatal in Perl 5.28
at - line 2.
-########
-# toke.c
-$a = <<~;
-
-$a = <<~ ;
-
-EXPECT
-Use of bare << to mean <<"" is deprecated. Its use will be fatal in Perl 5.28
at - line 2.
-Use of bare << to mean <<"" is deprecated. Its use will be fatal in Perl 5.28
at - line 4.
-########
-# toke.c
$a =~ m/$foo/eq;
$a =~ s/$foo/fool/seq;
diff --git a/t/op/chdir.t b/t/op/chdir.t
index 38cbbe92bd..0ce83d0673 100644
--- a/t/op/chdir.t
+++ b/t/op/chdir.t
@@ -12,7 +12,7 @@ BEGIN {
set_up_inc(qw(t . lib ../lib));
}
-plan(tests => 48);
+plan(tests => 44);
use Config;
use Errno qw(ENOENT EBADF EINVAL);
@@ -86,26 +86,7 @@ SKIP: {
}
ok(-d "op", "verify that we are back");
- # And now the ambiguous case
- {
- no warnings qw<io deprecated>;
- ok(opendir(H, "op"), "opendir op") or diag $!;
- ok(open(H, "<", "base"), "open base") or diag $!;
- }
- if ($has_dirfd) {
- ok(chdir(H), "fchdir to op");
- ok(-f "chdir.t", "verify that we are in 'op'");
- chdir ".." or die $!;
- }
- else {
- eval { chdir(H); };
- like($@, qr/^The dirfd function is unimplemented at/,
- "dirfd is unimplemented");
- SKIP: {
- skip("dirfd is unimplemented");
- }
- }
- ok(closedir(H), "closedir");
+ ok(open(H, "<", "base"), "open base") or diag $!;
ok(chdir(H), "fchdir to base");
ok(-f "cond.t", "verify that we are in 'base'");
ok(close(H), "close");
diff --git a/t/op/heredoc.t b/t/op/heredoc.t
index 5166159e63..7b11852e05 100644
--- a/t/op/heredoc.t
+++ b/t/op/heredoc.t
@@ -33,13 +33,13 @@ HEREDOC
);
fresh_perl_is(
- "print <<;\n$string\n",
+ qq(print <<"";\n$string\n),
$string,
{ switches => ['-X'] },
"blank-terminated heredoc at EOF"
);
fresh_perl_is(
- "print <<\n$string\n",
+ qq(print <<""\n$string\n),
$string,
{ switches => ['-X'] },
"blank-terminated heredoc at EOF and no semicolon"
@@ -75,7 +75,7 @@ HEREDOC
# that building with ASAN will reveal the bug and any related regressions.
for (1..31) {
fresh_perl_like(
- "print <<;\n" . "x" x $_,
+ qq(print <<"";\n) . "x" x $_,
qr/find string terminator/,
{ switches => ['-X'] },
"empty string terminator still needs a newline (length $_)"
@@ -100,16 +100,16 @@ HEREDOC
# also read freed memory, but got an invalid oldoldbufptr in a different
way
fresh_perl_like(
- qq(<<\n\$ \n),
+ qq(<<""\n\$ \n),
# valgrind and asan reports an error between these two lines
- qr/^Use of bare << to mean <<"" is deprecated\. Its use will be fatal
in Perl 5\.28 at - line 1\.\s+Final \$/,
+ qr/^Final \$/,
{},
"don't use an invalid oldoldbufptr (some more)"
);
# [perl #125540] this asserted or crashed
fresh_perl_like(
- q(map d$#<<<<),
+ q(map d$#<<<<""),
qr/Can't find string terminator "" anywhere before EOF at - line 1\./,
{},
"Don't assert parsing a here-doc if we hit EOF early"
diff --git a/t/op/lex.t b/t/op/lex.t
index 7a05ee98c1..90be519524 100644
--- a/t/op/lex.t
+++ b/t/op/lex.t
@@ -10,14 +10,13 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; }
plan(tests => 36);
{
- no warnings 'deprecated';
- print <<; # Yow!
+ print <<''; # Yow!
ok 1
# previous line intentionally left blank.
my $yow = "ok 2";
- print <<; # Yow!
+ print <<""; # Yow!
$yow
# previous line intentionally left blank.
diff --git a/t/op/stat.t b/t/op/stat.t
index 323c4982fc..a5bb018f62 100644
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -25,7 +25,7 @@ if ($^O eq 'MSWin32') {
${^WIN32_SLOPPY_STAT} = 0;
}
-plan tests => 118;
+plan tests => 108;
my $Perl = which_perl();
@@ -561,20 +561,7 @@ SKIP: {
ok(stat(DIR), "stat() on dirhandle works");
ok(-d -r _ , "chained -x's on dirhandle");
ok(-d DIR, "-d on a dirhandle works");
-
- # And now for the ambiguous bareword case
- {
- no warnings 'deprecated';
- ok(open(DIR, "TEST"), 'Can open "TEST" dir')
- || diag "Can't open 'TEST': $!";
- }
- my $size = (stat(DIR))[7];
- ok(defined $size, "stat() on bareword works");
- is($size, -s "TEST", "size returned by stat of bareword is for the file");
- ok(-f _, "ambiguous bareword uses file handle, not dir handle");
- ok(-f DIR);
closedir DIR or die $!;
- close DIR or die $!;
}
{
@@ -594,21 +581,7 @@ SKIP: {
ok(stat(*DIR{IO}), "stat() on *DIR{IO} works");
ok(-d _ , "The special file handle _ is set correctly");
ok(-d -r *DIR{IO} , "chained -x's on *DIR{IO}");
-
- # And now for the ambiguous bareword case
- {
- no warnings 'deprecated';
- ok(open(DIR, "TEST"), 'Can open "TEST" dir')
- || diag "Can't open 'TEST': $!";
- }
- my $size = (stat(*DIR{IO}))[7];
- ok(defined $size, "stat() on *THINGY{IO} works");
- is($size, -s "TEST",
- "size returned by stat of *THINGY{IO} is for the file");
- ok(-f _, "ambiguous *THINGY{IO} uses file handle, not dir handle");
- ok(-f *DIR{IO});
closedir DIR or die $!;
- close DIR or die $!;
}
}
diff --git a/toke.c b/toke.c
index e9d3979879..0dcf623194 100644
--- a/toke.c
+++ b/toke.c
@@ -9846,7 +9846,7 @@ S_scan_heredoc(pTHX_ char *s)
else
term = '"';
if (! isWORDCHAR_lazy_if_safe(s, PL_bufend, UTF))
- deprecate_fatal_in("5.28", "Use of bare << to mean <<\"\" is
deprecated");
+ Perl_croak(aTHX_ "Use of bare << to mean <<\"\" is forbidden");
peek = s;
while (
isWORDCHAR_lazy_if_safe(peek, PL_bufend, UTF))
--
Perl5 Master Repository
