← Back to branch summary

~ubuntu-branches/ubuntu/maverick/uim/maverick

« back to all changes in this revision

Viewing changes to test/test-db.scm

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2006-11-23 15:10:53 UTC
  • mfrom: (3.1.8 edgy)
  • Revision ID: james.westby@ubuntu.com-20061123151053-q42sk1lvks41xpfx
Tags: 1:1.2.1-9
http://bugs.debian.org/398530
uim-gtk2.0.postinst: Don't call update-gtk-immodules on purge.
(closes: Bug#398530)

Show diffs side-by-side

added added

removed removed

Lines of Context:
test/test-db.scm
 
1
#!/usr/bin/env gosh
 
2
 
 
3
;;; Copyright (c) 2005-2006 uim Project http://uim.freedesktop.org/
 
4
;;;
 
5
;;; All rights reserved.
 
6
;;;
 
7
;;; Redistribution and use in source and binary forms, with or without
 
8
;;; modification, are permitted provided that the following conditions
 
9
;;; are met:
 
10
;;; 1. Redistributions of source code must retain the above copyright
 
11
;;;    notice, this list of conditions and the following disclaimer.
 
12
;;; 2. Redistributions in binary form must reproduce the above copyright
 
13
;;;    notice, this list of conditions and the following disclaimer in the
 
14
;;;    documentation and/or other materials provided with the distribution.
 
15
;;; 3. Neither the name of authors nor the names of its contributors
 
16
;;;    may be used to endorse or promote products derived from this software
 
17
;;;    without specific prior written permission.
 
18
;;;
 
19
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
 
20
;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 
21
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 
22
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
 
23
;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 
24
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 
25
;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 
26
;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 
27
;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 
28
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 
29
;;; SUCH DAMAGE.
 
30
;;;;
 
31
 
 
32
 
 
33
 
 
34
; Tests for uim-db requires debugging information, so we have to let
 
35
; libuim load this file and give it a toplevel procedure.
 
36
 
 
37
(define test-db-find
 
38
  (lambda ()
 
39
    (if (feature? 'debug)
 
40
        (begin
 
41
          (let ((check
 
42
                 (lambda (code)
 
43
                   (eq? (cdr code)
 
44
                        (uim-db-find
 
45
                         (dbg-get-file code)
 
46
                         (+ 1 (dbg-get-line code)))))))
 
47
            (let* ((q quote))
 
48
              (let name ((code (q (place-holder
 
49
                                   (target)))))
 
50
                (uim-db-set-break! (dbg-get-file check)
 
51
                                   (dbg-get-line check))
 
52
                (check code)))))
 
53
        #t)))
 
54
 
 
55
; Certain functions in uim-db.scm are not allowed to call scheme
 
56
; functions in other files.  Otherwise setting a breakpoint to the
 
57
; function being used may cause an infinite recursion.
 
58
(define test-db-dep
 
59
  (lambda ()
 
60
    (letrec ((exclude
 
61
              '(dbg-closures)) ; don't follow these symbols
 
62
             (dependent?
 
63
              (lambda (datum)
 
64
                (case (typeof datum)
 
65
                  ((tc_closure)
 
66
                   (or (if (or (null? (dbg-get-info datum))
 
67
                               (string=? (dbg-get-file datum)
 
68
                                         (dbg-expand-file-name "uim-db.scm")))
 
69
                           #f
 
70
                            ; gosh doesn't recognize "#<CLOSURE arg...>"
 
71
                           (%%closure-code datum))
 
72
                       (dependent? (cddr (%%closure-code datum)))))
 
73
                  ((tc_symbol)
 
74
                   (and (symbol-bound? datum)
 
75
                        (not (memq datum exclude))
 
76
                        (begin
 
77
                          (set! exclude (cons datum exclude))
 
78
                          (dependent? (eval datum)))))
 
79
                  ((tc_cons)
 
80
                   (or (dependent? (car datum))
 
81
                       (dependent? (cdr datum))))
 
82
                  (else #f)))))
 
83
      (if (feature? 'debug)
 
84
          (any dependent?
 
85
               (cdr (srfi-assoc (dbg-expand-file-name "uim-db.scm")
 
86
                                dbg-closures
 
87
                                string=?)))
 
88
          #f))))
 
89
 
 
90
; shadow this part from libuim
 
91
(if (not (symbol-bound? 'feature?))
 
92
    (begin
 
93
      (use test.unit)
 
94
 
 
95
      (require "test/uim-test-utils")
 
96
 
 
97
      (define-uim-test-case "testcase debugger"
 
98
        (setup
 
99
         (lambda ()
 
100
           (uim '(begin (load "test/test-db.scm")
 
101
                        (load "uim-db.scm")))))
 
102
        ("test uim-db-find"
 
103
         (assert-true (uim-bool '(test-db-find))))
 
104
        ("test for external dependency"
 
105
         (assert-false (uim-bool '(test-db-dep)))))))