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

kzk at freedesktop.org kzk at freedesktop.org
Sat Jul 30 14:54:44 EST 2005


Author: kzk
Date: 2005-07-29 21:54:42 -0700 (Fri, 29 Jul 2005)
New Revision: 1074

Modified:
   branches/r5rs/sigscheme/datas.c
   branches/r5rs/sigscheme/io.c
   branches/r5rs/sigscheme/main.c
   branches/r5rs/sigscheme/sigscheme.c
   branches/r5rs/sigscheme/sigschemetype.h
   branches/r5rs/sigscheme/test/test-apply.scm
   branches/r5rs/sigscheme/test/test-exp.scm
Log:
* add filename information to port.

* sigscheme/sigscheme.h
* sigscheme/datas.c
  - (Scm_NewFilePort): change args
* sigscheme/debug.c
  - (SigScm_Display): use current_output_port
  - (SigScm_DisplayToPort): print more info for port
* sigscheme/main.c
  - (repl): change args of Scm_NewFilePort
* sigscheme/sigscheme.c
  - (SigScm_Initialize): change args of Scm_NewFilePort
* sigscheme/io.c
  - (ScmOp_open_input_file): change args of Scm_NewFilePort
  - (ScmOp_open_output_file): change args of Scm_NewFilePort
  - (ScmOp_read_char): SigScm_Read_Char reads character sequence.
     so not to use it.
  - (ScmOp_file_existp): close FILE stream when file is found

* test/test-apply.scm
* test/test-exp.scm
  - add test case


Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c	2005-07-29 15:47:08 UTC (rev 1073)
+++ branches/r5rs/sigscheme/datas.c	2005-07-30 04:54:42 UTC (rev 1074)
@@ -650,7 +650,7 @@
     return obj;
 }
 
-ScmObj Scm_NewFilePort(FILE *file, enum ScmPortDirection pdirection)
+ScmObj Scm_NewFilePort(FILE *file, const char *filename, enum ScmPortDirection pdirection)
 {
     ScmObj obj = SCM_NIL;
     ScmPortInfo *pinfo = (ScmPortInfo *)malloc(sizeof(ScmPortInfo));
@@ -661,6 +661,8 @@
     SCM_SETPORT_PORTDIRECTION(obj, pdirection);
     SCM_SETPORT_PORTTYPE(obj, PORT_FILE);
     pinfo->info.file_port.file = file;
+    pinfo->info.file_port.filename = (char*)malloc(sizeof(char) * strlen(filename) + 1);
+    strcpy(pinfo->info.file_port.filename, filename);
     pinfo->info.file_port.line = 0;
     pinfo->ungottenchar = 0;
     SCM_SETPORT_PORTINFO(obj, pinfo);

Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c	2005-07-29 15:47:08 UTC (rev 1073)
+++ branches/r5rs/sigscheme/io.c	2005-07-30 04:54:42 UTC (rev 1074)
@@ -215,7 +215,7 @@
         SigScm_ErrorObj("open-input-file : cannot open file ", filepath);
 
     /* Allocate ScmPort */
-    return Scm_NewFilePort(f, PORT_INPUT);
+    return Scm_NewFilePort(f, SCM_STRING_STR(filepath), PORT_INPUT);
 }
 
 ScmObj ScmOp_open_output_file(ScmObj filepath)
@@ -231,7 +231,7 @@
         SigScm_ErrorObj("open-output-file : cannot open file ", filepath);
 
     /* Return new ScmPort */
-    return Scm_NewFilePort(f, PORT_OUTPUT);
+    return Scm_NewFilePort(f, SCM_STRING_STR(filepath), PORT_OUTPUT);
 }
 
 ScmObj ScmOp_close_input_port(ScmObj port)
@@ -278,6 +278,7 @@
 ScmObj ScmOp_read_char(ScmObj arg, ScmObj env)
 {
     ScmObj port = SCM_NIL;
+    char  *buf  = NULL;
     if (SCM_NULLP(arg)) {
 	/* (read-char) */
 	port = current_input_port;
@@ -288,7 +289,11 @@
 	SigScm_ErrorObj("read-char : invalid parameter", arg);
     }
 
-    return SigScm_Read_Char(port);
+    /* TODO : implement this multibyte-char awareness */
+    buf = (char *)malloc(sizeof(char) * 2);
+    buf[0] = getc(SCM_PORTINFO_FILE(port));
+    buf[1] = '\0';
+    return Scm_NewChar(buf);
 }
 
 ScmObj ScmOp_peek_char(ScmObj arg, ScmObj env)
@@ -360,7 +365,6 @@
 	port = SCM_CAR(arg);
 
     SigScm_DisplayToPort(port, obj);
-
     return SCM_UNDEF;
 }
 
@@ -457,6 +461,8 @@
     if (!f)
 	return SCM_FALSE;
 
+    fclose(f);
+
     return SCM_TRUE;
 }
 

Modified: branches/r5rs/sigscheme/main.c
===================================================================
--- branches/r5rs/sigscheme/main.c	2005-07-29 15:47:08 UTC (rev 1073)
+++ branches/r5rs/sigscheme/main.c	2005-07-30 04:54:42 UTC (rev 1074)
@@ -55,8 +55,8 @@
 /* Very simple repl, please rewrite. */
 static void repl(void)
 {
-    ScmObj stdin_port  = Scm_NewFilePort(stdin,  PORT_INPUT);
-    ScmObj stdout_port = Scm_NewFilePort(stdout, PORT_INPUT);
+    ScmObj stdin_port  = Scm_NewFilePort(stdin,  "stdin",  PORT_INPUT);
+    ScmObj stdout_port = Scm_NewFilePort(stdout, "stdout", PORT_INPUT);
     ScmObj s_exp, result;
 
     printf("sscm> ");

Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c	2005-07-29 15:47:08 UTC (rev 1073)
+++ branches/r5rs/sigscheme/sigscheme.c	2005-07-30 04:54:42 UTC (rev 1074)
@@ -263,11 +263,11 @@
     /*=======================================================================
       Current Input & Output Initialization
     =======================================================================*/
-    current_input_port  = Scm_NewFilePort(stdin,  PORT_INPUT);
+    current_input_port  = Scm_NewFilePort(stdin,  "stdin",  PORT_INPUT);
     SigScm_gc_protect(current_input_port);
-    current_output_port = Scm_NewFilePort(stdout, PORT_OUTPUT);
+    current_output_port = Scm_NewFilePort(stdout, "stdout", PORT_OUTPUT);
     SigScm_gc_protect(current_output_port);
-    current_error_port  = Scm_NewFilePort(stderr, PORT_OUTPUT);
+    current_error_port  = Scm_NewFilePort(stderr, "stderr", PORT_OUTPUT);
     SigScm_gc_protect(current_error_port);
 
 #if USE_SRFI1

Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h	2005-07-29 15:47:08 UTC (rev 1073)
+++ branches/r5rs/sigscheme/sigschemetype.h	2005-07-30 04:54:42 UTC (rev 1074)
@@ -104,6 +104,7 @@
     union {
         struct {
             FILE *file;
+            char *filename;            
             int line;
         } file_port;
         
@@ -323,6 +324,7 @@
 #define SCM_SETPORT_PORTTYPE(a, ptype) (SCM_PORT_PORTTYPE(a) = ptype)
 #define SCM_SETPORT_PORTINFO(a, pinfo) (SCM_PORT_PORTINFO(a) = pinfo)
 #define SCM_PORTINFO_FILE(a) (SCM_PORT_PORTINFO(a)->info.file_port.file)
+#define SCM_PORTINFO_FILENAME(a) (SCM_PORT_PORTINFO(a)->info.file_port.filename)
 #define SCM_PORTINFO_LINE(a) (SCM_PORT_PORTINFO(a)->info.file_port.line)
 #define SCM_PORTINFO_STR(a) (SCM_PORT_PORTINFO(a)->info.str_port.port_str)
 #define SCM_PORTINFO_STR_CURRENT(a) (SCM_PORT_PORTINFO(a)->info.str_port.str_current)

Modified: branches/r5rs/sigscheme/test/test-apply.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-apply.scm	2005-07-29 15:47:08 UTC (rev 1073)
+++ branches/r5rs/sigscheme/test/test-apply.scm	2005-07-30 04:54:42 UTC (rev 1074)
@@ -13,6 +13,8 @@
 (assert-equal? "apply check9" 1 (apply (lambda (x) x) '(1)))
 (assert-equal? "apply check10" '(1) (apply (lambda x x) '(1)))
 
+(assert-equal? "apply check11" 2 (apply (lambda x x 2) '(1)))
+
 (define compose
   (lambda (f g)
     (lambda args

Modified: branches/r5rs/sigscheme/test/test-exp.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-exp.scm	2005-07-29 15:47:08 UTC (rev 1073)
+++ branches/r5rs/sigscheme/test/test-exp.scm	2005-07-30 04:54:42 UTC (rev 1074)
@@ -29,6 +29,8 @@
 					   (else 'equal)))
 (assert-equal? "basic cond test4" 2 (cond ((assv 'b '((a 1) (b 2))) => cadr)
 					  (else #f)))
+(assert-equal? "basic cond test5" 'greater1 (cond ((> 3 2) 'greater0 'greater1)
+						  (else #f)))
 
 ;; case
 (assert-eq? "basic case check1" 'case1 (case 1



More information about the uim-commit mailing list