diff options
-rw-r--r-- | libguile/ChangeLog | 3 | ||||
-rw-r--r-- | libguile/read.c | 13 | ||||
-rw-r--r-- | test-suite/ChangeLog | 5 | ||||
-rw-r--r-- | test-suite/tests/reader.test | 6 |
4 files changed, 27 insertions, 0 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 09378ff97..a356c41fe 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,8 @@ 2007-08-23 Ludovic Courtès <ludo@gnu.org> + * read.c (scm_read_quote): Record position and copy source + expression when asked to. Reported by Kevin Ryde. + * stime.c: Define `_REENTRANT' only if not already defined. 2007-08-21 Kevin Ryde <user42@zip.com.au> diff --git a/libguile/read.c b/libguile/read.c index d61723efb..e4211c5b0 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -610,6 +610,8 @@ static SCM scm_read_quote (int chr, SCM port) { SCM p; + long line = SCM_LINUM (port); + int column = SCM_COL (port) - 1; switch (chr) { @@ -643,6 +645,17 @@ scm_read_quote (int chr, SCM port) } p = scm_cons2 (p, scm_read_expression (port), SCM_EOL); + if (SCM_RECORD_POSITIONS_P) + scm_whash_insert (scm_source_whash, p, + scm_make_srcprops (line, column, + SCM_FILENAME (port), + SCM_COPY_SOURCE_P + ? (scm_cons2 (SCM_CAR (p), + SCM_CAR (SCM_CDR (p)), + SCM_EOL)) + : SCM_UNDEFINED, + SCM_EOL)); + return p; } diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index cee19d708..bb6d44292 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2007-08-23 Ludovic Courtès <ludo@gnu.org> + + * tests/reader.test (read-options)[positions on quote]: New + test, proposed by Kevin Ryde. + 2007-08-23 Kevin Ryde <user42@zip.com.au> * tests/ports.test (port-for-each): New test for passing freed cell, diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test index 2d9171803..3d37c1f7d 100644 --- a/test-suite/tests/reader.test +++ b/test-suite/tests/reader.test @@ -152,5 +152,11 @@ (lambda () (read-string "(+ 1 2 3)"))))) (and (equal? (source-property sexp 'line) 0) + (equal? (source-property sexp 'column) 0)))) + (pass-if "positions on quote" + (let ((sexp (with-read-options '(positions) + (lambda () + (read-string "'abcde"))))) + (and (equal? (source-property sexp 'line) 0) (equal? (source-property sexp 'column) 0))))) |