PageRenderTime 58ms CodeModel.GetById 28ms RepoModel.GetById 0ms app.codeStats 0ms

/site/url-rewrite-0.1.1/test.lisp

https://github.com/vikram/lisplibraries
Lisp | 85 lines | 48 code | 10 blank | 27 comment | 4 complexity | e941b9f914531a9638cb1c14bf7d9242 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, CC-BY-SA-3.0, LGPL-3.0, BSD-3-Clause, GPL-2.0
  1. ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
  2. ;;; $Header: /usr/local/cvsrep/url-rewrite/test.lisp,v 1.8 2006/01/03 18:40:23 edi Exp $
  3. ;;; Copyright (c) 2004-2006, Dr. Edmund Weitz. All rights reserved.
  4. ;;; Redistribution and use in source and binary forms, with or without
  5. ;;; modification, are permitted provided that the following conditions
  6. ;;; are met:
  7. ;;; * Redistributions of source code must retain the above copyright
  8. ;;; notice, this list of conditions and the following disclaimer.
  9. ;;; * Redistributions in binary form must reproduce the above
  10. ;;; copyright notice, this list of conditions and the following
  11. ;;; disclaimer in the documentation and/or other materials
  12. ;;; provided with the distribution.
  13. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
  14. ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  15. ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  16. ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
  17. ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  18. ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
  19. ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
  20. ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  21. ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  22. ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  23. ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  24. (in-package #:url-rewrite)
  25. (defvar +session-cookie-name+ "session")
  26. (defun add-session-var (html session-value)
  27. (with-input-from-string (*standard-input* html)
  28. (with-output-to-string (*standard-output*)
  29. (rewrite-urls (lambda (url)
  30. (add-get-param-to-url (or url "/")
  31. +session-cookie-name+
  32. session-value))))))
  33. ;; some simple test cases - there should be more... :)
  34. (defparameter *test-cases*
  35. '(("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">
  36. <HTML>
  37. <BODY BGCOLOR=white>
  38. This is the <A NAME=foo HREF=\"first.html\">first link</A>, and here's the <A HREF=\"mailto:bill@microsoft.com\" TITLE='bar'>second one</A>.
  39. </BODY>
  40. </HTML>"
  41. "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">
  42. <HTML>
  43. <BODY BGCOLOR=white>
  44. This is the <A NAME=foo HREF='first.html?session=foo42'>first link</A>, and here's the <A HREF=\"mailto:bill@microsoft.com\" TITLE='bar'>second one</A>.
  45. </BODY>
  46. </HTML>")
  47. ("Just some plain text")
  48. ;; error in comment declaration
  49. ("<A HREF='/frob'>outer link</A> <!-- comment with embedded <A HREF='/frob'>link</A>-- --another comment-- error <a href=\"/foo/frob/bar.html\">...</a>"
  50. "<A HREF='/frob?session=foo42'>outer link</A> <!-- comment with embedded <A HREF='/frob'>link</A>-- --another comment-- error <a href='/foo/frob/bar.html?session=foo42'>...</a>")
  51. ;; wrong comment declaration
  52. ("<!--------->"
  53. "<!-------->")
  54. ;; correct comment declaration
  55. ("<!-------->"
  56. "<!-------->")
  57. ("<% <a href=foo.html><img title='howdy' src=foo.gif border=0/></a>"
  58. "<% <a href='foo.html?session=foo42'><img title='howdy' src='foo.gif?session=foo42' border=0/></a>")
  59. ("<FORM NAME=Name-of-the-Form ACTION='/'><input type=text name=foo><br><input src=frob.gif value='Press me'></form>"
  60. "<FORM NAME=Name-of-the-Form ACTION='/?session=foo42'><input type=text name=foo><br><input src='frob.gif?session=foo42' value='Press me'></form>")
  61. ("<form name=name-of-the-form><input type=text name=foo><br><input src=frob.gif value='Press me'></form>"
  62. "<form name=name-of-the-form action='/?session=foo42'><input type=text name=foo><br><input src='frob.gif?session=foo42' value='Press me'></form>")))
  63. (defun test ()
  64. (loop for (input output) in *test-cases*
  65. for expected-output = (or output input)
  66. for i from 1
  67. for result = (add-session-var input "foo42")
  68. do (format t "~&Test #~A...~%" i)
  69. (force-output)
  70. unless (string= expected-output
  71. result)
  72. do (format t "~&Test #~A failed - mismatch at position ~A!!~%~a~%~a"
  73. i (mismatch expected-output result :test #'char=)
  74. expected-output result))
  75. (values))