This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add a bareword_filehandles feature, which is enabled by default
authorTony Cook <tony@develop-help.com>
Mon, 8 Jun 2020 00:13:35 +0000 (10:13 +1000)
committerTony Cook <tony@develop-help.com>
Mon, 4 Jan 2021 00:28:58 +0000 (11:28 +1100)
This disables use of bareword filehandles except for the built-in handles

12 files changed:
MANIFEST
embed.fnc
embed.h
feature.h
lib/feature.pm
op.c
pod/perldiag.pod
proto.h
regen/feature.pl
t/lib/feature/bareword_filehandles [new file with mode: 0644]
t/porting/known_pod_issues.dat
toke.c

index eed88d7..53c500d 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5622,6 +5622,7 @@ t/lib/Devel/nodb.pm               Module for t/run/switchd.t
 t/lib/Devel/switchd.pm         Module for t/run/switchd.t
 t/lib/Devel/switchd_empty.pm   Module for t/run/switchd.t
 t/lib/Devel/switchd_goto.pm    Module for t/run/switchd.t
+t/lib/feature/bareword_filehandles     Tests for enabling/disabling bareword_filehandles feature
 t/lib/feature/bits             Tests for feature bit handling
 t/lib/feature/bundle           Tests for feature bundles
 t/lib/feature/implicit         Tests for implicit loading of feature.pm
index 573ecc5..e633097 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2896,6 +2896,7 @@ S |bool   |process_special_blocks |I32 floor \
 S      |void   |clear_special_blocks   |NN const char *const fullname\
                                        |NN GV *const gv|NN CV *const cv
 #endif
+p      |void   |no_bareword_filehandle|NN const char *fhname
 XpR    |void*  |Slab_Alloc     |size_t sz
 Xp     |void   |Slab_Free      |NN void *op
 #if defined(PERL_DEBUG_READONLY_OPS)
diff --git a/embed.h b/embed.h
index fd5f3b4..d3a6000 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define newXS_deffile(a,b)     Perl_newXS_deffile(aTHX_ a,b)
 #define newXS_len_flags(a,b,c,d,e,f,g) Perl_newXS_len_flags(aTHX_ a,b,c,d,e,f,g)
 #define nextargv(a,b)          Perl_nextargv(aTHX_ a,b)
+#define no_bareword_filehandle(a)      Perl_no_bareword_filehandle(aTHX_ a)
 #define noperl_die             Perl_noperl_die
 #define notify_parser_that_changed_to_utf8()   Perl_notify_parser_that_changed_to_utf8(aTHX)
 #define oopsAV(a)              Perl_oopsAV(aTHX_ a)
index 20f7996..173719f 100644 (file)
--- a/feature.h
+++ b/feature.h
 
 #define HINT_FEATURE_SHIFT     26
 
-#define FEATURE_BITWISE_BIT          0x0001
-#define FEATURE___SUB___BIT          0x0002
-#define FEATURE_MYREF_BIT            0x0004
-#define FEATURE_EVALBYTES_BIT        0x0008
-#define FEATURE_FC_BIT               0x0010
-#define FEATURE_INDIRECT_BIT         0x0020
-#define FEATURE_ISA_BIT              0x0040
-#define FEATURE_MULTIDIMENSIONAL_BIT 0x0080
-#define FEATURE_POSTDEREF_QQ_BIT     0x0100
-#define FEATURE_REFALIASING_BIT      0x0200
-#define FEATURE_SAY_BIT              0x0400
-#define FEATURE_SIGNATURES_BIT       0x0800
-#define FEATURE_STATE_BIT            0x1000
-#define FEATURE_SWITCH_BIT           0x2000
-#define FEATURE_UNIEVAL_BIT          0x4000
-#define FEATURE_UNICODE_BIT          0x8000
+#define FEATURE_BAREWORD_FILEHANDLES_BIT 0x0001
+#define FEATURE_BITWISE_BIT              0x0002
+#define FEATURE___SUB___BIT              0x0004
+#define FEATURE_MYREF_BIT                0x0008
+#define FEATURE_EVALBYTES_BIT            0x0010
+#define FEATURE_FC_BIT                   0x0020
+#define FEATURE_INDIRECT_BIT             0x0040
+#define FEATURE_ISA_BIT                  0x0080
+#define FEATURE_MULTIDIMENSIONAL_BIT     0x0100
+#define FEATURE_POSTDEREF_QQ_BIT         0x0200
+#define FEATURE_REFALIASING_BIT          0x0400
+#define FEATURE_SAY_BIT                  0x0800
+#define FEATURE_SIGNATURES_BIT           0x1000
+#define FEATURE_STATE_BIT                0x2000
+#define FEATURE_SWITCH_BIT               0x4000
+#define FEATURE_UNIEVAL_BIT              0x8000
+#define FEATURE_UNICODE_BIT              0x10000
 
 #define FEATURE_BUNDLE_DEFAULT 0
 #define FEATURE_BUNDLE_510     1
@@ -47,7 +48,7 @@
     ? (PL_curcop->cop_features & (mask)) : FALSE)
 
 /* The longest string we pass in.  */
-#define MAX_FEATURE_LEN (sizeof("multidimensional")-1)
+#define MAX_FEATURE_LEN (sizeof("bareword_filehandles")-1)
 
 #define FEATURE_FC_IS_ENABLED \
     ( \
         FEATURE_IS_ENABLED_MASK(FEATURE_MULTIDIMENSIONAL_BIT)) \
     )
 
+#define FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED \
+    ( \
+       CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527 \
+     || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
+        FEATURE_IS_ENABLED_MASK(FEATURE_BAREWORD_FILEHANDLES_BIT)) \
+    )
+
 
 #define SAVEFEATUREBITS() SAVEI32(PL_compiling.cop_features)
 
@@ -236,7 +244,12 @@ S_magic_sethint_feature(pTHX_ SV *keysv, const char *keypv, STRLEN keylen,
             return;
 
         case 'b':
-            if (keylen == sizeof("feature_bitwise")-1
+            if (keylen == sizeof("feature_bareword_filehandles")-1
+                 && memcmp(subf+1, "areword_filehandles", keylen - sizeof("feature_")) == 0) {
+                mask = FEATURE_BAREWORD_FILEHANDLES_BIT;
+                break;
+            }
+            else if (keylen == sizeof("feature_bitwise")-1
                  && memcmp(subf+1, "itwise", keylen - sizeof("feature_")) == 0) {
                 mask = FEATURE_BITWISE_BIT;
                 break;
index 7c60f1d..a8e943a 100644 (file)
@@ -5,35 +5,36 @@
 
 package feature;
 
-our $VERSION = '1.61';
+our $VERSION = '1.62';
 
 our %feature = (
-    fc               => 'feature_fc',
-    isa              => 'feature_isa',
-    say              => 'feature_say',
-    state            => 'feature_state',
-    switch           => 'feature_switch',
-    bitwise          => 'feature_bitwise',
-    indirect         => 'feature_indirect',
-    evalbytes        => 'feature_evalbytes',
-    signatures       => 'feature_signatures',
-    current_sub      => 'feature___SUB__',
-    refaliasing      => 'feature_refaliasing',
-    postderef_qq     => 'feature_postderef_qq',
-    unicode_eval     => 'feature_unieval',
-    declared_refs    => 'feature_myref',
-    unicode_strings  => 'feature_unicode',
-    multidimensional => 'feature_multidimensional',
+    fc                   => 'feature_fc',
+    isa                  => 'feature_isa',
+    say                  => 'feature_say',
+    state                => 'feature_state',
+    switch               => 'feature_switch',
+    bitwise              => 'feature_bitwise',
+    indirect             => 'feature_indirect',
+    evalbytes            => 'feature_evalbytes',
+    signatures           => 'feature_signatures',
+    current_sub          => 'feature___SUB__',
+    refaliasing          => 'feature_refaliasing',
+    postderef_qq         => 'feature_postderef_qq',
+    unicode_eval         => 'feature_unieval',
+    declared_refs        => 'feature_myref',
+    unicode_strings      => 'feature_unicode',
+    multidimensional     => 'feature_multidimensional',
+    bareword_filehandles => 'feature_bareword_filehandles',
 );
 
 our %feature_bundle = (
-    "5.10"    => [qw(indirect multidimensional say state switch)],
-    "5.11"    => [qw(indirect multidimensional say state switch unicode_strings)],
-    "5.15"    => [qw(current_sub evalbytes fc indirect multidimensional say state switch unicode_eval unicode_strings)],
-    "5.23"    => [qw(current_sub evalbytes fc indirect multidimensional postderef_qq say state switch unicode_eval unicode_strings)],
-    "5.27"    => [qw(bitwise current_sub evalbytes fc indirect multidimensional postderef_qq say state switch unicode_eval unicode_strings)],
-    "all"     => [qw(bitwise current_sub declared_refs evalbytes fc indirect isa multidimensional postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)],
-    "default" => [qw(indirect multidimensional)],
+    "5.10"    => [qw(bareword_filehandles indirect multidimensional say state switch)],
+    "5.11"    => [qw(bareword_filehandles indirect multidimensional say state switch unicode_strings)],
+    "5.15"    => [qw(bareword_filehandles current_sub evalbytes fc indirect multidimensional say state switch unicode_eval unicode_strings)],
+    "5.23"    => [qw(bareword_filehandles current_sub evalbytes fc indirect multidimensional postderef_qq say state switch unicode_eval unicode_strings)],
+    "5.27"    => [qw(bareword_filehandles bitwise current_sub evalbytes fc indirect multidimensional postderef_qq say state switch unicode_eval unicode_strings)],
+    "all"     => [qw(bareword_filehandles bitwise current_sub declared_refs evalbytes fc indirect isa multidimensional postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)],
+    "default" => [qw(bareword_filehandles indirect multidimensional)],
 );
 
 $feature_bundle{"5.12"} = $feature_bundle{"5.11"};
@@ -392,6 +393,22 @@ previous versions, it was simply on all the time.
 You can use the L<multidimensional> module on CPAN to disable
 multidimensional array emulation for older versions of Perl.
 
+=head2 The 'bareword_filehandles' feature.
+
+This feature enables bareword filehandles for builtin functions
+operations, a generally discouraged practice.  It is enabled by
+default, but can be turned off to disable bareword filehandles, except
+for the exceptions listed below.
+
+The perl built-in filehandles C<STDIN>, C<STDOUT>, C<STDERR>, C<DATA>,
+C<ARGV>, C<ARGVOUT> and the special C<_> are always enabled.
+
+This feature is enabled under this name from Perl 5.34 onwards.  In
+previous versions it was simply on all the time.
+
+You can use the L<bareword::filehandles> module on CPAN to disable
+bareword filehandles for older versions of perl.
+
 =head1 FEATURE BUNDLES
 
 It's possible to load multiple features together, using
@@ -405,54 +422,64 @@ The following feature bundles are available:
   bundle    features included
   --------- -----------------
   :default  indirect multidimensional
+            bareword_filehandles
 
-  :5.10     indirect multidimensional say state switch
-
-  :5.12     indirect multidimensional say state switch
-            unicode_strings
-
-  :5.14     indirect multidimensional say state switch
-            unicode_strings
-
-  :5.16     current_sub evalbytes fc indirect
+  :5.10     bareword_filehandles indirect
             multidimensional say state switch
-            unicode_eval unicode_strings
 
-  :5.18     current_sub evalbytes fc indirect
+  :5.12     bareword_filehandles indirect
             multidimensional say state switch
-            unicode_eval unicode_strings
-
-  :5.20     current_sub evalbytes fc indirect
-            multidimensional say state switch
-            unicode_eval unicode_strings
+            unicode_strings
 
-  :5.22     current_sub evalbytes fc indirect
+  :5.14     bareword_filehandles indirect
             multidimensional say state switch
-            unicode_eval unicode_strings
+            unicode_strings
 
-  :5.24     current_sub evalbytes fc indirect
-            multidimensional postderef_qq say state
+  :5.16     bareword_filehandles current_sub evalbytes
+            fc indirect multidimensional say state
             switch unicode_eval unicode_strings
 
-  :5.26     current_sub evalbytes fc indirect
-            multidimensional postderef_qq say state
+  :5.18     bareword_filehandles current_sub evalbytes
+            fc indirect multidimensional say state
             switch unicode_eval unicode_strings
 
-  :5.28     bitwise current_sub evalbytes fc indirect
-            multidimensional postderef_qq say state
+  :5.20     bareword_filehandles current_sub evalbytes
+            fc indirect multidimensional say state
             switch unicode_eval unicode_strings
 
-  :5.30     bitwise current_sub evalbytes fc indirect
-            multidimensional postderef_qq say state
+  :5.22     bareword_filehandles current_sub evalbytes
+            fc indirect multidimensional say state
             switch unicode_eval unicode_strings
 
-  :5.32     bitwise current_sub evalbytes fc indirect
-            multidimensional postderef_qq say state
-            switch unicode_eval unicode_strings
+  :5.24     bareword_filehandles current_sub evalbytes
+            fc indirect multidimensional postderef_qq
+            say state switch unicode_eval
+            unicode_strings
 
-  :5.34     bitwise current_sub evalbytes fc indirect
-            multidimensional postderef_qq say state
-            switch unicode_eval unicode_strings
+  :5.26     bareword_filehandles current_sub evalbytes
+            fc indirect multidimensional postderef_qq
+            say state switch unicode_eval
+            unicode_strings
+
+  :5.28     bareword_filehandles bitwise current_sub
+            evalbytes fc indirect multidimensional
+            postderef_qq say state switch unicode_eval
+            unicode_strings
+
+  :5.30     bareword_filehandles bitwise current_sub
+            evalbytes fc indirect multidimensional
+            postderef_qq say state switch unicode_eval
+            unicode_strings
+
+  :5.32     bareword_filehandles bitwise current_sub
+            evalbytes fc indirect multidimensional
+            postderef_qq say state switch unicode_eval
+            unicode_strings
+
+  :5.34     bareword_filehandles bitwise current_sub
+            evalbytes fc indirect multidimensional
+            postderef_qq say state switch unicode_eval
+            unicode_strings
 
 The C<:default> bundle represents the feature set that is enabled before
 any C<use feature> or C<no feature> declaration.
diff --git a/op.c b/op.c
index dce844d..889a032 100644 (file)
--- a/op.c
+++ b/op.c
@@ -724,6 +724,21 @@ S_no_bareword_allowed(pTHX_ OP *o)
     o->op_private &= ~OPpCONST_STRICT; /* prevent warning twice about the same OP */
 }
 
+void
+Perl_no_bareword_filehandle(pTHX_ const char *fhname) {
+    PERL_ARGS_ASSERT_NO_BAREWORD_FILEHANDLE;
+
+    if (strNE(fhname, "STDERR")
+        && strNE(fhname, "STDOUT")
+        && strNE(fhname, "STDIN")
+        && strNE(fhname, "_")
+        && strNE(fhname, "ARGV")
+        && strNE(fhname, "ARGVOUT")
+        && strNE(fhname, "DATA")) {
+        qerror(Perl_mess(aTHX_ "Bareword filehandle \"%s\" not allowed under 'no feature \"bareword_filehandles\"'", fhname));
+    }
+}
+
 /* "register" allocation */
 
 PADOFFSET
@@ -13090,6 +13105,11 @@ Perl_ck_fun(pTHX_ OP *o)
                    {
                        OP * const newop = newGVOP(OP_GV, 0,
                            gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVIO));
+                        /* a first argument is handled by toke.c, ideally we'd
+                         just check here but several ops don't use ck_fun() */
+                        if (!FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED && numargs > 1) {
+                            no_bareword_filehandle(SvPVX(cSVOPx_sv((SVOP*)kid)));
+                        }
                         /* replace kid with newop in chain */
                         op_sibling_splice(o, prev_kid, 1, newop);
                        op_free(kid);
@@ -15159,6 +15179,9 @@ Perl_ck_trunc(pTHX_ OP *o)
        {
            o->op_flags |= OPf_SPECIAL;
            kid->op_private &= ~OPpCONST_STRICT;
+            if (!FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED) {
+                no_bareword_filehandle(SvPVX(cSVOPx_sv(kid)));
+            }
        }
     }
     return ck_fun(o);
index b21102e..27aa36e 100644 (file)
@@ -563,6 +563,15 @@ symbol.  Perhaps you need to predeclare a subroutine?
 compiler saw no other uses of that namespace before that point.  Perhaps
 you need to predeclare a package?
 
+=item Bareword filehandle "%s" not allowed under 'no feature "bareword_filehandles"'
+
+(F) You attempted to use a bareword filehandle with the
+C<bareword_filehandles> feature disabled.
+
+Only the built-in handles C<STDIN>, C<STDOUT>, C<STDERR>, C<ARGV>,
+C<ARGVOUT> and C<DATA> can be used with the C<bareword_filehandles>
+feature disabled.
+
 =item BEGIN failed--compilation aborted
 
 (F) An untrapped exception was raised while executing a BEGIN
diff --git a/proto.h b/proto.h
index 46e69cc..333dde1 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2533,6 +2533,9 @@ PERL_CALLCONV char*       Perl_ninstr(const char* big, const char* bigend, const char*
 #define PERL_ARGS_ASSERT_NINSTR        \
        assert(big); assert(bigend); assert(little); assert(lend)
 
+PERL_CALLCONV void     Perl_no_bareword_filehandle(pTHX_ const char *fhname);
+#define PERL_ARGS_ASSERT_NO_BAREWORD_FILEHANDLE        \
+       assert(fhname)
 PERL_CALLCONV_NO_RET void      Perl_noperl_die(const char* pat, ...)
                        __attribute__noreturn__
                        __attribute__format__(__printf__,1,2);
index 7ef071b..e626ca9 100755 (executable)
@@ -39,6 +39,7 @@ my %feature = (
     isa             => 'isa',
     indirect        => 'indirect',
     multidimensional => 'multidimensional',
+    bareword_filehandles => 'bareword_filehandles',
 );
 
 # NOTE: If a feature is ever enabled in a non-contiguous range of Perl
@@ -48,7 +49,7 @@ my %feature = (
 # 5.odd implies the next 5.even, but an explicit 5.even can override it.
 
 # features bundles
-use constant V5_9_5 => sort qw{say state switch indirect multidimensional};
+use constant V5_9_5 => sort qw{say state switch indirect multidimensional bareword_filehandles};
 use constant V5_11  => sort ( +V5_9_5, qw{unicode_strings} );
 use constant V5_15  => sort ( +V5_11, qw{unicode_eval evalbytes current_sub fc} );
 use constant V5_23  => sort ( +V5_15, qw{postderef_qq} );
@@ -56,7 +57,7 @@ use constant V5_27  => sort ( +V5_23, qw{bitwise} );
 
 my %feature_bundle = (
     all     => [ sort keys %feature ],
-    default => [ qw{indirect multidimensional} ],
+    default => [ qw{indirect multidimensional bareword_filehandles} ],
     # using 5.9.5 features bundle
     "5.9.5" => [ +V5_9_5 ],
     "5.10"  => [ +V5_9_5 ],
@@ -476,7 +477,7 @@ read_only_bottom_close_and_rename($h);
 __END__
 package feature;
 
-our $VERSION = '1.61';
+our $VERSION = '1.62';
 
 FEATURES
 
@@ -798,6 +799,22 @@ previous versions, it was simply on all the time.
 You can use the L<multidimensional> module on CPAN to disable
 multidimensional array emulation for older versions of Perl.
 
+=head2 The 'bareword_filehandles' feature.
+
+This feature enables bareword filehandles for builtin functions
+operations, a generally discouraged practice.  It is enabled by
+default, but can be turned off to disable bareword filehandles, except
+for the exceptions listed below.
+
+The perl built-in filehandles C<STDIN>, C<STDOUT>, C<STDERR>, C<DATA>,
+C<ARGV>, C<ARGVOUT> and the special C<_> are always enabled.
+
+This feature is enabled under this name from Perl 5.34 onwards.  In
+previous versions it was simply on all the time.
+
+You can use the L<bareword::filehandles> module on CPAN to disable
+bareword filehandles for older versions of perl.
+
 =head1 FEATURE BUNDLES
 
 It's possible to load multiple features together, using
diff --git a/t/lib/feature/bareword_filehandles b/t/lib/feature/bareword_filehandles
new file mode 100644 (file)
index 0000000..7eba757
--- /dev/null
@@ -0,0 +1,486 @@
+Test no feature bareword_filehandles
+
+todo:
+
+print HANDLE
+print HANDLE LIST
+printf HANDLE
+printf HANDLE LIST
+say HANDLE
+say HANDLE LIST
+readline
+<> / <HANDLE>
+<<>> - has an implicit argument
+truncate
+stat
+-X
+lstat
+open
+close
+eof
+fileno
+flock
+getc
+read
+write ?
+seek
+tell
+select
+sysopen
+sysread
+syswrite
+sysseek
+pipe
+
+socket
+connect
+bind
+listen
+recv
+send
+setsockopt
+getsockopt
+shutdown
+socketpair
+accept
+getpeername
+getsockname
+
+binmode
+ioctl
+fcntl
+chmod - doesn't accept bareword handles
+chown - doesn't accept bareword handles
+
+opendir
+closedir
+readdir
+seekdir
+telldir
+rewinddir
+chdir
+
+also check
+
+sort
+map
+grep
+
+aren't modified
+
+
+__END__
+# NAME defaults and explicitly on
+#!perl -c
+use File::Temp qw(tempfile);
+use Fcntl qw(SEEK_SET);
+use Socket;
+my ($fh, $name) = tempfile;
+open FOO, ">", File::Spec->devnull;
+print FOO;
+print FOO "Hello";
+printf FOO "Hello";
+seek FOO, 0, SEEK_SET;
+truncate FOO, 0;
+print FOO "Something read\n";
+close FOO;
+<FOO>;
+{
+    local *ARGV;
+    local *ARGVOUT;
+    @ARGV = $name;
+    <<>>;
+    <>;
+}
+pipe FH1, FH2;
+socketpair S1, S2, AF_UNIX, SOCK_STREAM, PF_UNSPEC;
+shutdown S1, 0;
+
+use feature "bareword_filehandles";
+open FOO, ">", File::Spec->devnull;
+print FOO;
+print FOO "Hello";
+printf FOO "Hello";
+seek FOO, 0, SEEK_SET;
+truncate FOO, 0;
+print FOO "Something read\n";
+close FOO;
+<FOO>;
+{
+    local *ARGV;
+    local *ARGVOUT;
+    @ARGV = $name;
+    <<>>;
+    <>;
+}
+pipe FH3, FH4;
+socketpair S3, S4, AF_UNIX, SOCK_STREAM, PF_UNSPEC;
+shutdown S3, 0;
+
+EXPECT
+- syntax OK
+########
+# NAME check atan2() with a handle doesn't trigger bareword filehandle errors
+no feature "bareword_filehandles", "indirect";
+my $x = atan2(FOO 1, 2);
+# my original approach to this hooked newGVREF(), which the parsing for most LOPs (as with
+# atan2() above) could end up calling newGVREF(), producing an unexpected error message.
+EXPECT
+OPTIONS fatal
+Number found where operator expected at - line 2, near "FOO 1"
+       (Do you need to predeclare FOO?)
+Missing comma after first argument to atan2 function at - line 2, near "2)"
+Execution of - aborted due to compilation errors.
+########
+# NAME print HANDLE LIST, printf HANDLE LIST, print HANDLE, printf HANDLE
+use File::Spec;
+open FOO, ">", File::Spec->devnull or die $!;
+$_ = "abc";
+print FOO "test\n";
+printf FOO "test\n";
+print FOO;
+printf FOO;
+no feature "bareword_filehandles";
+print FOO "test2\n";
+printf FOO "test2\n";
+print FOO;
+printf FOO;
+print STDERR;
+print STDOUT;
+print ARGV;
+print ARGVOUT;
+print DATA;
+print STDIN;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 10.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 11.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 12.
+Execution of - aborted due to compilation errors.
+########
+# NAME say HANDLE LIST, say HANDLE
+use File::Spec;
+use feature "say";
+open FOO, ">", File::Spec->devnull or die $!;
+$_ = "abc";
+say FOO "test\n";
+say FOO;
+no feature "bareword_filehandles";
+say FOO "test2\n";
+say FOO;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9.
+Execution of - aborted due to compilation errors.
+########
+# NAME readline FOO, readline, <>, <FOO>
+use File::Spec;
+open FOO, "<", File::Spec->devnull or die $!;
+my $x = readline FOO;
+$x .= readline FOO; # rcatline
+$x = readline(FOO); # parsed a little differently with ()
+$x .= readline(FOO);
+$x = <FOO>;
+$x .= <FOO>;
+no feature "bareword_filehandles";
+$x = readline FOO;
+$x .= readline FOO; # rcatline
+$x = readline(FOO); # parsed a little differently with ()
+$x .= readline(FOO);
+$x = <FOO>;
+$x .= <FOO>;
+$x = readline STDIN;
+$x = <STDIN>;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 10.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 11.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 12.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 13.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 14.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 15.
+Execution of - aborted due to compilation errors.
+########
+# NAME truncate
+use strict;
+use warnings;
+# if all goes well this doesn't run anyway
+my $name = "bare$$.tmp";
+END { unlink $name if $name; }
+open FOO, ">", $name or die;
+print FOO "Non-zero length data\n";
+truncate FOO, 2;
+no feature "bareword_filehandles";
+truncate FOO, 1;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 10.
+Execution of - aborted due to compilation errors.
+########
+# NAME stat, lstat, -X
+use File::Spec;
+open FOO, "<", File::Spec->devnull;
+my @x = stat FOO;
+@x = lstat FOO;
+my $x = -s FOO;
+no feature "bareword_filehandles";
+@x = stat FOO;
+@x = lstat FOO;
+$x = -s FOO;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9.
+Execution of - aborted due to compilation errors.
+########
+# NAME open, close, eof, fileno
+use File::Spec;
+open FOO, "<", File::Spec->devnull;
+my $x = eof FOO;
+$x = fileno FOO;
+close FOO;
+no feature "bareword_filehandles";
+open FOO, "<", File::Spec->devnull;
+$x = eof FOO;
+$x = fileno FOO;
+close FOO;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 10.
+Execution of - aborted due to compilation errors.
+########
+# NAME flock
+use Fcntl ":flock";
+open FOO, "<", $0 or die;
+flock FOO, LOCK_SH;
+no feature "bareword_filehandles";
+flock FOO, LOCK_UN;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 5.
+Execution of - aborted due to compilation errors.
+########
+# NAME getc, read, seek, tell
+open FOO, "<", $0 or die;
+my $x = getc FOO;
+read(FOO, $x, 1);
+$x = tell FOO;
+seek FOO, 0, 0;
+no feature "bareword_filehandles";
+$x = getc FOO;
+read(FOO, $x, 1);
+$x = tell FOO;
+seek FOO, 0, 0;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 10.
+Execution of - aborted due to compilation errors.
+########
+# NAME select
+open FOO, "<", $0 or die;
+my $old = select FOO;
+no feature "bareword_filehandles";
+select FOO;
+select $old;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 4.
+Execution of - aborted due to compilation errors.
+########
+# NAME sysopen, sysread, syswrite, sysseek
+use Fcntl;
+use File::Spec;
+sysopen FOO, File::Spec->devnull, O_RDWR or die;
+sysread FOO, my $x, 10;
+syswrite FOO, "Test";
+my $y = sysseek FOO, 0, SEEK_CUR;
+close FOO;
+no feature "bareword_filehandles";
+sysopen FOO, File::Spec->devnull, O_RDWR or die;
+sysread FOO, my $x, 10;
+syswrite FOO, "Test";
+my $y = sysseek FOO, 0, SEEK_CUR;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 10.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 11.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 12.
+Execution of - aborted due to compilation errors.
+########
+# NAME pipe
+my $fh;
+pipe IN, $fh;
+pipe $fh, OUT;
+pipe IN, OUT;
+no feature "bareword_filehandles";
+pipe IN, $fh;
+pipe $fh, OUT;
+pipe IN, OUT;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "IN" not allowed under 'no feature "bareword_filehandles"' at - line 6.
+Bareword filehandle "OUT" not allowed under 'no feature "bareword_filehandles"' at - line 7.
+Bareword filehandle "IN" not allowed under 'no feature "bareword_filehandles"' at - line 8.
+Bareword filehandle "OUT" not allowed under 'no feature "bareword_filehandles"' at - line 8.
+Execution of - aborted due to compilation errors.
+########
+# NAME socket, connect, bind, listen
+my $fh;
+# this won't run, just use dummy values for domain, type, protocol
+socket(FOO, 0, 0,0);
+connect(FOO, "abc");
+bind(FOO, "abc");
+listen(FOO, 5);
+no feature "bareword_filehandles";
+socket(FOO, 0, 0,0);
+connect(FOO, "abc");
+bind(FOO, "abc");
+listen(FOO, 5);
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 10.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 11.
+Execution of - aborted due to compilation errors.
+########
+# NAME accept
+accept(FOO, CHILD);
+accept($fh, CHILD);
+accept(FOO, $fh);
+no feature "bareword_filehandles";
+accept(FOO, CHILD);
+accept($fh, CHILD);
+accept(FOO, $fh);
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 5.
+Bareword filehandle "CHILD" not allowed under 'no feature "bareword_filehandles"' at - line 5.
+Bareword filehandle "CHILD" not allowed under 'no feature "bareword_filehandles"' at - line 6.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7.
+Execution of - aborted due to compilation errors.
+########
+# NAME send, recv, setsockopt, getsockopt
+send FOO, "abc", 0;
+recv FOO, my $x, 10, 0;
+setsockopt FOO, 0, 0, 0;
+my $y = getsockopt FOO, 0, 0;
+no feature "bareword_filehandles";
+send FOO, "abc", 0;
+recv FOO, my $x, 10, 0;
+setsockopt FOO, 0, 0, 0;
+my $y = getsockopt FOO, 0, 0;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 6.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9.
+Execution of - aborted due to compilation errors.
+########
+# NAME shutdown, getsockname, getpeername
+shutdown FOO, 0;
+my $sockname = getsockname FOO;
+my $peername = getpeername FOO;
+no feature "bareword_filehandles";
+shutdown FOO, 0;
+$sockname = getsockname FOO;
+$peername = getpeername FOO;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 5.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 6.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7.
+Execution of - aborted due to compilation errors.
+########
+# NAME socketpair
+my $fh;
+socketpair IN, $fh, 0, 0, 0;
+socketpair $fh, OUT, 0, 0, 0;
+socketpair IN, OUT, 0, 0, 0;
+no feature "bareword_filehandles";
+socketpair IN, $fh, 0, 0, 0;
+socketpair $fh, OUT, 0, 0, 0;
+socketpair IN, OUT, 0, 0, 0;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "IN" not allowed under 'no feature "bareword_filehandles"' at - line 6.
+Bareword filehandle "OUT" not allowed under 'no feature "bareword_filehandles"' at - line 7.
+Bareword filehandle "IN" not allowed under 'no feature "bareword_filehandles"' at - line 8.
+Bareword filehandle "OUT" not allowed under 'no feature "bareword_filehandles"' at - line 8.
+Execution of - aborted due to compilation errors.
+########
+# NAME binmode, ioctl, fcntl
+binmode FOO;
+binmode FOO, ":raw";
+ioctl FOO, 0, 0;
+fcntl FOO, 0, 0;
+no feature "bareword_filehandles";
+binmode FOO;
+binmode FOO, ":raw";
+ioctl FOO, 0, 0;
+fcntl FOO, 0, 0;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 6.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9.
+Execution of - aborted due to compilation errors.
+########
+# NAME opendir, closedir, readdir
+opendir FOO, ".";
+my @x = readdir FOO;
+chdir FOO;
+closedir FOO;
+no feature "bareword_filehandles";
+opendir FOO, ".";
+my @x = readdir FOO;
+chdir FOO;
+closedir FOO;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 6.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9.
+Execution of - aborted due to compilation errors.
+########
+# NAME seekdir, telldir, rewinddir
+use strict;
+my $x = telldir FOO;
+seekdir FOO, $x;
+rewinddir FOO;
+no feature "bareword_filehandles";
+my $x = telldir FOO;
+seekdir FOO, $x;
+rewinddir FOO;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 6.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8.
+Execution of - aborted due to compilation errors.
+########
+# NAME file tests
+-T FOO;
+-s FOO;
+no feature "bareword_filehandles";
+-T FOO;
+-s FOO;
+-s _;
+EXPECT
+OPTIONS fatal
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 4.
+Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 5.
+Execution of - aborted due to compilation errors.
index 5783359..cc720a0 100644 (file)
@@ -415,4 +415,5 @@ porting/release_managers_guide.pod  Verbatim line length including indents exceed
 porting/todo.pod       ? Should you be using F<...> or maybe L<...> instead of 1
 lib/benchmark.pm       Verbatim line length including indents exceeds 78 by    2
 lib/config.pod ? Should you be using L<...> instead of -1
+lib/feature.pm Apparent broken link    1
 lib/perl5db.pl ? Should you be using L<...> instead of 1
diff --git a/toke.c b/toke.c
index f4404bd..e58db68 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -7482,6 +7482,11 @@ yyl_just_a_word(pTHX_ char *s, STRLEN len, I32 orig_keyword, struct code c)
         }
         s = SvPVX(PL_linestr) + s_off;
 
+        if (((PL_opargs[PL_last_lop_op] >> OASHIFT) & 7) == OA_FILEREF
+            && !FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED) {
+            no_bareword_filehandle(PL_tokenbuf);
+        }
+
         /* If not a declared subroutine, it's an indirect object. */
         /* (But it's an indir obj regardless for sort.) */
         /* Also, if "_" follows a filetest operator, it's a bareword */
@@ -11096,6 +11101,11 @@ S_scan_inputsymbol(pTHX_ char *start)
                            newCVREF(0, newGVOP(OP_GV, 0, gv_readline))))
                 : newUNOP(OP_READLINE, nomagicopen ? OPf_SPECIAL : 0, newGVOP(OP_GV, 0, gv));
            pl_yylval.ival = OP_NULL;
+
+            /* leave the token generation above to avoid confusing the parser */
+            if (!FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED) {
+                no_bareword_filehandle(d);
+            }
        }
     }