mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

better messages on failed autocompilation

Browse source 
* libguile/load.c (auto_compile_catch_handler):
* module/ice-9/boot-9.scm (load-in-vicinity): Nicer messages when
  autocompilation fails.
This commit is contained in:
Andy Wingo 2011-06-17 18:08:06 +02:00
parent 0083cb5ec4
commit 669ea4ebff
2 changed files with 26 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

23
libguile/load.c
View file

@ -736,14 +736,27 @@ static SCM
auto_compile_catch_handler (void *data, SCM tag, SCM throw_args) auto_compile_catch_handler (void *data, SCM tag, SCM throw_args)
{ {
SCM source = PTR2SCM (data); SCM source = PTR2SCM (data);
SCM oport, lines;
oport = scm_open_output_string ();
scm_print_exception (oport, SCM_BOOL_F, tag, throw_args);
scm_puts (";;; WARNING: compilation of ", scm_current_error_port ()); scm_puts (";;; WARNING: compilation of ", scm_current_error_port ());
scm_display (source, scm_current_error_port ()); scm_display (source, scm_current_error_port ());
scm_puts (" failed:\n", scm_current_error_port ()); scm_puts (" failed:\n", scm_current_error_port ());
scm_puts (";;; key ", scm_current_error_port ());
scm_write (tag, scm_current_error_port ()); lines = scm_string_split (scm_get_output_string (oport),
scm_puts (", throw args ", scm_current_error_port ()); SCM_MAKE_CHAR ('\n'));
scm_write (throw_args, scm_current_error_port ()); for (; scm_is_pair (lines); lines = scm_cdr (lines))
scm_newline (scm_current_error_port ()); if (scm_c_string_length (scm_car (lines)))
{
scm_puts (";;; ", scm_current_error_port ());
scm_display (scm_car (lines), scm_current_error_port ());
scm_newline (scm_current_error_port ());
}
scm_close_port (oport);
return SCM_BOOL_F; return SCM_BOOL_F;
} }

10
module/ice-9/boot-9.scm
View file

@ -3506,8 +3506,14 @@ module '(ice-9 q) '(make-q q-length))}."
(else #f)))))) (else #f))))))
(lambda (k . args) (lambda (k . args)
(format (current-error-port) (format (current-error-port)
";;; WARNING: compilation of ~a failed:\n;;; key ~a, throw_args ~s\n" ";;; WARNING: compilation of ~a failed:\n" name)
name k args) (for-each (lambda (s)
(if (not (string-null? s))
(format (current-error-port) ";;; ~a\n" s)))
(string-split
(call-with-output-string
(lambda (port) (print-exception port #f k args)))
#\newline))
#f))) #f)))
(define (absolute-path? path) (define (absolute-path? path)