summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/ChangeLog3
-rw-r--r--libguile/read.c13
-rw-r--r--test-suite/ChangeLog5
-rw-r--r--test-suite/tests/reader.test6
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)))))