pic_strf_value does not interpret '~s' format specifier
This commit is contained in:
parent
571fa0993c
commit
4e1aaf8b89
|
@ -54,6 +54,10 @@
|
||||||
(get-output-string port))))
|
(get-output-string port))))
|
||||||
|
|
||||||
(define (print-error-object e)
|
(define (print-error-object e)
|
||||||
|
(define type (error-object-type e))
|
||||||
|
(unless (eq? type '||)
|
||||||
|
(display type)
|
||||||
|
(display "-"))
|
||||||
(display "error: ")
|
(display "error: ")
|
||||||
(display (error-object-message e))
|
(display (error-object-message e))
|
||||||
(display ".")
|
(display ".")
|
||||||
|
@ -81,7 +85,7 @@
|
||||||
(print-error-object condition)
|
(print-error-object condition)
|
||||||
(set! str ""))
|
(set! str ""))
|
||||||
(begin
|
(begin
|
||||||
(display "raised: ")
|
(display "raise: ")
|
||||||
(write condition)
|
(write condition)
|
||||||
(newline)
|
(newline)
|
||||||
(set! str "")))
|
(set! str "")))
|
||||||
|
|
|
@ -36,30 +36,29 @@ pic_get_backtrace(pic_state *pic)
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
pic_print_backtrace(pic_state *pic, xFILE *file)
|
pic_print_error(pic_state *pic, xFILE *file)
|
||||||
{
|
{
|
||||||
pic_value err = pic_err(pic);
|
pic_value err = pic_err(pic), port = pic_open_port(pic, file);
|
||||||
|
|
||||||
assert(! pic_invalid_p(pic, err));
|
assert(! pic_invalid_p(pic, err));
|
||||||
|
|
||||||
if (! pic_error_p(pic, err)) {
|
if (! pic_error_p(pic, err)) {
|
||||||
xfprintf(pic, file, "raise: ");
|
xfprintf(pic, file, "raise: ");
|
||||||
pic_fwrite(pic, err, file);
|
pic_fprintf(pic, port, "~s", err);
|
||||||
} else {
|
} else {
|
||||||
struct error *e;
|
struct error *e;
|
||||||
pic_value elem, it;
|
pic_value elem, it;
|
||||||
|
|
||||||
e = pic_error_ptr(pic, err);
|
e = pic_error_ptr(pic, err);
|
||||||
if (! pic_eq_p(pic, pic_obj_value(e->type), pic_intern_lit(pic, ""))) {
|
if (! pic_eq_p(pic, pic_obj_value(e->type), pic_intern_lit(pic, ""))) {
|
||||||
pic_fwrite(pic, pic_obj_value(e->type), file);
|
pic_fprintf(pic, port, "~s", pic_obj_value(e->type));
|
||||||
xfprintf(pic, file, " ");
|
xfprintf(pic, file, " ");
|
||||||
}
|
}
|
||||||
xfprintf(pic, file, "error: ");
|
xfprintf(pic, file, "error: ");
|
||||||
pic_fwrite(pic, pic_obj_value(e->msg), file);
|
pic_fprintf(pic, port, "~s", pic_obj_value(e->msg));
|
||||||
|
|
||||||
pic_for_each (elem, e->irrs, it) { /* print error irritants */
|
pic_for_each (elem, e->irrs, it) { /* print error irritants */
|
||||||
xfprintf(pic, file, " ");
|
pic_fprintf(pic, port, " ~s", elem);
|
||||||
pic_fwrite(pic, elem, file);
|
|
||||||
}
|
}
|
||||||
xfprintf(pic, file, "\n");
|
xfprintf(pic, file, "\n");
|
||||||
|
|
||||||
|
|
|
@ -23,6 +23,10 @@ pic_value pic_eval(pic_state *, pic_value program, const char *lib);
|
||||||
void pic_load(pic_state *, pic_value port);
|
void pic_load(pic_state *, pic_value port);
|
||||||
void pic_load_cstr(pic_state *, const char *);
|
void pic_load_cstr(pic_state *, const char *);
|
||||||
|
|
||||||
|
void pic_printf(pic_state *, const char *fmt, ...);
|
||||||
|
void pic_fprintf(pic_state *, pic_value port, const char *fmt, ...);
|
||||||
|
void pic_vfprintf(pic_state *, pic_value port, const char *fmt, va_list ap);
|
||||||
|
|
||||||
/* extra xfile methods */
|
/* extra xfile methods */
|
||||||
|
|
||||||
xFILE *xfile_xstdin(pic_state *);
|
xFILE *xfile_xstdin(pic_state *);
|
||||||
|
@ -43,12 +47,6 @@ xFILE *xfopen_null(pic_state *, const char *mode);
|
||||||
#define pic_stdin(pic) pic_funcall(pic, "picrin.base", "current-input-port", 0)
|
#define pic_stdin(pic) pic_funcall(pic, "picrin.base", "current-input-port", 0)
|
||||||
#define pic_stdout(pic) pic_funcall(pic, "picrin.base", "current-output-port", 0)
|
#define pic_stdout(pic) pic_funcall(pic, "picrin.base", "current-output-port", 0)
|
||||||
#define pic_stderr(pic) pic_funcall(pic, "picrin.base", "current-error-port", 0)
|
#define pic_stderr(pic) pic_funcall(pic, "picrin.base", "current-error-port", 0)
|
||||||
pic_value pic_write(pic_state *, pic_value); /* returns given obj */
|
|
||||||
pic_value pic_fwrite(pic_state *, pic_value, xFILE *);
|
|
||||||
void pic_printf(pic_state *, const char *, ...);
|
|
||||||
void pic_fprintf(pic_state *, pic_value port, const char *, ...);
|
|
||||||
pic_value pic_display(pic_state *, pic_value);
|
|
||||||
pic_value pic_fdisplay(pic_state *, pic_value, xFILE *);
|
|
||||||
|
|
||||||
/* utility macros */
|
/* utility macros */
|
||||||
|
|
||||||
|
@ -111,7 +109,7 @@ pic_value pic_err(pic_state *);
|
||||||
|
|
||||||
void pic_warnf(pic_state *, const char *, ...);
|
void pic_warnf(pic_state *, const char *, ...);
|
||||||
pic_value pic_get_backtrace(pic_state *);
|
pic_value pic_get_backtrace(pic_state *);
|
||||||
void pic_print_backtrace(pic_state *, xFILE *);
|
void pic_print_error(pic_state *, xFILE *);
|
||||||
|
|
||||||
pic_value pic_library_environment(pic_state *, const char *);
|
pic_value pic_library_environment(pic_state *, const char *);
|
||||||
|
|
||||||
|
|
|
@ -318,72 +318,6 @@ pic_str(pic_state *pic, pic_value str)
|
||||||
return rope_cstr(pic, pic_str_ptr(pic, str)->rope);
|
return rope_cstr(pic, pic_str_ptr(pic, str)->rope);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void
|
|
||||||
vfstrf(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
|
|
||||||
{
|
|
||||||
char c;
|
|
||||||
|
|
||||||
while ((c = *fmt++) != '\0') {
|
|
||||||
switch (c) {
|
|
||||||
default:
|
|
||||||
xfputc(pic, c, file);
|
|
||||||
break;
|
|
||||||
case '%':
|
|
||||||
c = *fmt++;
|
|
||||||
if (! c)
|
|
||||||
goto exit;
|
|
||||||
switch (c) {
|
|
||||||
default:
|
|
||||||
xfputc(pic, c, file);
|
|
||||||
break;
|
|
||||||
case '%':
|
|
||||||
xfputc(pic, '%', file);
|
|
||||||
break;
|
|
||||||
case 'c':
|
|
||||||
xfprintf(pic, file, "%c", va_arg(ap, int));
|
|
||||||
break;
|
|
||||||
case 's':
|
|
||||||
xfprintf(pic, file, "%s", va_arg(ap, const char *));
|
|
||||||
break;
|
|
||||||
case 'd':
|
|
||||||
xfprintf(pic, file, "%d", va_arg(ap, int));
|
|
||||||
break;
|
|
||||||
case 'p':
|
|
||||||
xfprintf(pic, file, "%p", va_arg(ap, void *));
|
|
||||||
break;
|
|
||||||
case 'f':
|
|
||||||
xfprintf(pic, file, "%f", va_arg(ap, double));
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case '~':
|
|
||||||
c = *fmt++;
|
|
||||||
if (! c)
|
|
||||||
goto exit;
|
|
||||||
switch (c) {
|
|
||||||
default:
|
|
||||||
xfputc(pic, c, file);
|
|
||||||
break;
|
|
||||||
case '~':
|
|
||||||
xfputc(pic, '~', file);
|
|
||||||
break;
|
|
||||||
case '%':
|
|
||||||
xfputc(pic, '\n', file);
|
|
||||||
break;
|
|
||||||
case 'a':
|
|
||||||
pic_fdisplay(pic, va_arg(ap, pic_value), file);
|
|
||||||
break;
|
|
||||||
case 's':
|
|
||||||
pic_fwrite(pic, va_arg(ap, pic_value), file);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
exit:
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
pic_value
|
pic_value
|
||||||
pic_vstrf_value(pic_state *pic, const char *fmt, va_list ap)
|
pic_vstrf_value(pic_state *pic, const char *fmt, va_list ap)
|
||||||
{
|
{
|
||||||
|
@ -394,7 +328,7 @@ pic_vstrf_value(pic_state *pic, const char *fmt, va_list ap)
|
||||||
|
|
||||||
file = xfopen_buf(pic, NULL, 0, "w");
|
file = xfopen_buf(pic, NULL, 0, "w");
|
||||||
|
|
||||||
vfstrf(pic, file, fmt, ap);
|
xvfprintf(pic, file, fmt, ap);
|
||||||
xfget_buf(pic, file, &buf, &len);
|
xfget_buf(pic, file, &buf, &len);
|
||||||
str = pic_str_value(pic, buf, len);
|
str = pic_str_value(pic, buf, len);
|
||||||
xfclose(pic, file);
|
xfclose(pic, file);
|
||||||
|
|
|
@ -366,44 +366,70 @@ write(pic_state *pic, pic_value obj, xFILE *file, int mode, int op)
|
||||||
write_core(pic, obj, file, &p);
|
write_core(pic, obj, file, &p);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
pic_value
|
|
||||||
pic_write(pic_state *pic, pic_value obj)
|
|
||||||
{
|
|
||||||
return pic_fwrite(pic, obj, pic_fileno(pic, pic_stdout(pic)));
|
|
||||||
}
|
|
||||||
|
|
||||||
pic_value
|
|
||||||
pic_fwrite(pic_state *pic, pic_value obj, xFILE *file)
|
|
||||||
{
|
|
||||||
write(pic, obj, file, WRITE_MODE, OP_WRITE);
|
|
||||||
xfflush(pic, file);
|
|
||||||
return obj;
|
|
||||||
}
|
|
||||||
|
|
||||||
pic_value
|
|
||||||
pic_display(pic_state *pic, pic_value obj)
|
|
||||||
{
|
|
||||||
return pic_fdisplay(pic, obj, pic_fileno(pic, pic_stdout(pic)));
|
|
||||||
}
|
|
||||||
|
|
||||||
pic_value
|
|
||||||
pic_fdisplay(pic_state *pic, pic_value obj, xFILE *file)
|
|
||||||
{
|
|
||||||
write(pic, obj, file, DISPLAY_MODE, OP_WRITE);
|
|
||||||
xfflush(pic, file);
|
|
||||||
return obj;
|
|
||||||
}
|
|
||||||
|
|
||||||
void
|
void
|
||||||
pic_vfprintf(pic_state *pic, pic_value port, const char *fmt, va_list ap)
|
pic_vfprintf(pic_state *pic, pic_value port, const char *fmt, va_list ap)
|
||||||
{
|
{
|
||||||
xFILE *file = pic_fileno(pic, port);
|
xFILE *file = pic_fileno(pic, port);
|
||||||
pic_value str;
|
char c;
|
||||||
|
|
||||||
str = pic_vstrf_value(pic, fmt, ap);
|
while ((c = *fmt++) != '\0') {
|
||||||
|
switch (c) {
|
||||||
xfprintf(pic, file, "%s", pic_str(pic, str));
|
default:
|
||||||
|
xfputc(pic, c, file);
|
||||||
|
break;
|
||||||
|
case '%':
|
||||||
|
c = *fmt++;
|
||||||
|
if (! c)
|
||||||
|
goto exit;
|
||||||
|
switch (c) {
|
||||||
|
default:
|
||||||
|
xfputc(pic, c, file);
|
||||||
|
break;
|
||||||
|
case '%':
|
||||||
|
xfputc(pic, '%', file);
|
||||||
|
break;
|
||||||
|
case 'c':
|
||||||
|
xfprintf(pic, file, "%c", va_arg(ap, int));
|
||||||
|
break;
|
||||||
|
case 's':
|
||||||
|
xfprintf(pic, file, "%s", va_arg(ap, const char *));
|
||||||
|
break;
|
||||||
|
case 'd':
|
||||||
|
xfprintf(pic, file, "%d", va_arg(ap, int));
|
||||||
|
break;
|
||||||
|
case 'p':
|
||||||
|
xfprintf(pic, file, "%p", va_arg(ap, void *));
|
||||||
|
break;
|
||||||
|
case 'f':
|
||||||
|
xfprintf(pic, file, "%f", va_arg(ap, double));
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
case '~':
|
||||||
|
c = *fmt++;
|
||||||
|
if (! c)
|
||||||
|
goto exit;
|
||||||
|
switch (c) {
|
||||||
|
default:
|
||||||
|
xfputc(pic, c, file);
|
||||||
|
break;
|
||||||
|
case '~':
|
||||||
|
xfputc(pic, '~', file);
|
||||||
|
break;
|
||||||
|
case '%':
|
||||||
|
xfputc(pic, '\n', file);
|
||||||
|
break;
|
||||||
|
case 'a':
|
||||||
|
write(pic, va_arg(ap, pic_value), file, DISPLAY_MODE, OP_WRITE);
|
||||||
|
break;
|
||||||
|
case 's':
|
||||||
|
write(pic, va_arg(ap, pic_value), file, WRITE_MODE, OP_WRITE);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
exit:
|
||||||
xfflush(pic, file);
|
xfflush(pic, file);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -39,7 +39,7 @@ main(int argc, char *argv[], char **envp)
|
||||||
status = 0;
|
status = 0;
|
||||||
}
|
}
|
||||||
pic_catch {
|
pic_catch {
|
||||||
pic_print_backtrace(pic, xstderr);
|
pic_print_error(pic, xstderr);
|
||||||
status = 1;
|
status = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue