From 6f3545ae20ad81a1c3a1bc1ad9f107f56348b4e3 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Fri, 3 Feb 2023 18:52:06 -0500 Subject: [PATCH 1/4] Additional tests for the connection pool --- postmodern/tests/tests.lisp | 65 ++++++++++++++++++++++++++++++++++--- 1 file changed, 60 insertions(+), 5 deletions(-) diff --git a/postmodern/tests/tests.lisp b/postmodern/tests/tests.lisp index 6f75c9d..39edd14 100644 --- a/postmodern/tests/tests.lisp +++ b/postmodern/tests/tests.lisp @@ -83,14 +83,18 @@ (test application-name (with-application-connection (is (equal - (query "select distinct application_name from pg_stat_activity where application_name = 'george'" + (query "select distinct application_name from pg_stat_activity + where application_name = 'george'" :single) "george")))) + (test connection-pool - (let* ((db-params (append (prompt-connection-to-postmodern-db-spec - (cl-postgres-tests:prompt-connection)) '(:pooled-p t))) + (let* ((db-params (append (prompt-connection-to-postmodern-db-spec + (cl-postgres-tests:prompt-connection)) + '(:pooled-p t))) (pooled (apply 'connect db-params))) + (format t "~%test-connection-pool db-params ~a" db-params) (disconnect pooled) (let ((pooled* (apply 'connect db-params))) (is (eq pooled pooled*)) @@ -101,6 +105,55 @@ (disconnect pooled*)) (clear-connection-pool))) +(defun create-pool-fixture () + (let ((connection-list nil) + (db nil)) + (with-test-connection + (let ((dbs (list-databases :names-only t)) + (base-connection (subseq (prompt-connection-to-postmodern-db-spec + (cl-postgres-tests:prompt-connection)) + 0 6))) + (setf base-connection (append base-connection '(:use-ssl :try :pooled-p t))) + (loop for y from 0 to 3 + do (setf db (format nil "tpssl~a" y)) + (when (not (member db dbs :test #'equal)) + (query (format nil "create database ~a" db))) + (let ((conn (append (list db) (subseq base-connection 1 10)))) + (push conn connection-list) + (pomo:with-connection conn + (query (format nil + "create table if not exists testtable~a (id integer,comment text)" + y)) + (query (format nil + "insert into testtable~a (id,comment) values (~a,'comment ~a')" + y y y))))))))) + +(defun drop-pool-fixture () + (with-test-connection + (loop for x from 0 to 3 do + (when (database-exists-p (format nil "tpssl~a" x)) + (query (format nil "drop database tpssl~a" x)))))) + +(test connection-pool-multiple-dbs + (create-pool-fixture) + (let ((ran-list '(2 2 1 2 0 0 2 1 1 1 0 1 1 2 0 1 1 0 0 0 0)) + (connection-list nil) + (db nil)) + (with-test-connection + (let ((base-connection (subseq (prompt-connection-to-postmodern-db-spec + (cl-postgres-tests:prompt-connection)) + 0 6))) + (setf base-connection (append base-connection '(:use-ssl :try :pooled-p t))) + (loop for y from 0 to 3 + do (setf db (format nil "tpssl~a" y)) + (let ((conn (append (list db) (subseq base-connection 1 10)))) + (push conn connection-list))) + (loop for x in ran-list do + (pomo:with-connection (elt connection-list 0) + (is (pomo:list-tables t))))) + (clear-connection-pool))) + (drop-pool-fixture)) + (test reconnect (with-test-connection (disconnect *database*) @@ -122,7 +175,8 @@ (with-test-connection (destructuring-bind (a b c d e f) (query (:select 22 (:type 44.5 double-precision) "abcde" t (:type 9/2 (numeric 5 2)) - (:[] #("A" "B") 2)) :row) + (:[] #("A" "B") 2)) + :row) (is (eql a 22)) (is (eql b 44.5d0)) (is (string= c "abcde")) @@ -134,7 +188,8 @@ (with-test-connection (is (= (query (:select '* :from (:as (:select (:as 1 'as)) 'where) - :where (:= 'where.as 1)) :single!) + :where (:= 'where.as 1)) + :single!) 1)))) (test time-types From 9a105cb27e28255b55a55e43caf2a2b0b8deb81c Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Fri, 3 Feb 2023 18:52:30 -0500 Subject: [PATCH 2/4] Partial fix for the dollar quote in execute-file Postmodern limits Tags within the dollar quote to alphabetic characters. Postgresql documentation is clear that any character can be in a tag. This commit reduces the limitation by allowing any character other than digital characters. To distinguish digital characters in a tag from parameter placeholders will require a second state to the state machine in parse-query. --- postmodern/execute-file.lisp | 41 ++++---- postmodern/tests/test-execute-file.lisp | 123 +++++++++++++++++++++++- 2 files changed, 146 insertions(+), 18 deletions(-) diff --git a/postmodern/execute-file.lisp b/postmodern/execute-file.lisp index 90a704c..fdf3f3a 100644 --- a/postmodern/execute-file.lisp +++ b/postmodern/execute-file.lisp @@ -49,10 +49,13 @@ (pop (parser-tags p))) (defmethod reset-state ((p parser) &key tagp) - "Depending on the current tags stack, set P state to either :eat or :eqt" + "Depending on the current tags stack, set P state to :eat, :ett or :eqt" (setf (parser-state p) (cond ((null (parser-tags p)) :eat) - (tagp :ett) + ((or tagp + (> (length (parser-tags p)) + 0)) + :ett) (t :eqt)))) #| @@ -143,7 +146,8 @@ should return ((:eat :eqt :edq) (write-char char (parser-stream state))) - (:tag (push-new-tag state)) + (:tag + (push-new-tag state)) (:eot ; check the tag stack (cond ((= 1 (length (parser-tags state))) @@ -178,20 +182,23 @@ should return (setf (parser-state state) :eqt)) ((member (parser-state state) '(:tag)) - ;; only letters are allowed in tags - (if (alpha-char-p char) - (extend-current-tag state char) - - (progn - ;; not a tag actually: remove the - ;; parser-tags entry and push back its - ;; contents to the main output stream - (let ((tag (pop-current-tag state))) - (format (parser-stream state) - "$~a~c" - tag - char)) - (reset-state state))))))) + ;; any non-numeric characters are allowed in tags + ;; numeric characters immediately following a $ indicates a parameter + ;; not a tag + (if + (not (digit-char-p char)) + (extend-current-tag state char) + + (progn + ;; not a tag actually: remove the + ;; parser-tags entry and push back its + ;; contents to the main output stream + (let ((tag (pop-current-tag state))) + (format (parser-stream state) + "$~a~c" + tag + char)) + (reset-state state))))))) :finally (return (get-output-stream-string (parser-stream state)))) (end-of-file (e) diff --git a/postmodern/tests/test-execute-file.lisp b/postmodern/tests/test-execute-file.lisp index 971daf6..71132f6 100644 --- a/postmodern/tests/test-execute-file.lisp +++ b/postmodern/tests/test-execute-file.lisp @@ -16,10 +16,131 @@ (defparameter *bad-file* (asdf:system-relative-pathname :postmodern "postmodern/tests/test-execute-file-broken.sql")) (defparameter *bad-file-with-transaction* (asdf:system-relative-pathname :postmodern "postmodern/tests/test-execute-file-broken-transaction.sql")) +;; Test Parse Dollar Quoted String Constants +(test basic-dollar-quote + (is (equal (with-input-from-string (s "$$Dianne's horse$$;;") + (pomo::parse-query s)) + "$$Dianne's horse$$")) + (is (equal (with-input-from-string (s "SELECT $$ UPPER(';'); $$;") + (pomo::parse-query s)) + "SELECT $$ UPPER(';'); $$")) + (is (equal (with-input-from-string (s "DO $$ +DECLARE + sql text; + dropped int; +BEGIN + SELECT count(*)::int, 'DROP FUNCTION ' || string_agg(oid::regprocedure::text, '; DROP FUNCTION ') + FROM pg_proc + WHERE proname ='gateway_error' AND pg_function_is_visible(oid) + INTO dropped, sql; + IF dropped > 0 THEN + EXECUTE sql; + END IF; +END; +$$ LANGUAGE plpgsql;") + (pomo::parse-query s)) +"DO $$ +DECLARE + sql text; + dropped int; +BEGIN + SELECT count(*)::int, 'DROP FUNCTION ' || string_agg(oid::regprocedure::text, '; DROP FUNCTION ') + FROM pg_proc + WHERE proname ='gateway_error' AND pg_function_is_visible(oid) + INTO dropped, sql; + IF dropped > 0 THEN + EXECUTE sql; + END IF; +END; +$$ LANGUAGE plpgsql"))) + +;; PARSE QUERY DOES NOT WORK WITH THE LAST TEST PROPERLY (loses the END; +(test dollar-quote-with-matching-tags + (is (equal (with-input-from-string (s "$a$Dianne's horse$a$;;") + (pomo::parse-query s)) + "$a$Dianne's horse$a$")) + (is (equal (with-input-from-string (s "$abc$Dianne's horse$abc$;;") + (pomo::parse-query s)) + "$abc$Dianne's horse$abc$")) + (is (equal (with-input-from-string (s "$_$Dianne's horse$_$;;") + (pomo::parse-query s)) + "$_$Dianne's horse$_$")) + (is (equal (with-input-from-string (s "$.$Dianne's horse$.$;;") + (pomo::parse-query s)) + "$.$Dianne's horse$.$")) + (is (equal (with-input-from-string (s "BEGIN + RETURN ($1 ~ $q$[\t\r\n\v\\]$q$); +END;;") + (pomo::parse-query s)) + "BEGIN + RETURN ($1 ~ $q$[\t\r\n\v\\]$q$)")) +) + +(test dollar-quote-with-mismatched-tags + (signals error (with-input-from-string (s "$a$Dianne's horse$b$;;") + (pomo::parse-query s))) + (signals error (with-input-from-string (s "$a$Dianne's horse$$;;") + (pomo::parse-query s))) + (signals error (with-input-from-string (s "$$Dianne's horse$b$;;") + (pomo::parse-query s)))) + +(test dollar-quote-with-parameters-outside-tag + (is (equal (with-input-from-string (s "$abc$Dianne's horse$abc$ where id= $1;;") + (pomo::parse-query s)) + "$abc$Dianne's horse$abc$ where id= $1")) + (is (equal (with-input-from-string (s "$abc$Dianne's horse$abc$ where id= $1 and name=$2;;") + (pomo::parse-query s)) + "$abc$Dianne's horse$abc$ where id= $1 and name=$2"))) + +(test dollar-quote-with-parameters-inside-tag + (is (equal (with-input-from-string (s "s $_$ ab = $1 cd $_$ s;;") + (pomo::parse-query s)) + "s $_$ ab = $1 cd $_$ s"))) + +(test dollar-quote-with-internal-statements + (is (equal (with-input-from-string (s "CREATE FUNCTION public.film_in_stock(p_film_id integer, p_store_id integer, OUT p_film_count integer) RETURNS SETOF integer + LANGUAGE sql + AS $_$ + SELECT inventory_id + FROM inventory + WHERE film_id = $1 + AND store_id = $2 + AND inventory_in_stock(inventory_id); +$_$;") + (pomo::parse-query s)) + "CREATE FUNCTION public.film_in_stock(p_film_id integer, p_store_id integer, OUT p_film_count integer) RETURNS SETOF integer + LANGUAGE sql + AS $_$ + SELECT inventory_id + FROM inventory + WHERE film_id = $1 + AND store_id = $2 + AND inventory_in_stock(inventory_id); +$_$"))) + +(test dollar-quote-with-internal-parameters + (is (equal (with-input-from-string (s "$abc$Dianne's $1 horse$abc$;;") + (pomo::parse-query s)) + "$abc$Dianne's $1 horse$abc$"))) + +;; PARSE QUERY DOES NOT WORK WITH THIS TEST PROPERLY +(test dollar-quote-with-nested-tags + (is (equal (with-input-from-string (s "$function$ +BEGIN + RETURN ($1 ~ $q$ something here $q$); +END; +$function$;") + (pomo::parse-query s)) +"$function$ +BEGIN + RETURN ($1 ~ $q$ something here $q$); +END; +$function$"))) + ;; Test Parse Comments (test basic-multi-line1 - (is (equal (postmodern::parse-comments " something1 /* comment */ something2") + (is (equal (pomo::parse-comments " something1 /* comment */ something2") " something1 something2"))) (test basic-multi-line2 From fc315b912fb452d317cda02ad2b554f25cb0d93b Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Thu, 9 Feb 2023 11:18:42 -0500 Subject: [PATCH 3/4] Fix bug in drop-role When a role had ownership in objects in multiple databases, drop-role tried to drop the role before all objects had been reassigned to new owner. This has now been fixed. --- postmodern/roles.lisp | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/postmodern/roles.lisp b/postmodern/roles.lisp index 8f8afd5..04d1f51 100644 --- a/postmodern/roles.lisp +++ b/postmodern/roles.lisp @@ -433,17 +433,24 @@ group roles." (when (not (role-exists-p new-owner)) (setf new-owner (cl-postgres::connection-user *database*))) (if (eq database :all) - (loop for x in (list-databases :names-only t) do - (with-connection (list x (cl-postgres::connection-user *database*) + (progn + (loop for x in (list-databases :names-only t) do + (with-connection (list x (cl-postgres::connection-user *database*) + (cl-postgres::connection-password *database*) + (cl-postgres::connection-host *database*) + :port (cl-postgres::connection-port *database*) + :use-ssl (cl-postgres::connection-use-ssl *database*)) + (when (and (not (string= role-name "postgres")) + (role-exists-p role-name)) + (query (format nil "reassign owned by ~a to ~a" role-name new-owner)) + (query (format nil "drop owned by ~a" role-name))))) + (with-connection (list (cl-postgres::connection-db *database*) + (cl-postgres::connection-user *database*) (cl-postgres::connection-password *database*) (cl-postgres::connection-host *database*) :port (cl-postgres::connection-port *database*) :use-ssl (cl-postgres::connection-use-ssl *database*)) - (when (and (not (string= role-name "postgres")) - (role-exists-p role-name)) - (query (format nil "reassign owned by ~a to ~a" role-name new-owner)) - (query (format nil "drop owned by ~a" role-name)) - (query (format nil "drop role if exists ~a" role-name))))) + (query (format nil "drop role if exists ~a" role-name)))) (with-connection (list database (cl-postgres::connection-user *database*) (cl-postgres::connection-password *database*) (cl-postgres::connection-host *database*) @@ -454,7 +461,7 @@ group roles." (query (format nil "reassign owned by ~a to ~a" role-name new-owner)) (query (format nil "drop owned by ~a cascade" role-name)) (query (format nil "drop role if exists ~a" role-name))))) - (not (role-exists-p role-name))) + (not (role-exists-p role-name))) (defun list-role-permissions (&optional role) "This returns a list of sublists of the permissions granted within the From 1fe2be474ccf1d716af294d56b99db74239911e7 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Sat, 11 Feb 2023 09:31:10 -0500 Subject: [PATCH 4/4] Dollar Quoted tags restrictions relaxed Dollar quoted tags are allowed in sql files. Prior to Postmodern version 1.33.8 only alphabetic characters were allowed in tags in order to use the execute-file function. Postgresql documentation and industry practice allow any character to be in a dollar quoted tag. Postmodern version 1.33.8 relaxes the alphabetic character requirement. The only limitation now is that digit characters cannot be in the first position in a tag. --- CHANGELOG.md | 12 ++++++++ README.md | 2 +- cl-postgres.asd | 2 +- doc/postmodern.html | 15 ++++++++- doc/postmodern.org | 9 ++++++ postmodern.asd | 2 +- postmodern/execute-file.lisp | 41 +++++++++++++++---------- postmodern/tests/test-execute-file.lisp | 30 +++++++++++++++--- s-sql.asd | 2 +- 9 files changed, 90 insertions(+), 25 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 81ad4ef..a1ff974 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,15 @@ +# Changelog 1.33.8 + +Dollar Quoted tags are allowed in files. Prior to Postmodern version 1.33.8 only +alphabetic characters were allowed in tags. Postgresql documentation and industry +practice allow any character to be in a dollar quoted tag. Postmodern version 1.33.8 +relaxes the alphabetic character requirement. The only limitation now is that digit +characters cannot be in the first position in a tag. + +This version also fixes a bug in the postmodern function drop-role. Previously if a role +owned objects in multiple databases, the drop-role function tried to drop the role before +all owned objects were reassigned owners. + # Changelog 1.33.7 Changes in cl-postgres and s-sql to allow use of plain proper lists in parameterized queries. Previously only vectors could be used. The following show examples using both vectors and lists in queries using both raw sql and s-sql. ```lisp diff --git a/README.md b/README.md index 9ff77f5..d0a06ec 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ A Common Lisp PostgreSQL programming interface --- -Version 1.33.7 +Version 1.33.8 Postmodern is a Common Lisp library for interacting with [PostgreSQL](http://www.postgresql.org) databases. It is under active development. Features are: diff --git a/cl-postgres.asd b/cl-postgres.asd index ecd4d43..68a755b 100644 --- a/cl-postgres.asd +++ b/cl-postgres.asd @@ -16,7 +16,7 @@ :author "Marijn Haverbeke " :maintainer "Sabra Crolleton " :license "zlib" - :version "1.33.7" + :version "1.33.8" :depends-on ("md5" "split-sequence" "ironclad" "cl-base64" "uax-15" (:feature (:or :allegro :ccl :clisp :genera :armedbear :cmucl :lispworks) diff --git a/doc/postmodern.html b/doc/postmodern.html index fbe7f5b..728aecf 100644 --- a/doc/postmodern.html +++ b/doc/postmodern.html @@ -1,7 +1,7 @@ - + Postmodern Reference Manual @@ -3775,6 +3775,19 @@

function execute-file (filename &optional (pr set to nil.

+

+Dollar Quoted tags are allowed in files. Prior to Postmodern version 1.33.8 only +alphabetic characters were allowed in tags. Postgresql documentation and industry +practice allow any character to be in a dollar quoted tag. Postmodern version 1.33.8 +relaxes the alphabetic character requirement. The only limitation now is that digit +characters cannot be in the first position in a tag. +

+ +

+Execute-file does not support copy-in or copy-out in a file. If you have files +with that requirement, you will need to fall back on another solution. +

+

IMPORTANT NOTE: This utility function assumes that the file containing the sql queries can be trusted and bypasses the normal postmodern parameterization of diff --git a/doc/postmodern.org b/doc/postmodern.org index bda19b8..b150906 100644 --- a/doc/postmodern.org +++ b/doc/postmodern.org @@ -2327,6 +2327,15 @@ The default setting is to remove sql comments from the file before executing the sql code. If that causes problems, the remove-comments parameter can be set to nil. +Dollar Quoted tags are allowed in files. Prior to Postmodern version 1.33.8 only +alphabetic characters were allowed in tags. Postgresql documentation and industry +practice allow any character to be in a dollar quoted tag. Postmodern version 1.33.8 +relaxes the alphabetic character requirement. The only limitation now is that digit +characters cannot be in the first position in a tag. + +Execute-file does not support copy-in or copy-out in a file. If you have files +with that requirement, you will need to fall back on another solution. + IMPORTANT NOTE: This utility function assumes that the file containing the sql queries can be trusted and bypasses the normal postmodern parameterization of queries. diff --git a/postmodern.asd b/postmodern.asd index 97bdeb6..6870246 100644 --- a/postmodern.asd +++ b/postmodern.asd @@ -20,7 +20,7 @@ :maintainer "Sabra Crolleton " :homepage "https://github.com/marijnh/Postmodern" :license "zlib" - :version "1.33.7" + :version "1.33.8" :depends-on ("alexandria" "cl-postgres" "s-sql" diff --git a/postmodern/execute-file.lisp b/postmodern/execute-file.lisp index fdf3f3a..13fe843 100644 --- a/postmodern/execute-file.lisp +++ b/postmodern/execute-file.lisp @@ -1,6 +1,11 @@ ;;;; -*- Mode: LISP; Syntax: Ansi-Common-Lisp; Base: 10; Package: POSTMODERN; -*- (in-package :postmodern) +(defun disallowed-tag-char-p (char) + "Returns t if char is a character we are going to disallow in a tag" + (if (member char '(#\space #\tab #\newline #\linefeed #\page #\return #\backspace #\rubout)) + t nil)) + (defstruct parser filename (stream (make-string-output-stream)) @@ -140,7 +145,6 @@ should return (:eat (setf (parser-state state) :tag)) (:ett (setf (parser-state state) :tag)) (:tag (setf (parser-state state) :eot))) - ;; we act depending on the NEW state (case (parser-state state) ((:eat :eqt :edq) @@ -155,10 +159,10 @@ should return (format-current-tag state) (reset-state state :tagp t)) - (t ; are we closing the current tag? + (t ; are we closing the current tag? (if (maybe-close-tags state) - (reset-state state :tagp t) - + (progn + (reset-state state :tagp t)) ;; not the same tags, switch state back ;; don't forget to add the opening tag (progn @@ -171,7 +175,6 @@ should return (otherwise (cond ((member (parser-state state) '(:eat :eqt :ett :edq)) (write-char char (parser-stream state))) - ;; see ;; http://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-STRINGS-ESCAPE ;; we re-inject whatever we read in the \x @@ -186,13 +189,15 @@ should return ;; numeric characters immediately following a $ indicates a parameter ;; not a tag (if - (not (digit-char-p char)) + (or (not (digit-char-p char)) + (> (length (first (parser-tags state))) 0)) (extend-current-tag state char) (progn ;; not a tag actually: remove the ;; parser-tags entry and push back its ;; contents to the main output stream + (let ((tag (pop-current-tag state))) (format (parser-stream state) "$~a~c" @@ -203,7 +208,11 @@ should return (get-output-stream-string (parser-stream state)))) (end-of-file (e) (unless (eq :eat (parser-state state)) - (error e))))) + (error + (format nil "~a~%~%~a" e + "In this context, look particularly for mismatched dollar quoted tags or a dollar quoted tag +that starts with a digit. Digits in a dollar quoted tag should not be in the first position +or they will be confused with parameterized variable positions.")))))) (defstruct comment-parser buffer @@ -230,7 +239,7 @@ should return (defun parse-comments (str &optional (state (make-comment-parser))) (loop for char across str do -; (format t "~a ~a~%" char (char-code char)) + (case char (#\' (case (first (comment-parser-state state)) (:base (push :sq (comment-parser-state state)) @@ -254,7 +263,7 @@ should return (:slc ) (:sq (write-char char (comment-parser-stream state))) (:sb? (setf (first (comment-parser-state state)) :slc)) - (:mb? ; faked multi-line beginning, return to earlier state + (:mb? ; faked multi-line beginning, return to earlier state (pop (comment-parser-state state)) (when (eq (first (comment-parser-state state)) :base) @@ -270,10 +279,10 @@ should return (write-char char (comment-parser-stream state))) (:sb? (pop (comment-parser-state state)) (write-char char (comment-parser-stream state))) - (:mb? ; faked multi-line beginning, return to earlier state + (:mb? ; faked multi-line beginning, return to earlier state (pop (comment-parser-state state)) (when (eq (first (comment-parser-state state)) - :base) + :base) (write-char #\/ (comment-parser-stream state)) (write-char #\/ (comment-parser-stream state)))) (:me? (pop (comment-parser-state state)) @@ -291,8 +300,8 @@ should return (write-char #\/ (comment-parser-stream state)))) (:mlc (push :mb? (comment-parser-state state)) ) - (:me? ; actual ending of a multi-line comment - ; need to pop both the :me? amd tej :mlc + (:me? ; actual ending of a multi-line comment + ; need to pop both the :me? amd tej :mlc (pop (comment-parser-state state)) (pop (comment-parser-state state))))) (#\* (case (first (comment-parser-state state)) @@ -301,7 +310,7 @@ should return (:mlc ; maybe starting the end of a nested multi-line comment (push :me? (comment-parser-state state))) (:sq (write-char char (comment-parser-stream state))) - (:me? ; fake ending of a multi-line comment + (:me? ; fake ending of a multi-line comment (pop (comment-parser-state state)) (when (eq (first (comment-parser-state state)) :mlc) (push :me? (comment-parser-state state)))))) @@ -314,9 +323,9 @@ should return :base) (write-char #\/ (comment-parser-stream state)) (write-char char (comment-parser-stream state)))) - (:me? ; fake ending of a multi-line comment + (:me? ; fake ending of a multi-line comment (pop (comment-parser-state state))) - (:sb? ; fake single line comment + (:sb? ; fake single line comment (pop (comment-parser-state state)) (write-char #\- (comment-parser-stream state)) (write-char char (comment-parser-stream state))) diff --git a/postmodern/tests/test-execute-file.lisp b/postmodern/tests/test-execute-file.lisp index 71132f6..58beb9b 100644 --- a/postmodern/tests/test-execute-file.lisp +++ b/postmodern/tests/test-execute-file.lisp @@ -54,11 +54,16 @@ BEGIN END; $$ LANGUAGE plpgsql"))) -;; PARSE QUERY DOES NOT WORK WITH THE LAST TEST PROPERLY (loses the END; (test dollar-quote-with-matching-tags (is (equal (with-input-from-string (s "$a$Dianne's horse$a$;;") (pomo::parse-query s)) "$a$Dianne's horse$a$")) + (is (equal (with-input-from-string (s "$a$Dianne's horse$a$ ;;") + (pomo::parse-query s)) + "$a$Dianne's horse$a$ ")) + (is (equal (with-input-from-string (s "$a $Dianne's horse$a $ ;;") + (pomo::parse-query s)) + "$a $Dianne's horse$a $ ")) (is (equal (with-input-from-string (s "$abc$Dianne's horse$abc$;;") (pomo::parse-query s)) "$abc$Dianne's horse$abc$")) @@ -73,8 +78,7 @@ $$ LANGUAGE plpgsql"))) END;;") (pomo::parse-query s)) "BEGIN - RETURN ($1 ~ $q$[\t\r\n\v\\]$q$)")) -) + RETURN ($1 ~ $q$[\t\r\n\v\\]$q$)"))) (test dollar-quote-with-mismatched-tags (signals error (with-input-from-string (s "$a$Dianne's horse$b$;;") @@ -90,6 +94,12 @@ END;;") "$abc$Dianne's horse$abc$ where id= $1")) (is (equal (with-input-from-string (s "$abc$Dianne's horse$abc$ where id= $1 and name=$2;;") (pomo::parse-query s)) + "$abc$Dianne's horse$abc$ where id= $1 and name=$2")) + (is (equal (with-input-from-string (s "$abc$Dianne's horse$abc$ where id= $1 ;;") + (pomo::parse-query s)) + "$abc$Dianne's horse$abc$ where id= $1 ")) + (is (equal (with-input-from-string (s "$abc$Dianne's horse$abc$ where id= $1 and name=$2;; ") + (pomo::parse-query s)) "$abc$Dianne's horse$abc$ where id= $1 and name=$2"))) (test dollar-quote-with-parameters-inside-tag @@ -123,7 +133,6 @@ $_$"))) (pomo::parse-query s)) "$abc$Dianne's $1 horse$abc$"))) -;; PARSE QUERY DOES NOT WORK WITH THIS TEST PROPERLY (test dollar-quote-with-nested-tags (is (equal (with-input-from-string (s "$function$ BEGIN @@ -137,6 +146,19 @@ BEGIN END; $function$"))) +(test dollar-quote-with-digit-tag + (is (equal (with-input-from-string (s "$a1$Dianne's $1 horse$a1$;;") + (pomo::parse-query s)) + "$a1$Dianne's $1 horse$a1$")) + (is (equal (with-input-from-string (s "$a12$Dianne's $1 horse$a12$;;") + (pomo::parse-query s)) + "$a12$Dianne's $1 horse$a12$")) + (is (equal (with-input-from-string (s "$a1$Dianne's $1 horse$a1$ ;;") + (pomo::parse-query s)) + "$a1$Dianne's $1 horse$a1$ ")) + (signals error (with-input-from-string (s "$1ab$Dianne's $1 horse$1ab$ ;;") + (pomo::parse-query s)))) + ;; Test Parse Comments (test basic-multi-line1 diff --git a/s-sql.asd b/s-sql.asd index 53d6384..b079036 100644 --- a/s-sql.asd +++ b/s-sql.asd @@ -9,7 +9,7 @@ :author "Marijn Haverbeke " :maintainer "Sabra Crolleton " :license "zlib" - :version "1.33.7" + :version "1.33.8" :depends-on ("cl-postgres" "alexandria") :components