From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 3 May 2017 07:57:21 +0000 (-0700)
Subject: Change pgsql to use regsexp.
X-Git-Tag: mit-scheme-pucked-9.2.12~14^2~86
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d800dd8da3bf9b2d1f0eec80cd128ab38ff764c4;p=mit-scheme.git

Change pgsql to use regsexp.
---

diff --git a/src/runtime/pgsql.scm b/src/runtime/pgsql.scm
index f224583a6..126687d8f 100644
--- a/src/runtime/pgsql.scm
+++ b/src/runtime/pgsql.scm
@@ -204,17 +204,23 @@ USA.
   (if string
       (begin
 	(write-string ": " port)
-	(let ((regs
-	       (re-string-match "\\`\\s *\\(error:\\)?\\s *\\(.*\\)\\s *\\'"
-				string
-				#t)))
-	  (if regs
-	      (write-string string
-			    port
-			    (re-match-start-index 2 regs)
-			    (re-match-end-index 2 regs))
-	      (write-string string port))))
+	(write-string
+	 (let ((result (regsexp-match-string error-regsexp string)))
+	   (if result
+	       (cdr (assv 'message (cddr result)))
+	       string))
+	 port))
       (write-string "." port)))
+
+(define error-regsexp
+  (compile-regsexp
+   '(seq (string-start)
+	 (* (char-set whitespace))
+	 (? (string-ci "error:"))
+	 (* (char-set whitespace))
+	 (group message (* (any-char)))
+	 (* (char-set whitespace))
+	 (string-end))))
 
 (define (open-pgsql-conn parameters #!optional wait?)
   (guarantee-pgsql-available)