[uim-commit] r2515 - branches/r5rs/sigscheme

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-12-10 00:02:36 -0800 (Sat, 10 Dec 2005)
New Revision: 2515

Modified:
   branches/r5rs/sigscheme/error.c
Log:
* sigscheme/error.c
  - (Scm_FatalError): Add error header
  - (ScmOp_fatal_error): Fix possible infinite loop


Modified: branches/r5rs/sigscheme/error.c
===================================================================
--- branches/r5rs/sigscheme/error.c	2005-12-10 07:27:16 UTC (rev 2514)
+++ branches/r5rs/sigscheme/error.c	2005-12-10 08:02:36 UTC (rev 2515)
@@ -144,6 +144,7 @@
 {
     /* don't use Scheme-level ports here */
     if (msg) {
+        fputs("Error: ", stderr);
         fputs(msg, stderr);
         fputs(SCM_NEWLINE_STR, stderr);
     }
@@ -162,18 +163,18 @@
 
 ScmObj ScmOp_fatal_error(ScmObj err_obj)
 {
-    ScmObj reason;
     const char *msg;
     DECLARE_FUNCTION("%%fatal-error", ProcedureFixed1);
 
-    if (!fatal_err_looped) {
+    if (fatal_err_looped) {
+        /* to avoid infinite loop by implicit assertion, use no SCM macros */
+        msg = "looped fatal error";
+    } else {
         fatal_err_looped = TRUE;
         ASSERT_ERROBJP(err_obj);
         ScmOp_inspect_error(err_obj);
+        msg = NULL;
     }
-    /* ERROBJP(err_obj) is always true here */
-    reason = CADR(err_obj);
-    msg = (STRINGP(reason)) ? SCM_STRING_STR(reason) : NULL;
 
     Scm_FatalError(msg);
     /* NOTREACHED */