From 965110995d6a942ef37b271fbcc08241f18bdaed Mon Sep 17 00:00:00 2001
From: Carl Gay <carlgay@gmail.com>
Date: Sun, 15 Oct 2023 22:09:29 +0000
Subject: [PATCH] Fix multi-line string warnings

Signal an appropriate compiler warning instead of just calling error()
---
 sources/dfmc/reader/interface.dylan           |  5 ++++
 sources/dfmc/reader/lexer.dylan               | 30 ++++++++++++-------
 sources/dfmc/reader/reader-library.dylan      |  1 +
 .../reader/tests/literal-test-suite.dylan     |  6 ++--
 4 files changed, 29 insertions(+), 13 deletions(-)

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 <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 "
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 :: <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,
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
         <integer-too-large>,
         <character-code-too-large>,
         <ratios-not-supported>,
+        <invalid-multi-line-string-literal>,
       <invalid-end-of-input>,
       <parser-error>,
       <manual-parser-error>,
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(<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)