From 49718a027333775f28d463d4e80d5e5238ef68a3 Mon Sep 17 00:00:00 2001 From: Nathan Bird Date: Tue, 26 Jan 2010 16:43:02 -0500 Subject: [PATCH] in output-sql (sql-relational-exp)-> made it not output anything if the relation has no subexpressions. --- sql/expressions.lisp | 41 ++++++++++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 13 deletions(-) diff --git a/sql/expressions.lisp b/sql/expressions.lisp index 746ed00..2cb7339 100644 --- a/sql/expressions.lisp +++ b/sql/expressions.lisp @@ -242,19 +242,34 @@ ;; should do arity checking of subexpressions (defmethod output-sql ((expr sql-relational-exp) database) - (with-slots (operator sub-expressions) - expr - (let ((subs (if (consp (car sub-expressions)) - (car sub-expressions) - sub-expressions))) - (write-char #\( *sql-stream*) - (do ((sub subs (cdr sub))) - ((null (cdr sub)) (output-sql (car sub) database)) - (output-sql (car sub) database) - (write-char #\Space *sql-stream*) - (output-sql operator database) - (write-char #\Space *sql-stream*)) - (write-char #\) *sql-stream*))) + (with-slots (operator sub-expressions) expr + ;; we do this as two runs so as not to emit confusing superflous parentheses + ;; The first loop renders all the child outputs so that we can skip anding with + ;; empty output (which causes sql errors) + ;; the next loop simply emits each sub-expression with the appropriate number of + ;; parens and operators + (flet ((trim (sub) + (string-trim '(#\space #\newline #\return #\tab #\no-break_space) + (with-output-to-string (*sql-stream*) + (output-sql sub database))))) + (let ((str-subs (loop for sub in sub-expressions + for str-sub = (trim sub) + when (and str-sub (> (length str-sub) 0)) + collect str-sub))) + (case (length str-subs) + (0 nil) + (1 (write-string (first str-subs) *sql-stream*)) + (t + (write-char #\( *sql-stream*) + (write-string (first str-subs) *sql-stream*) + (loop for str-sub in (rest str-subs) + do + (write-char #\Space *sql-stream*) + (output-sql operator database) + (write-char #\Space *sql-stream*) + (write-string str-sub *sql-stream*)) + (write-char #\) *sql-stream*)) + )))) t) (defclass sql-upcase-like (sql-relational-exp) -- 2.34.1