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

bc and cs: make srcloc->string compatible

Browse Source 
Currently, in Racket BC, the following program:

```
(srcloc->string (make-srcloc "x.rkt" #f #f 90 #f))
(srcloc->string (make-srcloc "x.rkt" #f 80 #f #f))
(srcloc->string (make-srcloc "x.rkt" #f #f #f #f))

(srcloc->string (make-srcloc "x.rkt" #f 80 90 #f))
(srcloc->string (make-srcloc "x.rkt" 70 #f 90 #f))
(srcloc->string (make-srcloc "x.rkt" 70 80 #f #f))
(srcloc->string (make-srcloc "x.rkt" 70 80 90 #f))
```

results in:

```
"x.rkt::90"
"x.rkt::80"
"x.rkt::-1"
"x.rkt::80"
"x.rkt:70:90"
"x.rkt:70:80"
"x.rkt:70:80"
```

This output is very confusing and inconsistent.
When we see "x.rkt::90", we can never be sure if it's a srcloc
whose position is 90, or a srcloc whose column is 90.
The same applies for "x.rkt:70:90".

Moreover, the srloc "x.rkt::-1" is weird and is arguably incorrect
(see #1371).

For CS, the output would sometimes contain `#f`, and that is fixed
here by not trying to add position information when it's not available.
This commit is contained in:
sorawee 2021-01-07 06:44:29 -08:00 committed by GitHub
parent bdc43a891a
commit d40c4d31c7
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 28 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/racket-test-core/tests/racket/read.rktl
View File

@ -1472,6 +1472,15 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; srcloc->string
(test "x.rkt" srcloc->string (make-srcloc "x.rkt" #f #f #f #f))
(test "x.rkt::90" srcloc->string (make-srcloc "x.rkt" #f #f 90 #f))
(test "x.rkt" srcloc->string (make-srcloc "x.rkt" #f 80 #f #f))
(test "x.rkt::90" srcloc->string (make-srcloc "x.rkt" #f 80 90 #f))
(test "x.rkt::90" srcloc->string (make-srcloc "x.rkt" 70 #f 90 #f))
(test "x.rkt:70:80" srcloc->string (make-srcloc "x.rkt" 70 80 #f #f))
(test "x.rkt:70:80" srcloc->string (make-srcloc "x.rkt" 70 80 90 #f))
(test "x.rkt:10:11" srcloc->string (make-srcloc "x.rkt" 10 11 100 8))
(test "x.rkt::100" srcloc->string (make-srcloc "x.rkt" #f #f 100 8))
(test "x.rkt::100" srcloc->string (chaperone-struct (make-srcloc "x.rkt" #f #f 100 8)

17
racket/src/bc/src/error.c
View File

@ -2120,9 +2120,6 @@ static char *make_srcloc_string(Scheme_Object *src, intptr_t line, intptr_t col,
return NULL;
}
if (col < 0)
col = pos + 1;
if (src && SCHEME_PATHP(src)) {
/* Strip off prefix matching the current directory: */
src = scheme_remove_current_directory_prefix(src);
@ -2144,12 +2141,18 @@ static char *make_srcloc_string(Scheme_Object *src, intptr_t line, intptr_t col,
result = (char *)scheme_malloc_atomic(srclen + 15);
if (col >= 0) {
if (line >= 0 && col >= 0) {
/* If both line and column are available, use the format `path:line:col` */
rlen = scheme_sprintf(result, srclen + 15, "%t:%L%ld",
srcstr, srclen, line, col-1);
srcstr, srclen, line, col-1);
} else if (pos >= 0) {
/* If pos is available, use the format `path::pos` */
rlen = scheme_sprintf(result, srclen + 15, "%t::%ld",
srcstr, srclen, pos);
} else {
rlen = scheme_sprintf(result, srclen + 15, "%t::",
srcstr, srclen);
/* Otherwise, use the format `path` */
rlen = scheme_sprintf(result, srclen + 15, "%t",
srcstr, srclen);
}
if (len) *len = rlen;

6
racket/src/cs/schemified/io.scm
View File

@ -31582,8 +31582,10 @@
(let ((app_0 (adjust-path (srcloc-source s_0))))
(let ((app_1 (srcloc-line s_0)))
(1/format "~a:~s:~s" app_0 app_1 (srcloc-column s_0))))
(let ((app_0 (adjust-path (srcloc-source s_0))))
(1/format "~a::~s" app_0 (srcloc-position s_0))))
(if (srcloc-position s_0)
(let ((app_0 (adjust-path (srcloc-source s_0))))
(1/format "~a::~s" app_0 (srcloc-position s_0)))
(1/format "~a" (adjust-path (srcloc-source s_0)))))
#f))))))
(define adjust-path
(lambda (p_0) (if (is-path? p_0) (relative-to-user-directory p_0) p_0)))

7
racket/src/io/srcloc/main.rkt
View File

@ -16,10 +16,13 @@
(adjust-path (srcloc-source s))
(srcloc-line s)
(srcloc-column s))]
[else
[(srcloc-position s)
(format "~a::~s"
(adjust-path (srcloc-source s))
(srcloc-position s))])))
(srcloc-position s))]
[else
(format "~a"
(adjust-path (srcloc-source s)))])))
(define (adjust-path p)
(cond