Initial reader macro syntax

With syntax support for a variety of regex types (BRE, ERE and PCRE) and
for "ignore case" and "global" options, but with only PCRE implemented
underneath via cl-ppcre [0].

[0]: https://edicl.github.io/cl-ppcre/

1 files changed, 624 insertions, 0 deletions

diff --git a/tests/org/euandre/resyn-test.lisp b/tests/org/euandre/resyn-test.lisp
new file mode 100644
index 0000000..660e74f
--- /dev/null
+++ b/tests/org/euandre/resyn-test.lisp
@@ -0,0 +1,624 @@
+(defpackage :org.euandre.resyn-test
+  (:use :cl)
+  (:local-nicknames (:resyn :org.euandre.resyn))
+  (:export :main))
+(in-package :org.euandre.resyn-test)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil))
+  (set-dispatch-macro-character #\# #\~ #'resyn:reader))
+
+(defun test-segment-reader ()
+  (assert
+    (equal '(("abc" "def") (() ()))
+           (with-input-from-string (s "abc/def/")
+             (resyn::segment-reader s #\/ 2))))
+  (assert
+    (equal '(("abc" "def" "ghi") (() () ()))
+           (with-input-from-string (s "abc/def/ghi/")
+             (resyn::segment-reader s #\/ 3))))
+  (assert
+    (equal '(("abc" "def") (() ()))
+           (with-input-from-string (s "abc/def/ghi/")
+             (resyn::segment-reader s #\/ 2))))
+  (assert
+    (equal '(("abc") (()))
+           (with-input-from-string (s "abc/def/ghi/")
+             (resyn::segment-reader s #\/ 1))))
+  (assert
+    (equal '(() ())
+           (with-input-from-string (s "abc/def/ghi/")
+             (resyn::segment-reader s #\/ 0))))
+  (assert
+    (equal '(() ())
+           (with-input-from-string (s "abc/def/ghi/")
+             (resyn::segment-reader s #\/ -1))))
+  (assert
+    (equal :eof
+           (handler-case
+               (progn
+                 (with-input-from-string (s "abc/def/ghi/")
+                   (resyn::segment-reader s #\/ 4))
+                 (assert nil))
+             (end-of-file ()
+               :eof))))
+  (assert
+    (equal '((("abc") (())) "def/ghi/")
+           (with-input-from-string (s "abc/def/ghi/")
+             (list
+              (resyn::segment-reader s #\/ 1)
+              (read-line s)))))
+  (assert
+    (equal '(("") (()))
+           (with-input-from-string (s "abc/def/ghi/")
+             (resyn::segment-reader s #\a 1))))
+  (assert
+    (equal '(("a") (()))
+           (with-input-from-string (s "abc/def/ghi/")
+             (resyn::segment-reader s #\b 1))))
+  (assert
+    (equal '(("ab" "/ab" "/ab") (() () ()))
+           (with-input-from-string (s "abc/abc/abc/")
+             (resyn::segment-reader s #\c 3))))
+  (assert
+    (equal '(("" "" "" "" "") (() () () () ()))
+           (with-input-from-string (s ".....")
+             (resyn::segment-reader s #\. 5))))
+  (assert
+    (equal '(("se\\/g1" "seg2\\\\" "\\.seg3") (() () ()))
+           (with-input-from-string (s "se\\/g1/seg2\\\\/\\.seg3/")
+             (resyn::segment-reader s #\/ 3))))
+  (assert
+    (equal '(("%not") (()))
+           (with-input-from-string (s "\\%not/")
+             (resyn::segment-reader s #\/ 1))))
+  (assert
+    (equal '(("%(escaped)") (()))
+           (with-input-from-string (s "\\%(escaped)/")
+             (resyn::segment-reader s #\/ 1))))
+  (assert
+    (equal '(("%\\(escaped\\)") (()))
+           (with-input-from-string (s "\\%\\(escaped\\)/")
+             (resyn::segment-reader s #\/ 1))))
+  (assert
+    (equal '(("a ~a here") (((progn cl-user::var))))
+           (with-input-from-string (s "a %(var) here/")
+             (resyn::segment-reader s #\/ 1))))
+  (assert
+    (equal '(("we ~a" "~a ~a") (((progn cl-user::have))
+                                ((progn cl-user::many)
+                                 (progn (cl-user::vars) (cl-user::here)))))
+           (with-input-from-string (s "we %(have)/%(many) %((vars) (here))/")
+             (resyn::segment-reader s #\/ 2))))
+  (assert
+    (equal '(("~a and " "%(without)") (((progn cl-user::with)) ()))
+            (with-input-from-string (s "%(with) and /\\%(without)/")
+              (resyn::segment-reader s #\/ 2))))
+  (assert
+    (equal '(("~a \" %(all) \\. %the \\/ things \\.\\? ~~ ~a")
+             (((progn cl-user::mix)
+               (progn cl-user::here))))
+            (with-input-from-string
+                (s "%(mix) \" \\%(all) \\. \\%the \\/ things \\.\\? ~ %(here)/")
+              (resyn::segment-reader s #\/ 1))))
+  (assert
+    (equal '(("~a %(one) \\\\~a \\\\%(three) \\\\\\\\~a")
+             (((progn cl-user::zero)
+               (progn cl-user::two)
+               (progn cl-user::four))))
+            (with-input-from-string
+                (s "%(zero) \\%(one) \\\\%(two) \\\\\\%(three) \\\\\\\\%(four)/")
+              (resyn::segment-reader s #\/ 1)))))
+
+(defun test-read-regex ()
+  (assert
+    (equal '("")
+           (with-input-from-string (s "/")
+             (resyn::read-regex s #\/ 1))))
+  (assert
+    (equal '("a")
+           (with-input-from-string (s "a/")
+             (resyn::read-regex s #\/ 1))))
+  (assert
+    (equal '("a"
+             (format nil "~a" (progn cl-user::b))
+             "%(c)"
+             (format nil "~a" (progn cl-user::d)))
+           (with-input-from-string (s "a/%(b)/\\%(c)/%(d)/")
+             (resyn::read-regex s #\/ 4))))
+  (assert
+    (equal '("a%~\\/")
+           (with-input-from-string (s "a\\%~\\//")
+             (resyn::read-regex s #\/ 1))))
+  (assert
+    (equal '("^(.*)\\.lisp\\$")
+           (with-input-from-string (s "^(.*)\\.lisp\\$/")
+             (resyn::read-regex s #\/ 1))))
+  (assert
+    (equal '((format nil "^(.*)\\.~a\\$" (progn cl-user::ext)))
+           (with-input-from-string (s "^(.*)\\.%(ext)\\$/")
+             (resyn::read-regex s #\/ 1)))))
+
+(defun test-match ()
+  (assert
+    (equal nil
+           (resyn:match
+            "abc"
+            "aaBcc"
+            :ERE)))
+  (assert
+    (equal "abc"
+           (resyn:match
+            "abc"
+            "aaBcc"
+            :ERE
+            :ignore-case? t))))
+
+(defun test-substitute ()
+  (assert
+    (equal "aaBcc"
+           (resyn::substitute
+            "abc"
+            "aaBcc"
+            "___"
+            :ERE)))  (assert
+    (equal "a___c"
+           (resyn::substitute
+            "abc"
+            "aaBcc"
+            "___"
+            :ERE
+            :ignore-case? t))))
+
+(defun test-reader ()
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               "abc"
+               resyn::str
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~m/abc/))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:substitute
+               "abc"
+               resyn::str
+               "def"
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~s/abc/def/))
+  (assert
+    (equal "4555556"
+           (#~m/45*6/ "01234555556789")))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               ""
+               resyn::str
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~m//))
+  (assert
+    (equal :type-error
+           (let ((*readtable* (copy-readtable nil)))
+             (set-dispatch-macro-character #\# #\~ #'resyn:reader *readtable*)
+             (handler-case
+                 (progn
+                   (read-from-string "#~a//")
+                   (assert nil))
+               (type-error () :type-error)))))
+  (assert
+    (equal ""
+           (#~m// "non empty string")))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                ""
+                resyn::str
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             /)
+           '(#~m///)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                ""
+                resyn::str
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             //)
+           '(#~m////)))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:substitute
+               "abc"
+               resyn::str
+               "def"
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~s/abc/def/))
+  (assert
+    (equal "defdefghi"
+           (#~s/abc/def/ "abcdefghi")))
+  (assert
+    (equal "0123-789"
+           (#~s/45*6/-/ "01234555556789")))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:substitute
+               "abc"
+               resyn::str
+               ""
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~s/abc//))
+  (assert
+    (equal "string containing  chars (changed)"
+           (#~s/abc// "string containing abc chars (changed)")))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:substitute
+               ""
+               resyn::str
+               "abc"
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~s//abc/))
+  (assert
+    (equal "abc1abc2abc3abc"
+           (#~s//abc/ "123")))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:substitute
+                ""
+                resyn::str
+                ""
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             /)
+           '(#~s////)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:substitute
+                ""
+                resyn::str
+                ""
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             //)
+           '(#~s/////)))
+  (assert
+    (equal "not"
+           (#~m_not_ "not the slash char")))
+  (assert
+    (equal "not slash char"
+           (#~s: the:: "not the slash char")))
+#+nil
+  (assert
+    (equal '("ab" "ac" "abc" "a") ;; FIXME: list of all matches?
+           (#~m/ab?c?/ "ab ac abc a")))
+  (assert
+    (equal "___ ___ ___"
+           (#~s/abc/___/ "abc abc abc")))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                "a%(b)c"
+                resyn::str
+                :ERE
+                :ignore-case? nil
+                :global? nil)))
+           '(#~m/a\%(b)c/)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:substitute
+                "a%(b)c"
+                resyn::str
+                "%(de)f"
+                :ERE
+                :ignore-case? nil
+                :global? nil)))
+           '(#~s/a\%(b)c/\%(de)f/)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                (format nil "a~ac" (progn b))
+                resyn::str
+                :ERE
+                :ignore-case? nil
+                :global? nil)))
+           '(#~m/a%(b)c/)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:substitute
+                (format nil "a~ac" (progn b))
+                resyn::str
+                (format nil "~af" (progn de))
+                :ERE
+                :ignore-case? nil
+                :global? nil)))
+           '(#~s/a%(b)c/%(de)f/)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                "a%(b)c"
+                resyn::str
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             %)
+           '(#~m/a\%(b)c/%)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:substitute
+                "a%(b)c"
+                resyn::str
+                "%(de)f"
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             $)
+           '(#~s/a\%(b)c/\%(de)f/$)))
+  (assert
+    (equal nil
+           (#~m/tirar \%(sub)/ "tirar uma var daqui")))
+  (assert
+    (equal "trocar uma var daqui"
+           (#~s/tirar \%(sub)/\%(repl)/ "trocar uma var daqui")))
+  (let ((sub "uma var"))
+    (assert
+      (equal "tirar uma var"
+             (#~m/tirar %(sub)/ "tirar uma var daqui"))))
+  (let ((sub "uma var")
+        (repl "um texto"))
+    (assert
+      (equal "tirar um texto daqui"
+             (#~s/tirar %(sub)/tirar %(repl)/ "tirar uma var daqui"))))
+  (assert
+    (equal "abc"
+           (#~m/abc/ "abcdefghi")))
+  (assert
+    (equal "defdefghi"
+           (#~s/abc/def/ "abcdefghi")))
+  (let ((place "here"))
+    (assert
+      (equal "percent sign here: %"
+             (#~m/percent sign %(place): \%/
+              "a percent sign here: %."))))
+  (let ((percent "%")
+        (dollar "$")
+        (from "here")
+        (to "there"))
+    (assert
+      (equal
+       "place: there, sign: $"
+       (#~s/place: %(from), sign: %(percent)/place: %(to), sign: %(dollar)/
+        "place: here, sign: %"))))
+  (assert
+    (equal "333444"
+           (#~m/3*444/ "111222333444")))
+  (let ((n 0))
+    (assert
+      (equal "111222"
+             (#~m/%((incf n))*222/ "111222333444"))))
+  (let ((n 0))
+    (assert
+      (equal "222333"
+             (#~m/%((incf n) (incf n))*333/ "111222333444"))))
+  (let ((n 0))
+    (assert
+      (equal "223223223"
+             (#~s/%((incf n))/%((incf n))/ "123123123"))))
+  (let ((b "real")
+        (pat "%\\(b\\)"))
+    (assert
+      (equal "real"
+             (#~m/%(b)/ "real embedded %(b) string")))
+    (assert
+      (equal nil
+             (#~m/%(b)/ "the embedded %(b) string")))
+    (assert
+      (equal "real and %(b)"
+             (#~m/%(b).*%(pat)/ "both real and %(b)"))))
+  (assert
+    (equal "the regex: #~m/ghi/"
+           (#~s|#~s/abc/def/|#~m/ghi/| "the regex: #~s/abc/def/")))
+  (assert
+    (equal "tildes (~) are covered: ~."
+           (#~s/~ are/tildes (~) are/ "~ are covered: ~.")))
+  (let ((tilde "~"))
+    (assert
+      (and
+        (equal "literal: ~"
+               (#~m/literal: ~/        "a literal: ~."))
+        (equal "literal: ~"
+               (#~m/literal: %(tilde)/ "a literal: ~.")))))
+  (assert
+    (equal "esc"
+           (#~m/.../ "escaping...")))
+  (assert
+    (equal ".../%()"
+           (#~m/\.\.\.\/\%\(\)/ "escaping.../%()")))
+  (assert
+    (equal "./"
+           (#~m/\.\// "escaping .%./")))
+  (assert
+    (equal "a"
+           (#~m/./ "anything")))
+  (assert
+    (equal nil
+           (#~m/\./ "anything")))
+  (assert
+    (equal " /// "
+           (#~m/ \/* / "before /// after")))
+  (assert
+    (equal "%(.*?)/"
+           (#~m/\%\(\.\*\?\)\// "%(.*?)/")))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               "abc"
+               resyn::str
+               :ERE
+               :ignore-case? t
+               :global? nil))
+           '#~m/abc/i))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               "aBc"
+               resyn::str
+               :ERE
+               :ignore-case? t
+               :global? nil))
+           '#~m/aBc/i))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                "aBc"
+                resyn::str
+                :ERE
+                :ignore-case? t
+                :global? nil))
+             i)
+           '(#~m/aBc/ii)))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               (format nil "aB~a%d" (progn c))
+               resyn::str
+               :ERE
+               :ignore-case? t
+               :global? nil))
+           '#~m/aB%(c)\%d/i))
+  (let ((c ".*f"))
+    (assert
+      (equal "%abcdef"
+             (#~m/\%aB%(c)/i " %abcdefghi"))))
+  (let ((var "defun"))
+    (assert
+      (equal "(DEFUN not-working ())"
+             (#~s/%(var)/defn/ "(DEFUN not-working ())")))
+    (assert
+      (equal "(defn working ())"
+             (#~s/%(var)/defn/i "(DEFUN working ())"))))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               "x"
+               resyn::str
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~/x/))
+  (assert
+    (equal "ALL THE THINGS"
+           (#~/ALL THE THINGS/ "MATCH ALL THE THINGS!")))
+  (let ((vars "all"))
+    (assert
+      (equal "with vars and all"
+             (#~/with vars and %(vars)/i "With vars and all!"))))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               "aBcD"
+               resyn::str
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~m/aBcD/E))
+  (assert
+    (equal '#~m/abc/
+           '#~m/abc/E))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               "x"
+               resyn::str
+               :BRE
+               :ignore-case? t
+               :global? t))
+           '#~m/x/igB))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                "x"
+                resyn::str
+                :BRE
+                :ignore-case? t
+                :global? t))
+             B)
+           '(#~m/x/igBB)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                "x"
+                resyn::str
+                :PCRE
+                :ignore-case? t
+                :global? t))
+             B)
+           '(#~m/x/igPB)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                "x"
+                resyn::str
+                :PCRE
+                :ignore-case? t
+                :global? t))
+             P)
+           '(#~m/x/igPP)))
+  (let ((str "string"))
+    (assert
+      (equal "a string"
+             (#~s/text/%(str)/ "a text"))))
+  (let ((resyn::str "string"))
+    (declare (ignorable resyn::str))
+    (assert
+      (equal "a a text"
+             (#~s/text/%(resyn::str)/ "a text"))))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:substitute
+                "text"
+                resyn::str
+                (format nil "~a" (progn str))
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             "a text")
+           '(#~s/text/%(str)/ "a text")))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:substitute
+                "text"
+                resyn::str
+                (format nil "~a" (progn resyn::str))
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             "a text")
+           '(#~s/text/%(resyn::str)/ "a text"))))
+
+(defparameter test-fns
+  '(test-segment-reader
+    test-read-regex
+    test-match
+    test-substitute
+    test-reader))
+
+(defun main ()
+  (dolist (f test-fns)
+    (funcall f)))