From ce370c2f6475c108ecf0b172417944b5ed10950d Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 14 Dec 2016 08:13:17 -0700
Subject: [PATCH] fix preservation of properties absent a source location

---
 pkgs/racket-test-core/tests/racket/stx.rktl | 15 +++++
 racket/src/racket/src/syntax.c              | 65 +++++++++++----------
 2 files changed, 48 insertions(+), 32 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/stx.rktl b/pkgs/racket-test-core/tests/racket/stx.rktl
index fcb3b390f0..f272cd88f2 100644
--- a/pkgs/racket-test-core/tests/racket/stx.rktl
+++ b/pkgs/racket-test-core/tests/racket/stx.rktl
@@ -2374,14 +2374,27 @@
                'something-not-saved 2)
               'a-third-thing 3 #t))
   (define s (zo-bounce s0))
+  ;; Like `s`, but without source locations or paren shape:
+  (define sx (zo-bounce
+              (syntax-property
+               (syntax-property
+                (syntax-property (datum->syntax #f '[0])
+                                 'something-else 1 #t)
+                'something-not-saved 2)
+               'a-third-thing 3 #t)))
+
   (test #\[ syntax-property s 'paren-shape)
+  (test #f syntax-property sx 'paren-shape)
   (test #\[ syntax-property s0 'paren-shape)
   (test #t syntax-property-preserved? s 'paren-shape)
+  (test #f syntax-property-preserved? sx 'paren-shape)
   (test #t syntax-property-preserved? s0 'paren-shape)
   
   (test 1 syntax-property s 'something-else)
+  (test 1 syntax-property sx 'something-else)
   (test 1 syntax-property s0 'something-else)
   (test #t syntax-property-preserved? s 'something-else)
+  (test #t syntax-property-preserved? sx 'something-else)
   (test #t syntax-property-preserved? s0 'something-else)
   
   (test #f syntax-property s 'something-not-saved)
@@ -2390,8 +2403,10 @@
   (test #f syntax-property-preserved? s0 'something-not-saved)
 
   (test 3 syntax-property s 'a-third-thing)
+  (test 3 syntax-property sx 'a-third-thing)
   (test 3 syntax-property s0 'a-third-thing)
   (test #t syntax-property-preserved? s 'a-third-thing)
+  (test #t syntax-property-preserved? sx 'a-third-thing)
   (test #t syntax-property-preserved? s0 'a-third-thing)
   
   ;; 'paren-shape has a special default:
diff --git a/racket/src/racket/src/syntax.c b/racket/src/racket/src/syntax.c
index e2d458343c..b762558847 100644
--- a/racket/src/racket/src/syntax.c
+++ b/racket/src/racket/src/syntax.c
@@ -6640,38 +6640,6 @@ static Scheme_Object *convert_srcloc(Scheme_Stx_Srcloc *srcloc, Scheme_Hash_Tree
   } else
     paren = NULL;
 
-  if ((!srcloc || (SCHEME_FALSEP(srcloc->src)
-                   && (srcloc->line < 0)
-                   && (srcloc->col < 0)
-                   && (srcloc->pos < 0)))
-      && !paren)
-    return scheme_false;
-
-  if (!srcloc)
-    srcloc = empty_srcloc;
-
-  src = srcloc->src;
-  if (SCHEME_PATHP(src)) {
-    /* To make paths portable and to avoid full paths, check whether the
-       path can be made relative (in which case it is turned into a list
-       of byte strings). If not, convert to a string using only the
-       last couple of path elements. */
-    dir = scheme_get_param(scheme_current_config(),
-                           MZCONFIG_WRITE_DIRECTORY);
-    if (SCHEME_TRUEP(dir))
-      src = scheme_extract_relative_to(src, dir, mt->path_cache);
-    if (SCHEME_PATHP(src)) {
-      src = scheme_hash_get(mt->path_cache, scheme_box(srcloc->src));
-      if (!src) {
-        src = srcloc_path_to_string(srcloc->src);
-        scheme_hash_set(mt->path_cache, scheme_box(srcloc->src), src);
-      }
-    } else {
-      /* use the path directly and let the printer make it relative */
-      src = srcloc->src;
-    }
-  }
-
   preserved_properties = scheme_null;
   if (props) {
     Scheme_Object *key, *val, **a = NULL;
@@ -6701,6 +6669,39 @@ static Scheme_Object *convert_srcloc(Scheme_Stx_Srcloc *srcloc, Scheme_Hash_Tree
     }
   }
 
+  if ((!srcloc || (SCHEME_FALSEP(srcloc->src)
+                   && (srcloc->line < 0)
+                   && (srcloc->col < 0)
+                   && (srcloc->pos < 0)))
+      && !paren
+      && SCHEME_NULLP(preserved_properties))
+    return scheme_false;
+
+  if (!srcloc)
+    srcloc = empty_srcloc;
+
+  src = srcloc->src;
+  if (SCHEME_PATHP(src)) {
+    /* To make paths portable and to avoid full paths, check whether the
+       path can be made relative (in which case it is turned into a list
+       of byte strings). If not, convert to a string using only the
+       last couple of path elements. */
+    dir = scheme_get_param(scheme_current_config(),
+                           MZCONFIG_WRITE_DIRECTORY);
+    if (SCHEME_TRUEP(dir))
+      src = scheme_extract_relative_to(src, dir, mt->path_cache);
+    if (SCHEME_PATHP(src)) {
+      src = scheme_hash_get(mt->path_cache, scheme_box(srcloc->src));
+      if (!src) {
+        src = srcloc_path_to_string(srcloc->src);
+        scheme_hash_set(mt->path_cache, scheme_box(srcloc->src), src);
+      }
+    } else {
+      /* use the path directly and let the printer make it relative */
+      src = srcloc->src;
+    }
+  }
+
   vec = scheme_make_vector(((paren || !SCHEME_NULLP(preserved_properties))
                             ? (SCHEME_NULLP(preserved_properties)
                                ? 6