t/op/recurse.t See if deep recursion works
t/op/ref.t See if refs and objects work
t/op/repeat.t See if x operator works
+t/op/require_37033.t See if require always closes rsfp
t/op/require_errors.t See if errors from require are reported correctly
t/op/reset.t See if reset operator works
t/op/reverse.t See if reverse operator works
# define LEX_IGNORE_UTF8_HINTS 0x00000002
# define LEX_EVALBYTES 0x00000004
# define LEX_START_COPIED 0x00000008
+# define LEX_DONT_CLOSE_RSFP 0x00000010
# define LEX_START_FLAGS \
(LEX_START_SAME_FILTER|LEX_START_COPIED \
- |LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES)
+ |LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES|LEX_DONT_CLOSE_RSFP)
#endif
/* flags for parser API */
#endif
SV *linestr_sv = newSV_type(SVt_PVIV);
bool add_read_e_script = FALSE;
+ U32 lex_start_flags = 0;
PERL_SET_PHASE(PERL_PHASE_START);
rsfp = open_script(scriptname, dosearch, &suidscript);
if (!rsfp) {
rsfp = PerlIO_stdin();
+ lex_start_flags = LEX_DONT_CLOSE_RSFP;
}
validate_suid(validarg, scriptname, fdscript, suidscript,
}
#endif
- lex_start(linestr_sv, rsfp, 0);
+ lex_start(linestr_sv, rsfp, lex_start_flags);
PL_subname = newSVpvs("main");
if (add_read_e_script)
=item *
-XXX
+F<t/op/require_37033.t> has been added, to test that C<require> always closes
+the file handle that it opens. Previously, it had been leaking the file handle
+if it happened to have file descriptor 0, which would happen if C<require> was
+called (explicitly or implicitly) when C<STDIN> had been closed.
=back
--- /dev/null
+#!perl -w
+use strict;
+
+# Check that require doesn't leave the handle it uses open, if it happens that
+# the handle it opens gets file descriptor 0. RT #37033.
+
+require './test.pl';
+@INC = 'lib';
+
+sub test_require {
+ my ($state, $want) = @_;
+ delete $INC{'test_use_14937.pm'};
+ open my $fh, '<', 'README' or die "Can't open README: $!";
+ my $fileno = fileno $fh;
+ if (defined $want) {
+ is($fileno, $want,
+ "file handle has correct numeric file descriptor $state");
+ } else {
+ like($fileno, qr/\A\d+\z/,
+ "file handle has a numeric file descriptor $state");
+ }
+ close $fh or die;
+
+ is($INC{'test_use_14937.pm'}, undef, "test_use_14937 isn't loaded $state");
+ require test_use_14937;
+ isnt($INC{'test_use_14937.pm'}, undef, "test_use_14937 is loaded $state");
+
+ open $fh, '<', 'README' or die "Can't open README: $!";
+ is(fileno $fh, $fileno,
+ "file handle has the same numeric file descriptor $state");
+ close $fh or die;
+}
+
+is(fileno STDIN, 0, 'STDIN is open on file descriptor 0');
+test_require('(STDIN open)');
+
+close STDIN or die "Can't close STDIN: $!";
+
+is(fileno STDIN, undef, 'STDIN is closed');
+test_require('(STDIN closed)', 0);
+
+done_testing();
*/
/* LEX_START_SAME_FILTER indicates that this is not a new file, so it
- can share filters with the current parser. */
+ can share filters with the current parser.
+ LEX_START_DONT_CLOSE indicates that the file handle wasn't opened by the
+ caller, hence isn't owned by the parser, so shouldn't be closed on parser
+ destruction. This is used to handle the case of defaulting to reading the
+ script from the standard input because no filename was given on the command
+ line (without getting confused by situation where STDIN has been closed, so
+ the script handle is opened on fd 0) */
void
Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
parser->linestart = SvPVX(parser->linestr);
parser->bufend = parser->bufptr + SvCUR(parser->linestr);
parser->last_lop = parser->last_uni = NULL;
- parser->lex_flags = flags & (LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES);
+ parser->lex_flags = flags & (LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES
+ |LEX_DONT_CLOSE_RSFP);
parser->in_pod = parser->filtered = 0;
}
PL_curcop = parser->saved_curcop;
SvREFCNT_dec(parser->linestr);
- if (parser->rsfp == PerlIO_stdin())
+ if (PL_parser->lex_flags & LEX_DONT_CLOSE_RSFP)
PerlIO_clearerr(parser->rsfp);
else if (parser->rsfp && (!parser->old_parser ||
(parser->old_parser && parser->rsfp != parser->old_parser->rsfp)))
/* End of real input. Close filehandle (unless it was STDIN),
* then add implicit termination.
*/
- if ((PerlIO*)PL_parser->rsfp == PerlIO_stdin())
+ if (PL_parser->lex_flags & LEX_DONT_CLOSE_RSFP)
PerlIO_clearerr(PL_parser->rsfp);
else if (PL_parser->rsfp)
(void)PerlIO_close(PL_parser->rsfp);