diff --git a/sources/dfmc/reader/interface.dylan b/sources/dfmc/reader/interface.dylan index 57dad13ab..663ed5218 100644 --- a/sources/dfmc/reader/interface.dylan +++ b/sources/dfmc/reader/interface.dylan @@ -102,6 +102,11 @@ define serious-program-warning () format-arguments token-string; end serious-program-warning; +define serious-program-warning () + format-string "Invalid multi-line string literal: %s"; + format-arguments detail; +end serious-program-warning; + define serious-program-warning () format-string "The ratio %s cannot be read because no ratio representation is " diff --git a/sources/dfmc/reader/lexer.dylan b/sources/dfmc/reader/lexer.dylan index eb96b2cce..207256141 100644 --- a/sources/dfmc/reader/lexer.dylan +++ b/sources/dfmc/reader/lexer.dylan @@ -934,26 +934,36 @@ end method decode-string; // character, the EOL sequence has already been canonicalized to just '\n', escape // sequences have been processed, and the start/end delimiters have been removed. define function trim-multi-line-prefix - (string :: ) => (maybe-trimmed :: ) + (string :: , source-location) => (maybe-trimmed :: ) let lines = split(string, '\n'); let junk = first(lines); let prefix = last(lines); if (~empty?(junk) & ~whitespace?(junk)) - error("invalid multi-line string literal - only whitespace may" - " follow the start delimiter \"\"\" on the same line"); + note(, + source-location: source-location, + token-string: extract-string(source-location), + detail: + "only whitespace may follow the start delimiter \"\"\" on the same line"); end; if (~empty?(prefix) & ~whitespace?(prefix)) - error("invalid multi-line string literal - only whitespace may" - " precede the end delimiter \"\"\" on the same line"); + note(, + source-location: source-location, + token-string: extract-string(source-location), + detail: + "only whitespace may precede the end delimiter \"\"\" on the same line"); end; local method remove-prefix (line) if (line = "") line elseif (~starts-with?(line, prefix)) - error("invalid multi-line string literal - each line must begin" - " with the same whitespace that precedes the end" - " delimiter (got %=, want %=)", - copy-sequence(line, end: prefix.size), prefix); + note(, + source-location: source-location, + token-string: extract-string(source-location), + detail: + format-to-string + ("each line must begin with the same whitespace that precedes the end" + " delimiter (got %=, want %=)", + copy-sequence(line, end: prefix.size), prefix)); else copy-sequence(line, start: prefix.size) end @@ -1172,7 +1182,7 @@ define method %make-string-literal let (string, multi-line?) = decode-string(source-location, bpos, epos, allow-escapes?); if (multi-line?) - string := trim-multi-line-prefix(string); + string := trim-multi-line-prefix(string, source-location); end; make(, record: source-location.source-location-record, diff --git a/sources/dfmc/reader/reader-library.dylan b/sources/dfmc/reader/reader-library.dylan index 902cd686c..1722580de 100644 --- a/sources/dfmc/reader/reader-library.dylan +++ b/sources/dfmc/reader/reader-library.dylan @@ -71,6 +71,7 @@ define module dfmc-reader , , , + , , , , diff --git a/sources/dfmc/reader/tests/literal-test-suite.dylan b/sources/dfmc/reader/tests/literal-test-suite.dylan index 7fdc84ca5..82ad55d08 100644 --- a/sources/dfmc/reader/tests/literal-test-suite.dylan +++ b/sources/dfmc/reader/tests/literal-test-suite.dylan @@ -289,17 +289,17 @@ def \<20>\<20>\<20> """}, "\ndef\n"); - assert-signals(, + assert-signals(, read-fragment(#:string:{"""a (only whitespace allowed after start delim) abc """}), "junk on first line"); - assert-signals(, + assert-signals(, read-fragment(#:string:{""" abc xxx"""}), "junk on last line"); - assert-signals(, + assert-signals(, read-fragment(#:string:{""" abc xxx (this line not indented enough)