Patch for input string port

From: Shiro Kawai <shiro_at_squareusa.com>
Date: Mon, 08 Nov 1999 22:49:22 -1000 (HST)

Input string port in STk-4.0.1 can't handle a string containing
NUL bytes, e.g.

  (with-input-from-string "abc\0def" (lambda () (read-line)))
     => "abc"

This patch fixes it. However, it changes API of
STk_internal_open_input_string, so it might break existing
extension code. Would it better to have a separate function? > Eric


*** slib.c.orig Fri Sep 3 10:21:32 1999
--- slib.c Thu Oct 21 17:14:40 1999
***************
*** 133,139 ****
      {
        /* Create a string port to read the sexpr and evaluate it in a new context */
        STk_err_handler->context |= context;
! port = STk_internal_open_input_string(s);
        result = STk_eval(STk_readf(port, FALSE), env);
      }
    WHEN_ERROR
--- 133,139 ----
      {
        /* Create a string port to read the sexpr and evaluate it in a new context */
        STk_err_handler->context |= context;
! port = STk_internal_open_input_string(s, -1);
        result = STk_eval(STk_readf(port, FALSE), env);
      }
    WHEN_ERROR
*** stk.h.orig Sat Sep 4 10:11:14 1999
--- stk.h Thu Oct 21 17:16:07 1999
***************
*** 1301,1307 ****
  };
  
  
! SCM STk_internal_open_input_string(char *s);
  void STk_free_string_port(SCM port);
  SCM STk_internal_read_from_string(SCM port, int *eof, int case_significant);
  PRIMITIVE STk_open_input_string(SCM s);
--- 1301,1307 ----
  };
  
  
! SCM STk_internal_open_input_string(char *s, int len);
  void STk_free_string_port(SCM port);
  SCM STk_internal_read_from_string(SCM port, int *eof, int case_significant);
  PRIMITIVE STk_open_input_string(SCM s);
*** sport.c.orig Sun Sep 26 05:02:14 1999
--- sport.c Mon Nov 8 22:27:57 1999
***************
*** 27,44 ****
  #include "stk.h"
  #include "sport.h"
  
! SCM STk_internal_open_input_string(char *str)
  {
    struct str_iob *p;
    SCM z;
  
    p = (struct str_iob *) must_malloc(sizeof (struct str_iob));
    
    p->signature = SPORT_SIGNATURE;
    p->flag = READING;
! p->cnt = p->bufsiz = strlen(str);
    p->base = p->ptr = must_malloc((unsigned int ) p->cnt + 1);
! strcpy(p->base, str);
  
    /* Sport_descr is a short version of a port_descr */
    NEWCELL(z, tc_isport);
--- 27,46 ----
  #include "stk.h"
  #include "sport.h"
  
! SCM STk_internal_open_input_string(char *str, int len)
  {
    struct str_iob *p;
    SCM z;
  
+ if (len < 0) len = strlen(str);
+
    p = (struct str_iob *) must_malloc(sizeof (struct str_iob));
    
    p->signature = SPORT_SIGNATURE;
    p->flag = READING;
! p->cnt = p->bufsiz = len;
    p->base = p->ptr = must_malloc((unsigned int ) p->cnt + 1);
! memcpy((void*)p->base, (void*)str, len+1); /* +1 for terminating NUL */
  
    /* Sport_descr is a short version of a port_descr */
    NEWCELL(z, tc_isport);
***************
*** 91,97 ****
  PRIMITIVE STk_open_input_string(SCM s)
  {
    if (NSTRINGP(s)) Err("open-input-string: not a string", s);
! return STk_internal_open_input_string(CHARS(s));
  }
  
  
--- 93,99 ----
  PRIMITIVE STk_open_input_string(SCM s)
  {
    if (NSTRINGP(s)) Err("open-input-string: not a string", s);
! return STk_internal_open_input_string(CHARS(s), STRSIZE(s));
  }
  
  
***************
*** 152,158 ****
    if (NSTRINGP(string)) Serror("bad string", string);
    if (!STk_is_thunk(thunk)) Serror("bad thunk", thunk);
  
! return STk_redirect_input(STk_internal_open_input_string(CHARS(string)), thunk);
  }
  
  PRIMITIVE STk_with_output_to_string(SCM thunk)
--- 154,160 ----
    if (NSTRINGP(string)) Serror("bad string", string);
    if (!STk_is_thunk(thunk)) Serror("bad thunk", thunk);
  
! return STk_redirect_input(STk_internal_open_input_string(CHARS(string), STRSIZE(string)), thunk);
  }
  
  PRIMITIVE STk_with_output_to_string(SCM thunk)
***************
*** 190,196 ****
    if (NSTRINGP(str)) Err("read-from-string: Bad string", str);
  
    /* Create a string port to read in the expression */
! port = STk_internal_open_input_string(CHARS(str));
    result = STk_internal_read_from_string(port, &eof, FALSE);
  
    return result == EVAL_ERROR? UNDEFINED: result;
--- 192,198 ----
    if (NSTRINGP(str)) Err("read-from-string: Bad string", str);
  
    /* Create a string port to read in the expression */
! port = STk_internal_open_input_string(CHARS(str), STRSIZE(str));
    result = STk_internal_read_from_string(port, &eof, FALSE);
  
    return result == EVAL_ERROR? UNDEFINED: result;
*** tcl-glue.c.orig Fri Sep 3 10:21:32 1999
--- tcl-glue.c Thu Oct 21 17:16:21 1999
***************
*** 46,52 ****
  
    if (*s) {
      /* Create a string port to read in the result */
! port = STk_internal_open_input_string(s);
      result = STk_internal_read_from_string(port, &eof, TRUE);
  #ifdef USE_TK
      if (result == Sym_dot) result = STk_root_window;
--- 46,52 ----
  
    if (*s) {
      /* Create a string port to read in the result */
! port = STk_internal_open_input_string(s, -1);
      result = STk_internal_read_from_string(port, &eof, TRUE);
  #ifdef USE_TK
      if (result == Sym_dot) result = STk_root_window;
***************
*** 223,229 ****
        SCM port;
        int eof;
        
! port = STk_internal_open_input_string(val);
        value = STk_internal_read_from_string(port, &eof, TRUE);
        if (value == EVAL_ERROR) return NULL;
      }
--- 223,229 ----
        SCM port;
        int eof;
        
! port = STk_internal_open_input_string(val, -1);
        value = STk_internal_read_from_string(port, &eof, TRUE);
        if (value == EVAL_ERROR) return NULL;
      }
Received on Tue Nov 09 1999 - 09:49:50 CET