From 3827daf4d953d0c988d37cb9ac65117a8a0424c4 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sun, 20 Dec 2020 22:11:49 +0100 Subject: [PATCH 1/4] file.d: clean up ecl_stream_open Previous implementation was messy and contained several race conditions (multiple open/close operations on the same file, first checking whether the file exists before opening it). We now always use a single open call and then optionally do an fdopen later on (exception being :rename which contains an unavoidable race condition between checking whether the file exists and then renaming it later on). Also improve error messages. --- src/c/file.d | 155 ++++++++++++++++++++++++----------------------- src/h/internal.h | 4 ++ 2 files changed, 82 insertions(+), 77 deletions(-) diff --git a/src/c/file.d b/src/c/file.d index 13ad5748e..df87a3999 100755 --- a/src/c/file.d +++ b/src/c/file.d @@ -2615,17 +2615,6 @@ safe_close(int f) return output; } -static FILE * -safe_fopen(const char *filename, const char *mode) -{ - const cl_env_ptr the_env = ecl_process_env(); - FILE *output; - ecl_disable_interrupts_env(the_env); - output = fopen(filename, mode); - ecl_enable_interrupts_env(the_env); - return output; -} - static FILE * safe_fdopen(int fildes, const char *mode) { @@ -5250,14 +5239,30 @@ FEinvalid_option(cl_object option, cl_object value) FEerror("Invalid value op option ~A: ~A", 2, option, value); } +static int +smmode_to_open_flag(enum ecl_smmode smm) +{ + switch (smm) { + case ecl_smm_probe: + case ecl_smm_input: + return O_RDONLY; + case ecl_smm_output: + return O_WRONLY; + case ecl_smm_io: + return O_RDWR; + default: + FEerror("Illegal stream mode ~S", 1, ecl_make_fixnum(smm)); + } +} + cl_object ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, int flags, cl_object external_format) { - cl_object output, file_kind; - int fd; - bool appending = 0, exists; + cl_object output; + int fd, open_flags = smmode_to_open_flag(smm) | O_BINARY; + bool appending = 0; #if defined(ECL_MS_WINDOWS_HOST) ecl_mode_t mode = _S_IREAD | _S_IWRITE; #else @@ -5267,91 +5272,87 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, remembers the original pathname FN. -- jd 2020-03-27 */ cl_object filename = si_coerce_to_filename(fn); char *fname = (char*)filename->base_string.self; - file_kind = si_file_kind(filename, ECL_T); - exists = file_kind != ECL_NIL; - if (!exists) { - if (if_does_not_exist == ECL_NIL) return ECL_NIL; - if (if_does_not_exist == @':error') FEcannot_open(fn); - if (if_does_not_exist != @':create') - FEinvalid_option(@':if-does-not-exist', if_does_not_exist); - fd = safe_open(fname, O_WRONLY|O_CREAT, mode); - unlikely_if (fd < 0) FEcannot_open(fn); - safe_close(fd); - fd = -1; + + if (if_does_not_exist == @':create') { + open_flags |= O_CREAT; + if ((smm == ecl_smm_output || smm == ecl_smm_io) && + (if_exists == ECL_NIL || if_exists == @':error' || if_exists == @':rename')) { + open_flags |= O_EXCL; + } + } else if (if_does_not_exist != ECL_NIL && if_does_not_exist != @':error') { + FEinvalid_option(@':if-does-not-exist', if_does_not_exist); } - switch (smm) { - case ecl_smm_probe: + if (if_exists == @':rename_and_delete' || + if_exists == @':new_version' || + if_exists == @':supersede' || + if_exists == @':truncate') { + if (smm == ecl_smm_output || smm == ecl_smm_io) { + open_flags |= O_TRUNC; + } + } else if (if_exists == @':append') { + if (smm == ecl_smm_output || smm == ecl_smm_io) { + appending = 1; + } + } else if (if_exists != ECL_NIL && + if_exists != @':error' && + if_exists != @':rename' && + if_exists != @':overwrite') { + FEinvalid_option(@':if-exists', if_exists); + } + + fd = safe_open(fname, open_flags, mode); + if (fd < 0) { + if (errno == ENOENT && if_does_not_exist == ECL_NIL) { + return ECL_NIL; + } else if (errno == EEXIST) { + if (if_exists == ECL_NIL) { + safe_close(fd); + return ECL_NIL; + } else if (if_exists == @':error') { + safe_close(fd); + FEcannot_open(fn); + } else if (if_exists == @':rename') { + safe_close(fd); + fd = ecl_backup_open(fname, smmode_to_open_flag(smm)|O_CREAT, mode); + unlikely_if (fd < 0) FEcannot_open(fn); + } + } else { + FEcannot_open(fn); + } + } + + if (smm == ecl_smm_probe) { + safe_close(fd); output = ecl_make_file_stream_from_fd(fn, -1, smm, byte_size, flags, external_format); generic_close(output); return output; - case ecl_smm_input: - fd = safe_open(fname, O_RDONLY|O_NONBLOCK, mode); - unlikely_if (fd < 0) FEcannot_open(fn); - break; - case ecl_smm_output: - /* For output we could have used O_WRONLY, but this doesn't matter because - we fopen with OPEN_RW later anyway. stream opts enforce things. */ - case ecl_smm_io: { - if (exists) { - if (if_exists == ECL_NIL) return ECL_NIL; - if (if_exists == @':error') FEcannot_open(fn); - if (if_exists == @':rename') { - fd = ecl_backup_open(fname, O_RDWR|O_CREAT, mode); - unlikely_if (fd < 0) FEcannot_open(fn); - } else if (if_exists == @':rename_and_delete' || - if_exists == @':new_version' || - if_exists == @':supersede' || - if_exists == @':truncate') { - fd = safe_open(fname, O_RDWR|O_TRUNC, mode); - unlikely_if (fd < 0) FEcannot_open(fn); - } else if (if_exists == @':overwrite' || if_exists == @':append') { - fd = safe_open(fname, O_RDWR, mode); - unlikely_if (fd < 0) FEcannot_open(fn); - appending = (if_exists == @':append'); - } else { - FEinvalid_option(@':if-exists', if_exists); - } - } - break; - } - default: - FEerror("Illegal stream mode ~S", 1, ecl_make_fixnum(smm)); } if (flags & ECL_STREAM_C_STREAM) { FILE *fp = 0; - /* We do not use fdopen() because Windows seems to have problems with the - * resulting streams. Furthermore, even for output we open with w+ because - * we do not want to overwrite the file. */ switch (smm) { case ecl_smm_probe: /* never happens (returns earlier) */ case ecl_smm_input: - if (file_kind == @':fifo') { - fp = safe_fdopen(fd, OPEN_R); - } else { - if (fd >= 0) - safe_close(fd); - fp = safe_fopen(fname, OPEN_R); - } + fp = safe_fdopen(fd, OPEN_R); break; case ecl_smm_output: + fp = safe_fdopen(fd, OPEN_W); + break; case ecl_smm_io: - if (file_kind == @':fifo') { - fp = safe_fdopen(fd, OPEN_RW); - } else { - if (fd >= 0) - safe_close(fd); - fp = safe_fopen(fname, OPEN_RW); - } + fp = safe_fdopen(fd, OPEN_RW); break; default:; /* never reached (errors earlier) */ } + if (fp == NULL) { + FEcannot_open(fn); + } output = ecl_make_stream_from_FILE(fn, fp, smm, byte_size, flags, external_format); si_set_buffering_mode(output, byte_size? @':full' : @':line'); } else { output = ecl_make_file_stream_from_fd(fn, fd, smm, byte_size, flags, external_format); } + output->stream.flags |= ECL_STREAM_MIGHT_SEEK; si_set_finalizer(output, ECL_T); /* Set file pointer to the correct position */ @@ -5703,7 +5704,7 @@ file_libc_error(cl_object error_type, cl_object stream, rest = cl_grab_rest_args(args); ecl_va_end(args); - si_signal_simple_error(4, (cl_object)(cl_symbols + ecl_fixnum(error_type)), Cnil, + si_signal_simple_error(4, (cl_object)(cl_symbols + ecl_fixnum(error_type)), ECL_NIL, ecl_make_constant_base_string("~?~%C library explanation: ~A.",-1), cl_list(3, ecl_make_constant_base_string(msg,-1), rest, error)); diff --git a/src/h/internal.h b/src/h/internal.h index 9237241ce..3579987d7 100755 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -237,6 +237,10 @@ extern enum ecl_ffi_tag ecl_foreign_type_code(cl_object type); #ifndef O_NONBLOCK #define O_NONBLOCK 0 #endif +/* Windows needs to be told explicitely to open files in binary mode */ +#ifndef O_BINARY +#define O_BINARY 0 +#endif #define ECL_FILE_STREAM_P(strm) \ (ECL_ANSI_STREAM_P(strm) && (strm)->stream.mode < ecl_smm_synonym) From da26facffae372f55fba9a177e9df5977ee78003 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Tue, 22 Dec 2020 19:14:00 +0100 Subject: [PATCH 2/4] file.d: introduce :nonblock and :close-on-exec options for open Maps directly to flags for open syscall. Ignored on Windows. We now let the user decide whether to open fifos in nonblocking mode or not. Manual has been extended to document the new extensions and slightly rearranged to put the important information first. --- src/c/file.d | 14 ++++ src/c/symbols_list.h | 2 + src/doc/manual/extensions/osi.txi | 10 +-- src/doc/manual/standards/streams.txi | 116 +++++++++++++++------------ src/h/internal.h | 3 + src/h/object.h | 4 +- 6 files changed, 92 insertions(+), 57 deletions(-) diff --git a/src/c/file.d b/src/c/file.d index df87a3999..3f72dba91 100755 --- a/src/c/file.d +++ b/src/c/file.d @@ -5299,6 +5299,12 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, if_exists != @':overwrite') { FEinvalid_option(@':if-exists', if_exists); } + if (flags & ECL_STREAM_CLOSE_ON_EXEC) { + open_flags |= O_CLOEXEC; + } + if (flags & ECL_STREAM_NONBLOCK) { + open_flags |= O_NONBLOCK; + } fd = safe_open(fname, open_flags, mode); if (fd < 0) { @@ -5367,6 +5373,8 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, (if_does_not_exist ECL_NIL idnesp) (external_format @':default') (cstream ECL_T) + (close_on_exec ECL_T) + (nonblock ECL_NIL) &aux strm) enum ecl_smmode smm; int flags = 0; @@ -5414,6 +5422,12 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, if (!Null(cstream)) { flags |= ECL_STREAM_C_STREAM; } + if (!Null(close_on_exec)) { + flags |= ECL_STREAM_CLOSE_ON_EXEC; + } + if (!Null(nonblock)) { + flags |= ECL_STREAM_NONBLOCK; + } strm = ecl_open_stream(filename, smm, if_exists, if_does_not_exist, byte_size, flags, external_format); @(return strm); diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 4666ba636..d18cdd07f 100755 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1359,6 +1359,7 @@ cl_symbols[] = { {KEY_ "CATCH" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "CASE" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "CIRCLE" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, +{KEY_ "CLOSE-ON-EXEC" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "COMPILE-TOPLEVEL" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "COMMON" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "CONC-NAME" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, @@ -1435,6 +1436,7 @@ cl_symbols[] = { {KEY_ "NEW-VERSION" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "NEWEST" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "NICKNAMES" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, +{KEY_ "NONBLOCK" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "OBJECT" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "OFFSET" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, {KEY_ "OPERATION" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)}, diff --git a/src/doc/manual/extensions/osi.txi b/src/doc/manual/extensions/osi.txi index 68a225096..1fe6495f1 100644 --- a/src/doc/manual/extensions/osi.txi +++ b/src/doc/manual/extensions/osi.txi @@ -293,11 +293,11 @@ Controls escaping of the arguments passed to @code{CreateProcess}. @subsection FIFO files (named pipes) Named pipe (known as fifo) may be created on UNIX with a shell command -mkfifo. ECL opens such files in non-blocking -mode. @coderef{ext:file-kind} will return for such file -@code{:fifo}. Since it is impossible to guess how many characters are -available in this special file @code{file-length} function will return -NIL. +mkfifo. They can be opened in non-blocking mode by using @code{:nonblock +t} option for @coderef{open}. @coderef{ext:file-kind} will return for +such file @code{:fifo}. Since it is impossible to guess how many +characters are available in this special file @code{file-length} +function will return @code{nil}. @node Operating System Interface Reference @subsection Operating System Interface Reference diff --git a/src/doc/manual/standards/streams.txi b/src/doc/manual/standards/streams.txi index 56cbc1494..698578d08 100644 --- a/src/doc/manual/standards/streams.txi +++ b/src/doc/manual/standards/streams.txi @@ -108,59 +108,23 @@ and the table of known symbols is shown below. Note how some symbols (@code{:cr} @node Streams - Dictionary @subsection Dictionary -@subsubsection Sequence Streams - -@lspdef ext:sequence-stream -@deftp {System Class} ext:sequence-stream - -@paragraph Class Precedence List -@coderef{ext:sequence-stream}, @code{stream}, @code{t} - -@paragraph Description -Sequence streams work similar to string streams for vectors. The -supplied vectors that the streams read from or write to must have a -byte sized element type, i.e. @code{(signed-byte 8)}, -@code{(unsigned-byte 8)} or @code{base-char}. - -The semantics depend on the vector element type and the external -format of the stream. If no external format is supplied and the -element type is an integer type, the stream is a binary stream and -accepts only integers of the same type as the element type of the -vector. Otherwise, the stream accepts both characters and integers and -converts them using the given external format. If the element type is -@code{base-char}, the elements of the vectors are treated as bytes. -This means that writing a character may use multiple elements of the -vector, whose @code{char-code}s will be equal to the values of the -bytes comprising the character in the given external format. -@end deftp - -@lspdef ext:make-sequence-input-stream -@defun ext:make-sequence-input-stream vector &key (start 0) (end nil) (external-format nil) -Create a sequence input stream with the subsequence bounded by -@var{start} and @var{end} of the given vector. -@end defun -@lspdef ext:make-sequence-output-stream -@defun ext:make-sequence-output-stream vector &key (external-format nil) -Create a sequence output stream. -@end defun - -@exindex Using sequence streams -Example: - -Using sequence streams to convert to a UTF8 encoded base string -@lisp -CL-USER> (defvar *output* (make-array 20 :element-type 'base-char :adjustable t :fill-pointer 0)) -*OUTPUT* -CL-USER> (defvar *stream* (ext:make-sequence-output-stream *output* :external-format :utf-8)) -*STREAM* -CL-USER> (write-string "Spätzle mit Soß'" *stream*) -"Spätzle mit Soß'" -CL-USER> *output* -"Spätzle mit SoÃ\237'" -@end lisp - @subsubsection File Stream Extensions +@lspdef open +@defun open filespec &key direction element-type if-exists if-does-not-exist external-format close-on-exec nonblock +Additional options for @clhs{f_open.htm,open} include: +@table @code +@item :close-on-exec +Child processes don't inherit a copy of this stream: new processes +created by @code{fork} and @code{exec} (for example by calling +@coderef{ext:run-program}) close the stream after calling @code{exec}. +Defaults to @code{t}. +@item :nonblock +Open fifos or device files in nonblocking mode. Defaults to @code{nil}. +@end table +These options are ignored on operating systems which do not support them. +@end defun + @lspdef ext:set-buffering-mode @defun ext:set-buffering-mode stream mode Control the buffering mode of a stream @@ -303,6 +267,56 @@ that the error can be ignored or the octets can be replaced with a character. @end defun +@subsubsection Sequence Streams + +@lspdef ext:sequence-stream +@deftp {System Class} ext:sequence-stream + +@paragraph Class Precedence List +@coderef{ext:sequence-stream}, @code{stream}, @code{t} + +@paragraph Description +Sequence streams work similar to string streams for vectors. The +supplied vectors that the streams read from or write to must have a +byte sized element type, i.e. @code{(signed-byte 8)}, +@code{(unsigned-byte 8)} or @code{base-char}. + +The semantics depend on the vector element type and the external +format of the stream. If no external format is supplied and the +element type is an integer type, the stream is a binary stream and +accepts only integers of the same type as the element type of the +vector. Otherwise, the stream accepts both characters and integers and +converts them using the given external format. If the element type is +@code{base-char}, the elements of the vectors are treated as bytes. +This means that writing a character may use multiple elements of the +vector, whose @code{char-code}s will be equal to the values of the +bytes comprising the character in the given external format. +@end deftp + +@lspdef ext:make-sequence-input-stream +@defun ext:make-sequence-input-stream vector &key (start 0) (end nil) (external-format nil) +Create a sequence input stream with the subsequence bounded by +@var{start} and @var{end} of the given vector. +@end defun +@lspdef ext:make-sequence-output-stream +@defun ext:make-sequence-output-stream vector &key (external-format nil) +Create a sequence output stream. +@end defun + +@exindex Using sequence streams +Example: + +Using sequence streams to convert to a UTF8 encoded base string +@lisp +CL-USER> (defvar *output* (make-array 20 :element-type 'base-char :adjustable t :fill-pointer 0)) +*OUTPUT* +CL-USER> (defvar *stream* (ext:make-sequence-output-stream *output* :external-format :utf-8)) +*STREAM* +CL-USER> (write-string "Spätzle mit Soß'" *stream*) +"Spätzle mit Soß'" +CL-USER> *output* +"Spätzle mit SoÃ\237'" +@end lisp @node Streams - C Reference @subsection C Reference diff --git a/src/h/internal.h b/src/h/internal.h index 3579987d7..6a0a7abb2 100755 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -234,6 +234,9 @@ extern enum ecl_ffi_tag ecl_foreign_type_code(cl_object type); #define OPEN_RA "a+b" /* Windows does not have this flag (POSIX thing) */ +#ifndef O_CLOEXEC +#define O_CLOEXEC 0 +#endif #ifndef O_NONBLOCK #define O_NONBLOCK 0 #endif diff --git a/src/h/object.h b/src/h/object.h index 69023bc9a..4b2ebd3e1 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -634,7 +634,9 @@ enum { ECL_STREAM_LITTLE_ENDIAN = 128, ECL_STREAM_C_STREAM = 256, ECL_STREAM_MIGHT_SEEK = 512, - ECL_STREAM_CLOSE_COMPONENTS = 1024 + ECL_STREAM_CLOSE_COMPONENTS = 1024, + ECL_STREAM_CLOSE_ON_EXEC = 2048, + ECL_STREAM_NONBLOCK = 4096 }; /* buffer points to an array of bytes ending at buffer_end. Decode one From f0afa57b963d39315c66a884e4694dcacb069166 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Tue, 22 Dec 2020 19:15:30 +0100 Subject: [PATCH 3/4] tests: fix mix.0016.fifo-tests Use new :nonblock open flag, only test standard POSIX behaviour (POSIX leaves it undefined what happens when opening a fifo for writing in nonblocking mode while there are no readers available. Previously we were testing for behaviour as implemented by Linux). Windows has no equivalent of a named pipe that can be opened like a regular file, thus we disable the test there. --- src/tests/normal-tests/mixed.lsp | 33 ++++++++++---------------------- 1 file changed, 10 insertions(+), 23 deletions(-) diff --git a/src/tests/normal-tests/mixed.lsp b/src/tests/normal-tests/mixed.lsp index b1e9cd262..1c108dbad 100644 --- a/src/tests/normal-tests/mixed.lsp +++ b/src/tests/normal-tests/mixed.lsp @@ -256,42 +256,29 @@ ;;; Date: 2018-05-08 ;;; Description: ;;; -;;; Better handling of fifos. This test will most likely fail on Windows (this -;;; is not confirmed yet) because it does not support non-blocking -;;; operations. -;;; -;;; When we figure out what would be correct semantics for Windows this test -;;; should be disabled for that platform and a separate test case ought to be -;;; created. It is possible that it won't fail (because cygwin will handle it -;;; gracefully and/or WinAPI does not support file-pipes). +;;; Better handling of fifos. ;;; ;;; Bug: https://gitlab.com/embeddable-common-lisp/ecl/issues/242 +#-windows (test mix.0016.fifo-tests (ext:run-program "mkfifo" '("my-fifo") :output t) ;; 1) reader (first) and writer (inside) - (with-open-file (stream "my-fifo") + (with-open-file (stream "my-fifo" :nonblock t) (is (null (file-length stream))) (is (null (listen stream))) (is (eql :foo (read-line stream nil :foo))) (is (eql :fifo (ext:file-kind stream nil))) - (with-open-file (stream2 "my-fifo" :direction :output) - ;; Even for output it should not block on Linux. + (with-open-file (stream2 "my-fifo" :direction :output :nonblock t) + ;; Even for output it should not block on Unix. (finishes (write-line "foobar" stream2))) - (is (equal "foobar" (read-line stream nil :foo)))) - ;; 2) writer (first) and reader (second) - (with-open-file (stream "my-fifo" :direction :output) - (finishes (write-line "foobar" stream))) - (with-open-file (stream "my-fifo" :direction :input) ;; there is nobody on the other side, data is lost + (is (equal :foo (read-line stream nil :foo)))) + ;; 2) writer (first) and reader (second) + (signals file-error (open "my-fifo" :direction :output :nonblock t)) + (with-open-file (stream "my-fifo" :direction :input :nonblock t) (is (eql :foo (read-line stream nil :foo)))) - ;; 3) writer (first) and reader (inside) - (with-open-file (stream "my-fifo" :direction :output) - (finishes (write-line "foobar" stream)) - (with-open-file (stream2 "my-fifo" :direction :input) - ;; Even for output it should not block on Linux. - (is (equal "foobar" (read-line stream2 nil :foo))))) ;; clean up - (ext:run-program "rm" '("-rf" "my-fifo") :output t)) + (delete-file "my-fifo")) ;;; Date: 2018-12-02 From 7ddb4ada07ab77c06889c30517393e66c0d58af0 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Fri, 25 Dec 2020 19:39:45 +0100 Subject: [PATCH 4/4] error.d: FEcannot_open: improve error message --- src/c/error.d | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/c/error.d b/src/c/error.d index 20c0f4b4b..4ed815b1e 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -234,9 +234,17 @@ FEreader_error(const char *s, cl_object stream, int narg, ...) void -FEcannot_open(cl_object fn) +FEcannot_open(cl_object file) { - cl_error(3, @'file-error', @':pathname', fn); + cl_object c_error = _ecl_strerror(errno); + si_signal_simple_error + (6, @'file-error', /* condition */ + ECL_NIL, /* continuable */ + ecl_make_constant_base_string("Cannot open ~S.~%C library error: ~A",-1), /* format */ + cl_list(2, file, c_error), /* format args */ + @':pathname', /* file-error options */ + file); + _ecl_unexpected_return(); } void