[uim-commit] r2779 - in branches/r5rs/sigscheme: . test

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-04 08:30:42 -0800 (Wed, 04 Jan 2006)
New Revision: 2779

Modified:
   branches/r5rs/sigscheme/TODO
   branches/r5rs/sigscheme/io.c
   branches/r5rs/sigscheme/operations-srfi38.c
   branches/r5rs/sigscheme/sigschemeinternal.h
   branches/r5rs/sigscheme/test/test-srfi38.scm
Log:
* sigscheme/io.c
  - (PREPARE_PORT): Move to sigschemeinternal.h
* sigscheme/sigschemeinternal.h
  - (PREPARE_PORT): Moved from io.c
* sigscheme/operations-srfi38.c
  - (scm_p_srfi38_write_with_shared_structure):
    * Fix SEGV on dot arg
    * Simplify with PREPARE_PORT()
    * Cleanup variable declaration
* sigscheme/test/test-srfi38.scm
  - Add test for the SEGV condition
* sigscheme/TODO
  - Update


Modified: branches/r5rs/sigscheme/TODO
===================================================================
--- branches/r5rs/sigscheme/TODO	2006-01-04 16:18:33 UTC (rev 2778)
+++ branches/r5rs/sigscheme/TODO	2006-01-04 16:30:42 UTC (rev 2779)
@@ -12,9 +12,9 @@
 * Fix all destructive expression on macros
 
 * Review and refactor all functions in syntax.c(listran, vectran,
-  qquote_internal, scm_s_quasiquote, scm_s_do), operations-srfi*.c,
-  encoding.[hc] and *port.[hc] (other files had already been done except for
-  the destructive exp on macros)
+  qquote_internal, scm_s_quasiquote, scm_s_do),
+  operations-srfi{1,2,6,8,23,34,60}.c, encoding.[hc] and *port.[hc] (other
+  files had already been done except for the destructive exp on macros)
 
 * Investigate behavior of other Scheme implementations about constant vector
   and list

Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c	2006-01-04 16:18:33 UTC (rev 2778)
+++ branches/r5rs/sigscheme/io.c	2006-01-04 16:30:42 UTC (rev 2779)
@@ -420,16 +420,6 @@
 /*===========================================================================
   R5RS : 6.6 Input and Output : 6.6.2 Input
 ===========================================================================*/
-#define PREPARE_PORT(port, args, default_port)                               \
-    do {                                                                     \
-        port = POP_ARG(args);                                                \
-        if (!VALIDP(port))                                                   \
-            port = default_port;                                             \
-        ENSURE_PORT(port);                                                   \
-        ASSERT_NO_MORE_ARG(args);                                            \
-    } while (/* CONSTCOND */ 0)
-
-
 ScmObj
 scm_p_read(ScmObj args)
 {

Modified: branches/r5rs/sigscheme/operations-srfi38.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi38.c	2006-01-04 16:18:33 UTC (rev 2778)
+++ branches/r5rs/sigscheme/operations-srfi38.c	2006-01-04 16:30:42 UTC (rev 2779)
@@ -76,13 +76,10 @@
 ScmObj
 scm_p_srfi38_write_with_shared_structure(ScmObj obj, ScmObj args)
 {
-    ScmObj port = scm_out;
+    ScmObj port;
     DECLARE_FUNCTION("write-with-shared-structure", procedure_variadic_1);
 
-    /* get port */
-    port = scm_out;
-    if (!NULLP(args) && PORTP(CAR(args)))
-        port = CAR(args);
+    PREPARE_PORT(port, args, scm_out);
 
     scm_write_to_port_with_shared_structure(port, obj);
     return SCM_UNDEF;

Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h	2006-01-04 16:18:33 UTC (rev 2778)
+++ branches/r5rs/sigscheme/sigschemeinternal.h	2006-01-04 16:30:42 UTC (rev 2779)
@@ -343,6 +343,15 @@
 
 #define ENSURE_ALLOCATED SCM_ENSURE_ALLOCATED
 
+#define PREPARE_PORT(port, args, default_port)                               \
+    do {                                                                     \
+        port = POP_ARG(args);                                                \
+        if (!VALIDP(port))                                                   \
+            port = default_port;                                             \
+        ENSURE_PORT(port);                                                   \
+        ASSERT_NO_MORE_ARG(args);                                            \
+    } while (/* CONSTCOND */ 0)
+
 /* Macros For Handling Continuation Object */
 #define INVALID_CONTINUATION_OPAQUE  NULL
 

Modified: branches/r5rs/sigscheme/test/test-srfi38.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-srfi38.scm	2006-01-04 16:18:33 UTC (rev 2778)
+++ branches/r5rs/sigscheme/test/test-srfi38.scm	2006-01-04 16:30:42 UTC (rev 2779)
@@ -31,9 +31,14 @@
 ;;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (load "./test/unittest.scm")
 
+(define tn test-name)
+
 (use srfi-38)
 (use srfi-6)
 
+(tn "write/ss invalid form")
+(assert-error (tn) (lambda () (write/ss #f . (current-output-port))))
+
 (let* ((outs (open-output-string))
        (s "abc")
        (convolution `(,s 1 #(,s b) (2) () ,s)))