racket/base: add string-port?

pkgs/racket-pkgs/racket-doc/scribblings/reference/string-ports.scrbl

@@ -20,7 +20,15 @@ ports} in position-setting mode.
 
 @refalso["bytestrings"]{bytestrings}
 
-@defproc[(open-input-bytes [bstr bytes?] [name any/c 'string]) input-port?]{
+@defproc[(string-port? [p port?]) boolean?]{
+
+Returns @racket[#t] if @racket[p] is a @tech{string port}, @racket[#f]
+otherwise.
+
+@history[#:added "6.0.1.6"]}
+
+@defproc[(open-input-bytes [bstr bytes?] [name any/c 'string])
+         (and/c input-port? string-port?)]{
 
 Creates an input @tech{string port} that reads characters from
 @racket[bstr] (see @secref["bytestrings"]). Modifying @racket[bstr]
@@ -39,7 +47,8 @@ port.}
 
 @refalso["strings"]{strings}
 
-@defproc[(open-input-string [str string?] [name any/c 'string]) input-port?]{
+@defproc[(open-input-string [str string?] [name any/c 'string])
+         (and/c input-port? string-port?)]{
 
 Creates an input @tech{string port} that reads bytes from the UTF-8
 encoding (see @secref["encodings"]) of @racket[str]. The optional
@@ -52,7 +61,8 @@ encoding (see @secref["encodings"]) of @racket[str]. The optional
   (read-line names)
   (read-line names)]
 
-@defproc[(open-output-bytes [name any/c 'string]) output-port?]{
+@defproc[(open-output-bytes [name any/c 'string])
+         (and/c output-port? string-port?)]{
 
 Creates an output @tech{string port} that accumulates the output into a
 byte string. The optional @racket[name] argument is used as the name for
@@ -72,8 +82,10 @@ the returned port.}
   (get-output-bytes op3)
 ]
 
-@defproc[(open-output-string [name any/c 'string]) output-port?]{The
+@defproc[(open-output-string [name any/c 'string])
-same as @racket[open-output-bytes].}
+         (and/c output-port? string-port?)]{
+
+The same as @racket[open-output-bytes].}
 
 @examples[ #:eval sp-eval
   (define op1 (open-output-string))
@@ -89,7 +101,7 @@ same as @racket[open-output-bytes].}
   (get-output-string op3)
 ]
 
-@defproc[(get-output-bytes [out output-port?]
+@defproc[(get-output-bytes [out (and/c output-port? string-port?)]
                            [reset? any/c #f]
                            [start-pos exact-nonnegative-integer? 0]
                            [end-pos exact-nonnegative-integer? #f])
@@ -126,7 +138,7 @@ passing a second argument to @racket[subbytes].}
   (get-output-bytes op #t)
   (get-output-bytes op)]
 
-@defproc[(get-output-string [out output-port?]) string?]{
+@defproc[(get-output-string [out (and/c output-port? string-port?)]) string?]{
 Returns @racket[(bytes->string/utf-8 (get-output-bytes out) #\?)].}
 
 @examples[

pkgs/racket-pkgs/racket-test/tests/racket/port.rktl

@@ -78,6 +78,11 @@
   (test #t evt? (sync/timeout 0 (port-progress-evt i)))
   (test 0 peek-bytes-avail! (make-bytes 10) 0 (port-progress-evt i) i))
 
+(test #t string-port? (open-input-string ""))
+(test #t string-port? (open-input-bytes #""))
+(test #t string-port? (open-output-bytes))
+(test #t string-port? (open-output-string))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Based on the Racket manual...
 

racket/src/racket/src/portfun.c

@@ -33,6 +33,7 @@ static Scheme_Object *input_port_p (int, Scheme_Object *[]);
 static Scheme_Object *output_port_p (int, Scheme_Object *[]);
 static Scheme_Object *port_closed_p (int, Scheme_Object *[]);
 static Scheme_Object *current_input_port (int, Scheme_Object *[]);
+static Scheme_Object *string_port_p(int, Scheme_Object *[]);
 static Scheme_Object *current_output_port (int, Scheme_Object *[]);
 static Scheme_Object *current_error_port (int, Scheme_Object *[]);
 static Scheme_Object *make_input_port (int, Scheme_Object *[]);
@@ -238,6 +239,7 @@ scheme_init_port_fun(Scheme_Env *env)
   GLOBAL_FOLDING_PRIM("input-port?",            input_port_p,               1, 1, 1, env);
   GLOBAL_FOLDING_PRIM("output-port?",           output_port_p,              1, 1, 1, env); 
   GLOBAL_FOLDING_PRIM("file-stream-port?",      scheme_file_stream_port_p,  1, 1, 1, env);
+  GLOBAL_FOLDING_PRIM("string-port?",           string_port_p,              1, 1, 1, env);
   GLOBAL_FOLDING_PRIM("terminal-port?",         scheme_terminal_port_p,     1, 1, 1, env);
 
   GLOBAL_PRIM_W_ARITY("port-closed?",           port_closed_p,          1, 1, env); 
@@ -2629,7 +2631,7 @@ Scheme_Object *do_get_output_string(const char *who, int is_byte,
   op = scheme_output_port_record(argv[0]);
   if (!SCHEME_OUTPUT_PORTP(argv[0])
       || (op->sub_type != scheme_string_output_port_type))
-    scheme_wrong_contract(who, "string-output-port?", 0, argc, argv);
+    scheme_wrong_contract(who, "(and/c output-port? string-port?)", 0, argc, argv);
 
   if (argc > 2) {
     intptr_t len;
@@ -2692,6 +2694,26 @@ get_output_char_string (int argc, Scheme_Object *argv[])
   return do_get_output_string("get-output-string", 0, argc, argv);
 }
 
+static Scheme_Object *
+string_port_p (int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *p = argv[0];
+
+  if (SCHEME_INPUT_PORTP(p)) {
+    if (SAME_OBJ(scheme_input_port_record(p)->sub_type,
+                 scheme_string_input_port_type))
+      return scheme_true;
+  } else if (SCHEME_OUTPUT_PORTP(p)) {
+    if (SAME_OBJ(scheme_output_port_record(p)->sub_type,
+                 scheme_string_output_port_type))
+      return scheme_true;
+  } else {
+    scheme_wrong_contract("string-port?", "port?", 0, argc, argv);
+  }
+
+  return scheme_false;
+}
+
 static Scheme_Object *
 close_input_port (int argc, Scheme_Object *argv[])
 {

racket/src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1116
+#define EXPECTED_PRIM_COUNT 1117
 #define EXPECTED_UNSAFE_COUNT 106
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_EXTFL_COUNT 45

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "6.0.1.5"
+#define MZSCHEME_VERSION "6.0.1.6"
 
 #define MZSCHEME_VERSION_X 6
 #define MZSCHEME_VERSION_Y 0
 #define MZSCHEME_VERSION_Z 1
-#define MZSCHEME_VERSION_W 5
+#define MZSCHEME_VERSION_W 6
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)