[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