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

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-09-23 03:10:35 -0700 (Fri, 23 Sep 2005)
New Revision: 1543

Modified:
   branches/r5rs/sigscheme/TODO
   branches/r5rs/sigscheme/io.c
   branches/r5rs/sigscheme/sigscheme.c
Log:
* sigscheme/sigscheme.c
  - (SigScm_Initialize_internal): Initialize SigScm_features with
    SCM_NULL to fix broken 'features' feature
* sigscheme/io.c
  - (SigScm_load_internal): Add a FIXME comment
  - (ScmOp_require):
    * Fix broken 'features' handlings
    * Add (define *foo.scm-loaded* #t) as SIOD does. It is required
      for compatibility although the alternative facility (provide?)
      is existing
    * Simplify
    * Remove a debug message because the function has been stabilized
  - (create_loaded_str): Fix incorrect format "foo-loaded*" to
    "*foo-loaded*"
  - (ScmOp_providedp): Fix broken list update
* sigscheme/TODO
  - Update


Modified: branches/r5rs/sigscheme/TODO
===================================================================
--- branches/r5rs/sigscheme/TODO	2005-09-23 09:05:26 UTC (rev 1542)
+++ branches/r5rs/sigscheme/TODO	2005-09-23 10:10:35 UTC (rev 1543)
@@ -7,6 +7,8 @@
   - Implement assert-error in unittest.scm
   - [uim] Make uim-sh loop workable even if error occurred
 
+* Fix error handling of SigScm_load_internal()
+
 * Support SIOD-compatible verbose message control (suppressing backtrace, GC
   stat, error, etc based on verbose-level)
   - [uim] Make the GaUnit-based testing framework workable

Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c	2005-09-23 09:05:26 UTC (rev 1542)
+++ branches/r5rs/sigscheme/io.c	2005-09-23 10:10:35 UTC (rev 1543)
@@ -453,6 +453,7 @@
     if (!filepath)
         return SCM_FALSE;
 
+    /* FIXME: generate an error when file open has been failed */
     /* open port */
     port = ScmOp_open_input_file(Scm_NewStringCopying(filepath));
     s_expression = SCM_NULL;
@@ -532,38 +533,28 @@
 
 /*
  * TODO:
- * - return the status which indicates succeeded or not
+ * - generate an error when the file open has been failed (via ScmOp_load())
  */
 ScmObj ScmOp_require(ScmObj filename)
 {
-    ScmObj loaded_str  = SCM_NULL;
+    ScmObj loaded_str = SCM_FALSE;
 #if SCM_COMPAT_SIOD
-    ScmObj retsym = SCM_NULL;
-    char *retsym_name = NULL;
+    ScmObj retsym     = SCM_FALSE;
 #endif
 
     if (!STRINGP(filename))
         SigScm_ErrorObj("require : string required but got ", filename);
 
-    /* construct loaded_str */
     loaded_str = create_loaded_str(filename);
-
-    if (FALSEP(ScmOp_member(loaded_str, SCM_SYMBOL_VCELL(SigScm_features)))) {
-        /* not provided, so load it! */
+    if (FALSEP(ScmOp_providedp(loaded_str))) {
         ScmOp_load(filename);
-
-        /* record to SigScm_features */
-        SCM_SYMBOL_VCELL(SigScm_features) = CONS(loaded_str, SCM_SYMBOL_VCELL(SigScm_features));
+        ScmOp_provide(loaded_str);
     }
 
 #if SCM_COMPAT_SIOD
-    retsym_name = (char*)malloc(sizeof(char) * (strlen(SCM_STRING_STR(filename)) + strlen("*-loaded*") + 1));
-    sprintf(retsym_name, "*%s-loaded*", SCM_STRING_STR(filename));
-#if 0
-    fprintf(stderr, "retsym_name = %s\n", retsym_name);
-#endif
-    retsym = Scm_Intern(retsym_name);
-    free(retsym_name);
+    retsym = Scm_Intern(SCM_STRING_STR(loaded_str));
+    SCM_SYMBOL_SET_VCELL(retsym, SCM_TRUE);
+
     return retsym;
 #else
     return SCM_TRUE;
@@ -576,9 +567,9 @@
     int    size = 0;
 
     /* generate loaded_str, contents is filename-loaded* */
-    size = (strlen(SCM_STRING_STR(filename)) + strlen("-loaded*") + 1);
+    size = (strlen(SCM_STRING_STR(filename)) + strlen("*-loaded*") + 1);
     loaded_str = (char*)malloc(sizeof(char) * size);
-    snprintf(loaded_str, size, "%s-loaded*", SCM_STRING_STR(filename));
+    snprintf(loaded_str, size, "*%s-loaded*", SCM_STRING_STR(filename));
     
     return Scm_NewString(loaded_str);
 }
@@ -604,10 +595,14 @@
  */
 ScmObj ScmOp_providedp(ScmObj feature)
 {
+    ScmObj provided = SCM_FALSE;
+
     if (!STRINGP(feature))
         SigScm_ErrorObj("provide : string required but got ", feature);
 
-    return (FALSEP(ScmOp_member(feature, SigScm_features))) ? SCM_FALSE : SCM_TRUE;
+    provided = ScmOp_member(feature, SCM_SYMBOL_VCELL(SigScm_features));
+
+    return (NFALSEP(provided)) ? SCM_TRUE : SCM_FALSE;
 }
 
 /*

Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c	2005-09-23 09:05:26 UTC (rev 1542)
+++ branches/r5rs/sigscheme/sigscheme.c	2005-09-23 10:10:35 UTC (rev 1543)
@@ -125,6 +125,7 @@
     SigScm_unquote_splicing = Scm_Intern("unquote-splicing");
 #if SCM_USE_NONSTD_FEATURES
     SigScm_features         = Scm_Intern("*features*");
+    SCM_SYMBOL_SET_VCELL(SigScm_features, SCM_NULL);
 #endif
     /*=======================================================================
       Export Scheme Special Symbols