summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog48
-rw-r--r--lib.c7
-rw-r--r--lib.h2
-rw-r--r--match.c4
-rw-r--r--stream.c176
-rw-r--r--stream.h6
-rw-r--r--txr.c4
-rw-r--r--unwind.c1
8 files changed, 190 insertions, 58 deletions
diff --git a/ChangeLog b/ChangeLog
index 1b27ed8e..638b1886 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,51 @@
+2009-11-06 Kaz Kylheku <kkylheku@gmail.com>
+
+ Throw exception on stream error during close, or I/O operations. This
+ is needed for pipes that terminate abnormally or return failed
+ termination. Pipe and stdio streams have an extra description field
+ so they are printed in a readable way.
+
+ * lib.c (process_error): New global defined.
+ (obj_init): New symbol interned.
+ (lazy_stream_func): Pass t to close_stream, so exception
+ is thrown if the close fails.
+ (lazy_stream_cons): Ditto.
+
+ * lib.h (process_error): Declared.
+
+ * match.c (complex_snarf): Pass new desr argument to make_stdio_stream
+ and make_pipe_stream.
+
+ * stream.c (strm_ops): New argument on close function pointer.
+ (common_destroy): Close without throwing exception. For objects
+ being finalized, we don't care if the close works or not; the
+ program has shown that it doesn't care about the stream by
+ letting it become unreachable, so we don't bother the program
+ by throwing an exception.
+ (stdio_handle): New struct.
+ (stdio_stream_print, stdio_stream_destroy, stdio_stream_mark,
+ stdio_maybe_read_error, stdio_maybe_write_error): New functions.
+ (stdio_put_string, stdio_put_char, stdio_get_line,
+ stdio_get_char, stdio_vcformat, stdio_close): Updated to new
+ handle format, and throw errors now.
+ (stdio_ops, pipe_ops): Redirected to new functions stdio_stream_print,
+ stdio_stream_destroy and stdio_stream_mark.
+ (pipe_close): Updated to new handle format. Parses status from
+ pclose and throws exceptions appropriate to the situation.
+ (dir_close): Takes extra argument.
+ (make_stdio_stream, make_pipe_stream): New argument added.
+ (make_string_output_stream): Some casts added.
+ (close_stream): Pass new argument down to virtual function.
+ (stream_init): Pass new argument to make_stdio_stream
+ when creating streams for stdin, stdout and stderr.
+
+ * stream.h (make_stdio_stream, make_pipe_stream, close_stream):
+ Declarations updated.
+
+ * txr.c (txr_main): Pass new argument to make_stdio_stream.
+
+ * unwind.c (uw_init): Register process_error.
+
2009-11-01 Kaz Kylheku <kkylheku@gmail.com>
Version 020
diff --git a/lib.c b/lib.c
index aa17a7a5..635ab8d4 100644
--- a/lib.c
+++ b/lib.c
@@ -53,7 +53,7 @@ obj_t *define, *output, *single, *frst, *lst, *empty, *repeat, *rep;
obj_t *flattn, *forget, *local, *mrge, *bind, *cat, *args;
obj_t *try, *catch, *finally, *nothrow, *throw, *defex;
obj_t *error, *type_error, *internal_err, *numeric_err, *range_err;
-obj_t *query_error, *file_error;
+obj_t *query_error, *file_error, *process_error;
obj_t *zero, *one, *two, *negone, *maxint, *minint;
obj_t *null_string;
@@ -1338,7 +1338,7 @@ static obj_t *lazy_stream_func(obj_t *env, obj_t *lcons)
lcons->lc.func = nil;
if (!next || !ahead)
- close_stream(stream);
+ close_stream(stream, t);
if (ahead)
push(ahead, cdr_l(env));
@@ -1351,7 +1351,7 @@ obj_t *lazy_stream_cons(obj_t *stream)
obj_t *first = get_line(stream);
if (!first) {
- close_stream(stream);
+ close_stream(stream, t);
return nil;
}
@@ -1753,6 +1753,7 @@ static void obj_init(void)
range_err = intern(string("range_error"));
query_error = intern(string("query_error"));
file_error = intern(string("file_error"));
+ process_error = intern(string("process_error"));
interned_syms = cons(nil, interned_syms);
diff --git a/lib.h b/lib.h
index 45b454f5..03fede10 100644
--- a/lib.h
+++ b/lib.h
@@ -164,7 +164,7 @@ extern obj_t *define, *output, *single, *frst, *lst, *empty, *repeat, *rep;
extern obj_t *flattn, *forget, *local, *mrge, *bind, *cat, *args;
extern obj_t *try, *catch, *finally, *nothrow, *throw, *defex;
extern obj_t *error, *type_error, *internal_err, *numeric_err, *range_err;
-extern obj_t *query_error, *file_error;
+extern obj_t *query_error, *file_error, *process_error;
extern obj_t *zero, *one, *two, *negone, *maxint, *minint;
extern obj_t *null_string;
diff --git a/match.c b/match.c
index 15e98a08..0e70947b 100644
--- a/match.c
+++ b/match.c
@@ -683,9 +683,9 @@ obj_t *complex_snarf(fpip_t fp, obj_t *name)
{
switch (fp.close) {
case fpip_fclose:
- return lazy_stream_cons(make_stdio_stream(fp.f, t, nil));
+ return lazy_stream_cons(make_stdio_stream(fp.f, name, t, nil));
case fpip_pclose:
- return lazy_stream_cons(make_pipe_stream(fp.f, t, nil));
+ return lazy_stream_cons(make_pipe_stream(fp.f, name, t, nil));
case fpip_closedir:
return lazy_stream_cons(make_dir_stream(fp.d));
}
diff --git a/stream.c b/stream.c
index 01ef8ad0..c76db73a 100644
--- a/stream.c
+++ b/stream.c
@@ -31,6 +31,7 @@
#include <stdlib.h>
#include <assert.h>
#include <setjmp.h>
+#include <errno.h>
#include "lib.h"
#include "gc.h"
#include "unwind.h"
@@ -46,7 +47,7 @@ struct strm_ops {
obj_t *(*get_char)(obj_t *);
obj_t *(*vcformat)(obj_t *, const char *fmt, va_list vl);
obj_t *(*vformat)(obj_t *, const char *fmt, va_list vl);
- obj_t *(*close)(obj_t *);
+ obj_t *(*close)(obj_t *, obj_t *);
};
static obj_t *common_equal(obj_t *self, obj_t *other)
@@ -56,7 +57,7 @@ static obj_t *common_equal(obj_t *self, obj_t *other)
static void common_destroy(obj_t *obj)
{
- (void) close_stream(obj);
+ (void) close_stream(obj, nil);
}
obj_t *common_vformat(obj_t *stream, const char *fmt, va_list vl)
@@ -100,16 +101,62 @@ obj_t *common_vformat(obj_t *stream, const char *fmt, va_list vl)
return t;
}
+struct stdio_handle {
+ FILE *f;
+ obj_t *descr;
+};
+
+void stdio_stream_print(obj_t *stream, obj_t *out)
+{
+ struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
+ format(out, "#<~s ~s>", stream->co.cls, h->descr, nao);
+}
+
+void stdio_stream_destroy(obj_t *stream)
+{
+ struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
+ common_destroy(stream);
+ free(h);
+}
+
+void stdio_stream_mark(obj_t *stream)
+{
+ struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
+ gc_mark(h->descr);
+}
+
+static obj_t *stdio_maybe_read_error(obj_t *stream)
+{
+ struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
+ if (ferror(h->f)) {
+ clearerr(h->f);
+ uw_throwf(file_error, "error reading ~a: ~a/~s",
+ stream, num(errno), string(strerror(errno)));
+ }
+ return nil;
+}
+
+static obj_t *stdio_maybe_write_error(obj_t *stream)
+{
+ struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
+ if (ferror(h->f)) {
+ clearerr(h->f);
+ uw_throwf(file_error, "error writing ~a: ~a/~s",
+ stream, num(errno), string(strerror(errno)));
+ }
+ return nil;
+}
+
static obj_t *stdio_put_string(obj_t *stream, const char *s)
{
- FILE *f = (FILE *) stream->co.handle;
- return (f && fputs(s, f) != EOF) ? t : nil;
+ struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
+ return (h->f && fputs(s, h->f) != EOF) ? t : stdio_maybe_write_error(stream);
}
static obj_t *stdio_put_char(obj_t *stream, int ch)
{
- FILE *f = (FILE *) stream->co.handle;
- return (f && putc(ch, f) != EOF) ? t : nil;
+ struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
+ return (h->f && putc(ch, h->f) != EOF) ? t : stdio_maybe_write_error(stream);
}
static char *snarf_line(FILE *in)
@@ -149,41 +196,46 @@ static obj_t *stdio_get_line(obj_t *stream)
if (stream->co.handle == 0) {
return nil;
} else {
- char *line = snarf_line((FILE *) stream->co.handle);
+ struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
+ char *line = snarf_line(h->f);
if (!line)
- return nil;
+ return stdio_maybe_read_error(stream);
return string_own(line);
}
}
obj_t *stdio_get_char(obj_t *stream)
{
- FILE *f = (FILE *) stream->co.handle;
- if (f) {
- int ch = getc(f);
- return (ch != EOF) ? chr(ch) : nil;
+ struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
+ if (h->f) {
+ int ch = getc(h->f);
+ return (ch != EOF) ? chr(ch) : stdio_maybe_read_error(stream);
}
return nil;
}
obj_t *stdio_vcformat(obj_t *stream, const char *fmt, va_list vl)
{
- FILE *f = (FILE *) stream->co.handle;
- if (f) {
- int n = vfprintf(f, fmt, vl);
- return (n >= 0) ? num(n) : nil;
+ struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
+
+ if (h->f) {
+ int n = vfprintf(h->f, fmt, vl);
+ return (n >= 0) ? num(n) : stdio_maybe_write_error(stream);
}
return nil;
}
-static obj_t *stdio_close(obj_t *stream)
+static obj_t *stdio_close(obj_t *stream, obj_t *throw_on_error)
{
+ struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
- FILE *f = (FILE *) stream->co.handle;
-
- if (f != 0 && f != stdin && f != stdout) {
- int result = fclose(f);
- stream->co.handle = 0;
+ if (h->f != 0 && h->f != stdin && h->f != stdout) {
+ int result = fclose(h->f);
+ h->f = 0;
+ if (result == EOF && throw_on_error) {
+ uw_throwf(file_error, "error closing ~a: ~a/~s",
+ stream, num(errno), string(strerror(errno)));
+ }
return result != EOF ? t : nil;
}
return nil;
@@ -191,9 +243,9 @@ static obj_t *stdio_close(obj_t *stream)
static struct strm_ops stdio_ops = {
{ common_equal,
- cobj_print_op,
- common_destroy,
- 0 },
+ stdio_stream_print,
+ stdio_stream_destroy,
+ stdio_stream_mark },
stdio_put_string,
stdio_put_char,
stdio_get_line,
@@ -203,23 +255,47 @@ static struct strm_ops stdio_ops = {
stdio_close
};
-static obj_t *pipe_close(obj_t *stream)
-{
- FILE *f = (FILE *) stream->co.handle;
+static obj_t *pipe_close(obj_t *stream, obj_t *throw_on_error)
+{
+ struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
+
+ if (h->f != 0) {
+ int status = pclose(h->f);
+
+ h->f = 0;
+
+ if (status != 0 && throw_on_error) {
+ if (status < 0) {
+ uw_throwf(process_error, "unable to obtain status of command ~a: ~a/~s",
+ stream, num(errno), string(strerror(errno)), nao);
+ } else if (WIFEXITED(status)) {
+ int exitstatus = WEXITSTATUS(status);
+ uw_throwf(process_error, "pipe ~a terminated with status ~a",
+ stream, num(exitstatus), nao);
+ } else if (WIFSIGNALED(status)) {
+ int termsig = WTERMSIG(status);
+ uw_throwf(process_error, "pipe ~a terminated by signal ~a",
+ stream, num(termsig), nao);
+
+ } else if (WIFSTOPPED(status) || WIFCONTINUED(status)) {
+ uw_throwf(process_error, "processes of closed pipe ~a still running",
+ stream, nao);
+ } else {
+ uw_throwf(file_error, "strange status in when closing pipe ~a",
+ stream, nao);
+ }
+ }
- if (f != 0) {
- int result = pclose(f);
- stream->co.handle = 0;
- return result >= 0 ? t : nil;
+ return status == 0 ? t : nil;
}
return nil;
}
static struct strm_ops pipe_ops = {
{ common_equal,
- cobj_print_op,
- common_destroy,
- 0 },
+ stdio_stream_print,
+ stdio_stream_destroy,
+ stdio_stream_mark },
stdio_put_string,
stdio_put_char,
stdio_get_line,
@@ -412,7 +488,7 @@ static obj_t *dir_get_line(obj_t *stream)
}
}
-static obj_t *dir_close(obj_t *stream)
+static obj_t *dir_close(obj_t *stream, obj_t *throw_on_error)
{
if (stream->co.handle != 0) {
closedir((DIR *) stream->co.handle);
@@ -438,14 +514,20 @@ static struct strm_ops dir_ops = {
};
-obj_t *make_stdio_stream(FILE *handle, obj_t *input, obj_t *output)
+obj_t *make_stdio_stream(FILE *f, obj_t *descr, obj_t *input, obj_t *output)
{
- return cobj((void *) handle, stream_t, &stdio_ops.cobj_ops);
+ struct stdio_handle *h = (struct stdio_handle *) chk_malloc(sizeof *h);
+ h->f = f;
+ h->descr = descr;
+ return cobj((void *) h, stream_t, &stdio_ops.cobj_ops);
}
-obj_t *make_pipe_stream(FILE *handle, obj_t *input, obj_t *output)
+obj_t *make_pipe_stream(FILE *f, obj_t *descr, obj_t *input, obj_t *output)
{
- return cobj((void *) handle, stream_t, &pipe_ops.cobj_ops);
+ struct stdio_handle *h = (struct stdio_handle *) chk_malloc(sizeof *h);
+ h->f = f;
+ h->descr = descr;
+ return cobj((void *) h, stream_t, &pipe_ops.cobj_ops);
}
obj_t *make_string_input_stream(obj_t *string)
@@ -455,9 +537,9 @@ obj_t *make_string_input_stream(obj_t *string)
obj_t *make_string_output_stream(void)
{
- struct string_output *so = chk_malloc(sizeof *so);
+ struct string_output *so = (struct string_output *) chk_malloc(sizeof *so);
so->size = 128;
- so->buf = chk_malloc(so->size);
+ so->buf = (char *) chk_malloc(so->size);
so->fill = 0;
so->buf[0] = 0;
return cobj((void *) so, stream_t, &string_out_ops.cobj_ops);
@@ -494,14 +576,14 @@ obj_t *make_dir_stream(DIR *dir)
return cobj((void *) dir, stream_t, &dir_ops.cobj_ops);
}
-obj_t *close_stream(obj_t *stream)
+obj_t *close_stream(obj_t *stream, obj_t *throw_on_error)
{
type_check (stream, COBJ);
type_assert (stream->co.cls == stream_t, ("~a is not a stream", stream));
{
struct strm_ops *ops = (struct strm_ops *) stream->co.ops;
- return ops->close ? ops->close(stream) : nil;
+ return ops->close ? ops->close(stream, throw_on_error) : nil;
}
}
@@ -635,7 +717,7 @@ obj_t *put_line(obj_t *stream, obj_t *string)
void stream_init(void)
{
protect(&std_input, &std_output, &std_error, (obj_t **) 0);
- std_input = make_stdio_stream(stdin, t, nil);
- std_output = make_stdio_stream(stdout, nil, t);
- std_error = make_stdio_stream(stderr, nil, t);
+ std_input = make_stdio_stream(stdin, string("stdin"), t, nil);
+ std_output = make_stdio_stream(stdout, string("stdout"), nil, t);
+ std_error = make_stdio_stream(stderr, string("stderr"), nil, t);
}
diff --git a/stream.h b/stream.h
index 2be353f3..ba483b27 100644
--- a/stream.h
+++ b/stream.h
@@ -26,13 +26,13 @@
extern obj_t *std_input, *std_output, *std_error;
-obj_t *make_stdio_stream(FILE *, obj_t *input, obj_t *output);
-obj_t *make_pipe_stream(FILE *, obj_t *input, obj_t *output);
+obj_t *make_stdio_stream(FILE *, obj_t *descr, obj_t *input, obj_t *output);
+obj_t *make_pipe_stream(FILE *, obj_t *descr, obj_t *input, obj_t *output);
obj_t *make_string_input_stream(obj_t *);
obj_t *make_string_output_stream(void);
obj_t *get_string_from_stream(obj_t *);
obj_t *make_dir_stream(DIR *);
-obj_t *close_stream(obj_t *);
+obj_t *close_stream(obj_t *stream, obj_t *throw_on_error);
obj_t *get_line(obj_t *);
obj_t *get_char(obj_t *);
obj_t *vformat(obj_t *stream, const char *string, va_list); /* nao-terminated */
diff --git a/txr.c b/txr.c
index b7dcbe2a..c68b4d47 100644
--- a/txr.c
+++ b/txr.c
@@ -309,7 +309,7 @@ static int txr_main(int argc, char **argv)
FILE *in = fopen(c_str(spec_file_str), "r");
if (in == 0)
uw_throwcf(file_error, "unable to open %s", c_str(spec_file_str));
- yyin_stream = make_stdio_stream(in, t, nil);
+ yyin_stream = make_stdio_stream(in, spec_file_str, t, nil);
} else {
spec_file = "stdin";
}
@@ -323,7 +323,7 @@ static int txr_main(int argc, char **argv)
FILE *in = fopen(*argv, "r");
if (in == 0)
uw_throwcf(file_error, "unable to open %s", *argv);
- yyin_stream = make_stdio_stream(in, t, nil);
+ yyin_stream = make_stdio_stream(in, string(*argv), t, nil);
spec_file = *argv;
} else {
spec_file = "stdin";
diff --git a/unwind.c b/unwind.c
index 8c817da5..e3cbe5e5 100644
--- a/unwind.c
+++ b/unwind.c
@@ -369,4 +369,5 @@ void uw_init(void)
uw_register_subtype(range_err, error);
uw_register_subtype(query_error, error);
uw_register_subtype(file_error, error);
+ uw_register_subtype(process_error, error);
}
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-06 22:37:47 +0000