Merge pull request #1538 from cgay/multi-line-string-warnings

Fix multi-line string warnings

sources/dfmc/reader/interface.dylan

@@ -102,6 +102,11 @@ define serious-program-warning <character-code-too-large> (<invalid-token>)
   format-arguments token-string;
 end serious-program-warning;
 
+define serious-program-warning <invalid-multi-line-string-literal> (<invalid-token>)
+  format-string    "Invalid multi-line string literal: %s";
+  format-arguments detail;
+end serious-program-warning;
+
 define serious-program-warning <ratios-not-supported> (<invalid-token>)
   format-string
     "The ratio %s cannot be read because no ratio representation is "

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 :: <string>) => (maybe-trimmed :: <string>)
+    (string :: <string>, source-location) => (maybe-trimmed :: <string>)
   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(<invalid-multi-line-string-literal>,
+         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(<invalid-multi-line-string-literal>,
+         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(<invalid-multi-line-string-literal>,
+                 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(<string-fragment>,
        record: source-location.source-location-record,

sources/dfmc/reader/reader-library.dylan

@@ -71,6 +71,7 @@ define module dfmc-reader
         <integer-too-large>,
         <character-code-too-large>,
         <ratios-not-supported>,
+        <invalid-multi-line-string-literal>,
       <invalid-end-of-input>,
       <parser-error>,
       <manual-parser-error>,

sources/dfmc/reader/tests/literal-test-suite.dylan

@@ -289,17 +289,17 @@ def
 \<20>\<20>\<20>
    """},
              "\ndef\n");
-  assert-signals(<error>,
+  assert-signals(<invalid-multi-line-string-literal>,
                  read-fragment(#:string:{"""a  (only whitespace allowed after start delim)
 abc
 """}),
                  "junk on first line");
-  assert-signals(<error>,
+  assert-signals(<invalid-multi-line-string-literal>,
                  read-fragment(#:string:{"""
 abc
 xxx"""}),
                   "junk on last line");
-  assert-signals(<error>,
+  assert-signals(<invalid-multi-line-string-literal>,
                  read-fragment(#:string:{"""
    abc
   xxx  (this line not indented enough)