The parser should always close the file handle that it opened.

Previously it would leave the file handle open if it was (equal to) stdin,
on the assumption that this must have been because no script name was
supplied on the interpreter command line, so the interpreter was defaulting
to reading the script from standard input.

However, if the program has closed STDIN, then the next file handle opened
(for any reason) will have file descriptor 0. So in this situation, the
handle that require opened to read the module would be mistaken for the above
situation and left open. Effectively, this leaked a file handle.

This is now fixed, by explicitly tracking from parser creation time whether
it should keep the file handle open, and only setting this flag when
defaulting to reading the main program from standard input. This resolves
RT #37033.

1 files changed, 42 insertions, 0 deletions

diff --git a/t/op/require_37033.t b/t/op/require_37033.t
new file mode 100644
index 0000000000..dac8568010
--- /dev/null
+++ b/t/op/require_37033.t
@@ -0,0 +1,42 @@
+#!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();