hyperdoc-test.lisp

   1 ;; Copyright (c) 2003 Nikodemus Siivola
   2
   3 ;; Permission is hereby granted, free of charge, to any person obtaining
   4 ;; a copy of this software and associated documentation files (the
   5 ;; "Software"), to deal in the Software without restriction, including
   6 ;; without limitation the rights to use, copy, modify, merge, publish,
   7 ;; distribute, sublicense, and/or sell copies of the Software, and to
   8 ;; permit persons to whom the Software is furnished to do so, subject to
   9 ;; the following conditions:
  10
  11 ;; The above copyright notice and this permission notice shall be
  12 ;; included in all copies or substantial portions of the Software.
  13
  14 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  15 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  16 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  17 ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
  18 ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
  19 ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
  20 ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  21
  22 (defpackage :hyperdoc-test
  23   (:use :cl :rt :hyperdoc))
  24
  25 ;;;; TEST PACKAGE
  26
  27 (defpackage :foo
  28   (:use :cl)
  29   (:shadow #:cons
  30            #:car)
  31   (:export  #:cons
  32             #:car
  33             #:ensure-class))
  34
  35 (in-package :foo)
  36
  37 (defvar *hyperdoc-base-uri* "http://www.example.com/foo/")
  38
  39 (defun hyperdoc-lookup (symbol type)
  40   (declare (ignore type))
  41   (case symbol
  42     (cons "cons.html")
  43     (ensure-class "ensure-class.html")))
  44
  45 ;;;; OTHER TEST PACKAGE
  46
  47 (defpackage :bar
  48   (:use :cl)
  49   (:export #:foo))
  50
  51 (in-package :bar)
  52
  53 (defvar *hyperdoc-base-uri* "file://bar/")
  54
  55 (defun hyperdoc-lookup (symbol doc-type)
  56   (when (member doc-type '(variable function))
  57     (concatenate 'string (string-downcase (symbol-name doc-type))
  58                  "/" (string-downcase (symbol-name symbol)))))
  59
  60
  61 ;;;; ACTUAL TESTS
  62
  63 (in-package :hyperdoc-test)
  64
  65 (deftest cl.1
  66     (lookup 'cons)
  67   "http://www.lispworks.com/reference/HyperSpec/Body/a_cons.htm")
  68
  69 (deftest cl.2
  70     (lookup 'foo:cons)
  71   "http://www.example.com/foo/cons.html")
  72
  73 (deftest cl.3
  74     (prog2
  75         (setf (base-uri 'foo) "http://newbase.com/")
  76         (lookup 'foo:cons)
  77       (setf (base-uri 'foo) "http://www.example.com/foo/"))
  78   "http://newbase.com/cons.html")
  79
  80 (deftest cl.4
  81     (lookup 'foo:car)
  82   nil)
  83
  84 (deftest cl.5
  85     (lookup 'car)
  86   "http://www.lispworks.com/reference/HyperSpec/Body/f_car_c.htm")
  87
  88 (deftest mop.1
  89     (lookup 'ensure-class)
  90   "http://www.alu.org/mop/dictionary.html#ensure-class")
  91
  92 (deftest mop.2
  93     (lookup 'foo:ensure-class)
  94   "http://www.example.com/foo/ensure-class.html")
  95
  96 (deftest all-types.1
  97     (lookup 'bar:foo)
  98   (("file://bar/variable/foo" . "VARIABLE")
  99    ("file://bar/function/foo" . "FUNCTION")))