Have close() set $! and $^E

This is what we used to get when close reported an error after a print
failure (‘Disk Image’ is a small disk image I made):

$ ./miniperl -Ilib -e 'open fh, ">/Volumes/Disk Image/foo"; print fh "x"x1000, "\n" for 1..50; unlink "ntoeuhnteo"; warn $!; close fh or die "error closing: $!"'
No such file or directory at -e line 1.
error closing: No such file or directory at -e line 1.

Notice how the value of $! as set by unlink is still present after
close fails.  So that means after close returns false, you can’t
depend on $! to have the reason for the failure, because it might come
from an unrelated system call.  Remove the ‘unlink’ statement and you
get ‘No space left on device’.

As of this commit, the output is more helpful:

$ ./miniperl -Ilib -e 'open fh, ">/Volumes/Disk Image/foo"; print fh "x"x1000, "\n" for 1..50; unlink "ntoeuhnteo"; warn $!; close fh or die "error closing: $!"'
No such file or directory at -e line 1.
error closing: No space left on device at -e line 1.

Three commits ago, I/O errors started recording the error number in
the handle itself.  Now ‘close’ restores $! and $^E to the values they
were when the I/O error associated with the closed handle occurred.

This is related to ticket #57512.

1 files changed, 8 insertions, 0 deletions

diff --git a/doio.c b/doio.c
index a09800fcde..1df3535092 100644
--- a/doio.c
+++ b/doio.c
@@ -1076,11 +1076,19 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit)
 	else {
 	    if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {		/* a socket */
 		const bool prev_err = PerlIO_error(IoOFP(io));
+#ifdef USE_PERLIO
+		if (prev_err)
+		    PerlIO_restore_errno(IoOFP(io));
+#endif
 		retval = (PerlIO_close(IoOFP(io)) != EOF && !prev_err);
 		PerlIO_close(IoIFP(io));	/* clear stdio, fd already closed */
 	    }
 	    else {
 		const bool prev_err = PerlIO_error(IoIFP(io));
+#ifdef USE_PERLIO
+		if (prev_err)
+		    PerlIO_restore_errno(IoIFP(io));
+#endif
 		retval = (PerlIO_close(IoIFP(io)) != EOF && !prev_err);
 	    }
 	}