suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix preservation of properties absent a source location

Browse Source
This commit is contained in:
Matthew Flatt 2016-12-14 08:13:17 -07:00
parent 6ec5b27f81
commit ce370c2f64
2 changed files with 48 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
pkgs/racket-test-core/tests/racket/stx.rktl
View File

@ -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:

65
racket/src/racket/src/syntax.c
View File

@ -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