From 702451541a96df3b66920a2223911045a102a936 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Fri, 27 May 2022 16:21:08 -0400
Subject: [PATCH 1/3] Add formal test cases

---
 circ-test.scm        | 39 ---------------------------------------
 tests/unit-tests.scm | 35 +++++++++++++++++++++++++++++++++++
 2 files changed, 35 insertions(+), 39 deletions(-)
 delete mode 100644 circ-test.scm

diff --git a/circ-test.scm b/circ-test.scm
deleted file mode 100644
index 0201c36b..00000000
--- a/circ-test.scm
+++ /dev/null
@@ -1,39 +0,0 @@
-;; TODO: Temporary test file
-(import (scheme base) (scheme write))
-(define v1 (vector #f))
-(define v2 (vector v1))
-(vector-set! v1 0 v2)
-(display v1)
-(display (equal? v1 v2))
-(newline)
-
-(define v1 (vector 1 2 3))
-(define v2 (vector 1 v1 3))
-(vector-set! v1 1 v2)
-(display v1)
-;(display (equal? v1 v2))
-(newline)
-
-(define l1 (list #f))
-(define l2 (list l1))
-(set-cdr! l1 l2)
-(display l1)
-(display (equal? l1 l2))
-(newline)
-
-(define l1 (list 1 2 3))
-(define l2 (list 1 l1 3))
-(set-cdr! (cdr l1) l2)
-(write l1)
-(display (equal? l1 l2))
-(newline)
-
-; TODO: need to compare pointers to prevent this sort of thing:
-;
-; cyclone> (display #(1 1 1 1 1 1 1 1))
-; #(... ... ... ... ... ... ... ...)
-;
-; for equalp of pairs we track progress using cdr, cddr
-; proves that if pointers are equal we are traversing the same list
-;
-; how to handle vector traversal?
diff --git a/tests/unit-tests.scm b/tests/unit-tests.scm
index 79ba4051..57e69f5b 100644
--- a/tests/unit-tests.scm
+++ b/tests/unit-tests.scm
@@ -35,6 +35,41 @@
 (set-cdr! l '(c b)) ; Above seems to break if it replaces this line
 (assert:equal "list? on circular list" (list? l) #t)
 
+;; Circular data structures
+(define v1 (vector #f))
+(define v2 (vector v1))
+(vector-set! v1 0 v2)
+(let ((fp (open-output-string)))
+  (display v1 fp)
+  (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))
+(assert:equal "equality on circular vectors" (equal? v1 v2) #t)
+(newline)
+
+(define v1 (vector 1 2 3))
+(define v2 (vector 1 v1 3))
+(vector-set! v1 1 v2)
+(let ((fp (open-output-string)))
+  (write v1 fp)
+  (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))
+(assert:equal "equality on circular vectors, test 2" (equal? v1 v2) #t)
+(newline)
+
+(define l1 (list #f))
+(define l2 (list l1))
+(set-cdr! l1 l2)
+(let ((fp (open-output-string)))
+  (display l1 fp)
+  (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))
+(assert:equal "equality on circular lists" (equal? l1 l2) #f)
+
+(define l1 (list 1 2 3))
+(define l2 (list 1 l1 3))
+(set-cdr! (cdr l1) l2)
+(let ((fp (open-output-string)))
+  (write l1 fp)
+  (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))
+(assert:equal "equality on circular lists, test 2" (equal? l1 l2) #f)
+
 ;; Adder example
 (define (make-adder x)
   (lambda (y) (+ x  y)))

From 6ffd229dcdd1b74e77bc3f33d245efc4c340edf6 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Sat, 28 May 2022 08:21:11 -0700
Subject: [PATCH 2/3] Add memory-streams to list of features

---
 CHANGELOG.md              |  4 ++++
 include/cyclone/runtime.h |  1 +
 mstreams.c                |  9 +++++++++
 runtime.c                 |  7 +++++++
 scheme/base.sld           | 17 ++++++++++-------
 5 files changed, 31 insertions(+), 7 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 9732f62d..e4c621b9 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,10 @@
 
 ## 0.35.0 - TBD
 
+Features
+
+- Add `memory-streams` to the list of symbols that `(features)` can return, indicating that the current installation supports in-memory streams.
+
 Bug Fixes
 
 - Enforce a maximum recursion depth when printing an object via `display` and `write`, and when comparing objects via `equal?`. This prevents segmentation faults when working with circular data structures.
diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h
index b1c0bfc3..3a32a332 100644
--- a/include/cyclone/runtime.h
+++ b/include/cyclone/runtime.h
@@ -375,6 +375,7 @@ object Cyc_io_peek_u8(void *data, object cont, object port);
 object Cyc_write_bytevector(void *data, object bvec, object port, object start, object end);
 object Cyc_io_read_line(void *data, object cont, object port);
 void Cyc_io_read_token(void *data, object cont, object port);
+int Cyc_have_mstreams();
 /**@}*/
 
 
diff --git a/mstreams.c b/mstreams.c
index 16b5d7d1..af5b5838 100644
--- a/mstreams.c
+++ b/mstreams.c
@@ -32,6 +32,15 @@ if (obj_is_not_closure(clo)) { \
  } \
 }
 
+int Cyc_have_mstreams()
+{
+#if CYC_HAVE_FMEMOPEN && CYC_HAVE_OPEN_MEMSTREAM
+  return 1;
+#else
+  return 0;
+#endif
+}
+
 object Cyc_heap_alloc_port(void *data, port_type *p);
 port_type *Cyc_io_open_input_string(void *data, object str)
 {
diff --git a/runtime.c b/runtime.c
index 6330d026..32061cf7 100644
--- a/runtime.c
+++ b/runtime.c
@@ -2942,6 +2942,13 @@ object Cyc_compilation_environment(void *data, object cont, object var)
       snprintf(buf, sizeof(buf), "%s", CYC_PLATFORM);
       make_utf8_string(data, str, buf);
       _return_closcall1(data, cont, &str);
+    } else if (strncmp(((symbol) var)->desc, "memory-streams", 9) == 0) {
+      char buf[] = "memory-streams";
+      if (!Cyc_have_mstreams()) {
+        buf[0] = '\0';
+      }
+      make_utf8_string(data, str, buf);
+      _return_closcall1(data, cont, &str);
     }
   }
   Cyc_rt_raise2(data, 
diff --git a/scheme/base.sld b/scheme/base.sld
index c078c1b9..b4ec756b 100644
--- a/scheme/base.sld
+++ b/scheme/base.sld
@@ -235,14 +235,17 @@
   (begin
     ;; Features implemented by this Scheme
     (define (features) 
-      (cons 
-        'cyclone
-        (cons
-          (string->symbol 
-            (string-append "version-" *version-number*))
+      (let ((feats *other-features*))
+        (if (> (string-length (Cyc-compilation-environment 'memory-streams)) 0)
+          (set! feats (cons 'memory-streams feats)))
+        (cons 
+          'cyclone
           (cons
-            (string->symbol (Cyc-compilation-environment 'platform))
-            *other-features*))))
+            (string->symbol 
+              (string-append "version-" *version-number*))
+            (cons
+              (string->symbol (Cyc-compilation-environment 'platform))
+              feats)))))
 
     (define *other-features* 
             '(r7rs 

From 86b1169cf9720dc1bc9e003046fb904676963b5f Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Sat, 28 May 2022 17:41:19 -0700
Subject: [PATCH 3/3] Conditionally expand memory stream tests

---
 tests/unit-tests.scm | 32 ++++++++++++++++++++------------
 1 file changed, 20 insertions(+), 12 deletions(-)

diff --git a/tests/unit-tests.scm b/tests/unit-tests.scm
index 57e69f5b..c535dc63 100644
--- a/tests/unit-tests.scm
+++ b/tests/unit-tests.scm
@@ -39,35 +39,43 @@
 (define v1 (vector #f))
 (define v2 (vector v1))
 (vector-set! v1 0 v2)
-(let ((fp (open-output-string)))
-  (display v1 fp)
-  (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))
+(cond-expand
+  (memory-streams
+   (let ((fp (open-output-string)))
+     (display v1 fp)
+     (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))))
 (assert:equal "equality on circular vectors" (equal? v1 v2) #t)
 (newline)
 
 (define v1 (vector 1 2 3))
 (define v2 (vector 1 v1 3))
 (vector-set! v1 1 v2)
-(let ((fp (open-output-string)))
-  (write v1 fp)
-  (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))
+(cond-expand
+ (memory-streams
+  (let ((fp (open-output-string)))
+    (write v1 fp)
+    (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))))
 (assert:equal "equality on circular vectors, test 2" (equal? v1 v2) #t)
 (newline)
 
 (define l1 (list #f))
 (define l2 (list l1))
 (set-cdr! l1 l2)
-(let ((fp (open-output-string)))
-  (display l1 fp)
-  (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))
+(cond-expand
+  (memory-streams
+   (let ((fp (open-output-string)))
+     (display l1 fp)
+     (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))))
 (assert:equal "equality on circular lists" (equal? l1 l2) #f)
 
 (define l1 (list 1 2 3))
 (define l2 (list 1 l1 3))
 (set-cdr! (cdr l1) l2)
-(let ((fp (open-output-string)))
-  (write l1 fp)
-  (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))
+(cond-expand
+  (memory-streams
+   (let ((fp (open-output-string)))
+     (write l1 fp)
+     (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))))
 (assert:equal "equality on circular lists, test 2" (equal? l1 l2) #f)
 
 ;; Adder example