From fec10162549f1d0b498d707f96192caf190adba2 Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Sat, 19 Mar 2016 15:01:05 +0900
Subject: [PATCH] Fix for additional edge cases in escaping symbols on output.

---
 sexp.c               | 12 +++++++-----
 tests/r7rs-tests.scm |  4 ++++
 2 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/sexp.c b/sexp.c
index 95490dc5..cb5cdb25 100644
--- a/sexp.c
+++ b/sexp.c
@@ -1192,7 +1192,7 @@ sexp sexp_intern(sexp ctx, const char *str, sexp_sint_t len) {
   res = 0;
   space = 3;
   if (len == 0 || sexp_isdigit(p[0])
-      || ((p[0] == '+' || p[0] == '-') && len > 1 && sexp_isdigit(p[1])))
+      || ((p[0] == '+' || p[0] == '-') && len > 1))
     goto normal_intern;
   for ( ; i<len; i++, p++) {
     c = *p;
@@ -1920,10 +1920,12 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
            (sexp_lsymbol_length(obj) == 1 && str[0] == '.') ||
            sexp_isdigit(str[0]) ||
            (sexp_lsymbol_length(obj) > 1 &&
-            (((str[0] == '+' || str[0] == '-')
-              && (sexp_isdigit(str[1]) || str[1] == '.')) ||
-             (str[sexp_lsymbol_length(obj)-1] == '0' &&
-              str[sexp_lsymbol_length(obj)-2] == '.'))))
+            ((str[0] == '+' || str[0] == '-')
+             && (sexp_isdigit(str[1]) || str[1] == '.' || str[1] == 'i' ||
+                 ((sexp_lsymbol_length(obj) > 3) &&
+                  sexp_tolower(str[1]) == 'n' &&
+                  sexp_tolower(str[2]) == 'a' &&
+                  sexp_tolower(str[3]) == 'n')))))
         ? '|' : EOF;
       for (i=sexp_lsymbol_length(obj)-1; i>=0; i--)
         if (str[i] <= ' ' || str[i] == '\\' || sexp_is_separator(str[i]))
diff --git a/tests/r7rs-tests.scm b/tests/r7rs-tests.scm
index e8d74b8d..5b0da7ad 100644
--- a/tests/r7rs-tests.scm
+++ b/tests/r7rs-tests.scm
@@ -2107,9 +2107,13 @@
 (test-write-syntax "|2|" '|2|)
 (test-write-syntax "|+3|" '|+3|)
 (test-write-syntax "|-.4|" '|-.4|)
+(test-write-syntax "|+i|" '|+i|)
+(test-write-syntax "|-i|" '|-i|)
 (test-write-syntax "|+inf.0|" '|+inf.0|)
 (test-write-syntax "|-inf.0|" '|-inf.0|)
 (test-write-syntax "|+nan.0|" '|+nan.0|)
+(test-write-syntax "|+NaN.0|" '|+NaN.0|)
+(test-write-syntax "|+NaN.0abc|" '|+NaN.0abc|)
 
 (test-end)