← Back to branch summary

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

« back to all changes in this revision

Viewing changes to sigscheme/test/bigloo-bool.scm

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2008-06-25 19:56:33 UTC
  • mfrom: (3.1.18 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080625195633-8jljph4rfq00l8o7
Tags: 1:1.5.1-2
http://bugs.debian.org/482659
http://bugs.debian.org/483078
* uim-tcode: provide tutcode-custom.scm, tutcode-bushudic.scm
  and tutcode-rule.scm (Closes: #482659)
* Fix FTBFS: segv during compile (Closes: #483078).
  I personally think this bug is not specific for uim but is a optimization
  problem on gcc-4.3.1. (https://bugs.freedesktop.org/show_bug.cgi?id=16477)

Show diffs side-by-side

added added

removed removed

Lines of Context:
sigscheme/test/bigloo-bool.scm
 
1
;;    A practical implementation for the Scheme programming language   
 
2
;;                                                                     
 
3
;;                                    ,--^,                            
 
4
;;                              _ ___/ /|/                             
 
5
;;                          ,;'( )__, ) '                              
 
6
;;                         ;;  //   L__.                               
 
7
;;                         '   \\   /  '                               
 
8
;;                              ^   ^                                  
 
9
;;                                                                     
 
10
;;               Copyright (c) 1992-2004 Manuel Serrano                
 
11
;;                                                                     
 
12
;;     Bug descriptions, use reports, comments or suggestions are      
 
13
;;     welcome. Send them to                                           
 
14
;;       bigloo@sophia.inria.fr                                        
 
15
;;       http://www.inria.fr/mimosa/fp/Bigloo                                 
 
16
;;                                                                     
 
17
;;   This program is free software; you can redistribute it and/or modify
 
18
;;   it under the terms of the GNU General Public License as published by 
 
19
;;   the Free Software Foundation; either version 2 of the License, or 
 
20
;;   (at your option) any later version. More precisely,
 
21
;;
 
22
;;      - The compiler and the tools are distributed under the terms of the
 
23
;;      GNU General Public License.
 
24
;;
 
25
;;      - The Bigloo run-time system and the libraries are distributed under 
 
26
;;      the terms of the GNU Library General Public License. The source code
 
27
;;      of the Bigloo runtime system is located in the ./runtime directory.
 
28
;;      The source code of the FairThreads library is located in the
 
29
;;      ./fthread directory.
 
30
;;
 
31
;;   This program is distributed in the hope that it will be useful,   
 
32
;;   but WITHOUT ANY WARRANTY; without even the implied warranty of    
 
33
;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     
 
34
;;   GNU General Public License for more details.                      
 
35
;;                                                                     
 
36
;;   You should have received a copy of the GNU General Public         
 
37
;;   License along with this program; if not, write to the Free        
 
38
;;   Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,   
 
39
;;   MA 02111-1307, USA.                                               
 
40
 
 
41
;*---------------------------------------------------------------------*/
 
42
;*    serrano/prgm/project/bigloo/recette/bool.scm                     */
 
43
;*                                                                     */
 
44
;*    Author      :  Manuel Serrano                                    */
 
45
;*    Creation    :  Tue Nov  3 09:16:12 1992                          */
 
46
;*    Last change :  Wed Apr  1 14:05:49 1998 (serrano)                */
 
47
;*                                                                     */
 
48
;*    On test les operations booleenes.                                */
 
49
;*---------------------------------------------------------------------*/
 
50
 
 
51
;; ChangeLog
 
52
;;
 
53
;; 2005-08-18 kzk     Copied from Bigloo 2.6e and adapted to SigScheme
 
54
 
 
55
(load "./test/unittest-bigloo.scm")
 
56
 
 
57
;*---------------------------------------------------------------------*/
 
58
;*    predicat ...                                                     */
 
59
;*---------------------------------------------------------------------*/
 
60
(define (predicat x)
 
61
   (> x 5))
 
62
 
 
63
;*---------------------------------------------------------------------*/
 
64
;*    faux-predicat ...                                                */
 
65
;*---------------------------------------------------------------------*/
 
66
(define (faux-predicat x)
 
67
   (> x 5))
 
68
 
 
69
;*---------------------------------------------------------------------*/
 
70
;*    encore-faux ...                                                  */
 
71
;*---------------------------------------------------------------------*/
 
72
(define (encore-faux x)
 
73
   (> x 5))
 
74
 
 
75
;*---------------------------------------------------------------------*/
 
76
;*    local-pred-1 ...                                                 */
 
77
;*---------------------------------------------------------------------*/
 
78
(define (local-pred-1 x)
 
79
   (let ((pred (lambda (x) (< x 3))))
 
80
      (if (pred x) #t #f)))
 
81
 
 
82
;*---------------------------------------------------------------------*/
 
83
;*    local-pred-2 ...                                                 */
 
84
;*---------------------------------------------------------------------*/
 
85
(define (local-pred-2 x)
 
86
  (let* ((foo (lambda (x) (< x 3)))
 
87
         (bar (lambda (x) (if (foo x) 3 4)))
 
88
         (gee (lambda (x) (if (foo x) 3 4))))
 
89
    bar
 
90
    gee
 
91
    (if (foo x) #t #f)))
 
92
 
 
93
;*---------------------------------------------------------------------*/
 
94
;*    local-pred-3 ...                                                 */
 
95
;*---------------------------------------------------------------------*/
 
96
(define (local-pred-3 x)
 
97
  (let ((pred (lambda (x) (< x 3))))
 
98
    (pred x)))
 
99
 
 
100
;*---------------------------------------------------------------------*/
 
101
;*    test-bool ...                                                    */
 
102
;*---------------------------------------------------------------------*/
 
103
(define (test-bool)
 
104
   (test "or" (or #f #f) #f)
 
105
   (test "not" (not #f) #t)
 
106
   (test "and" (and #t #t) #t)
 
107
   (test "and" (and #t #f) #f)
 
108
   (test "if" (let ((x 1)) (if x x)) 1)
 
109
   (test "ifnot" (let ((x 1)) (if (not x) #t #f)) #f)
 
110
   (test "ifor" (let ((x 1) (y #f)) (if (or x y) x y)) 1)
 
111
   (test "ifand" (let ((x 1) (y #f)) (if (and x y) #t #f)) #f)
 
112
   (test "pred" (if (predicat 6) #t #f) #t)
 
113
   (test "faux" (if (faux-predicat 6) (faux-predicat 7) (faux-predicat 3)) #t)
 
114
   (test "encore-faux" (if (encore-faux 6) #t #f) #t)
 
115
   (test "local-pred-1" (local-pred-1 1) #t)
 
116
   (test "local-pred-2" (local-pred-2 1) #t)
 
117
   (test "local-pred-3" (if (local-pred-3 1) #t #f) #t))
 
118
 
 
119
(test-bool)
 
120
 
 
121
(total-report)