source: trunk/source/tests/ansi-tests/random-type-prop-tests-07.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 4.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Mar 13 17:03:52 2005
4;;;; Contains: Random type prop tests, part 7 (strings)
5
6(in-package :cl-test)
7
8(def-type-prop-test simple-string-p 'simple-string-p '(t) 1)
9(def-type-prop-test char 'char (list 'string (index-type-for-dim 0)) 2)
10(def-type-prop-test schar 'schar (list 'simple-string (index-type-for-dim 0)) 2)
11
12(def-type-prop-test string 'string '((or string symbol character)) 1)
13(def-type-prop-test string-upcase 'string-upcase '(string) 1)
14(def-type-prop-test string-downcase 'string-downcase '(string) 1)
15(def-type-prop-test string-capitalize 'string-capitalize '(string) 1)
16
17(def-type-prop-test string-trim.1 'string-trim '(string string) 2)
18(def-type-prop-test string-trim.2 'string-trim (list #'(lambda () (make-list-type (random 10) 'null 'character))
19                                                     'string)
20  2)
21(def-type-prop-test string-left-trim.1 'string-left-trim '(string string) 2)
22(def-type-prop-test string-left-trim.2 'string-left-trim (list #'(lambda () (make-list-type (random 10) 'null 'character))
23                                                               'string)
24  2)
25(def-type-prop-test string-right-trim.1 'string-right-trim '(string string) 2)
26(def-type-prop-test string-right-trim.2 'string-right-trim
27  (list #'(lambda () (make-list-type (random 10) 'null 'character)) 'string)
28  2)
29
30(defmacro def-string-comparison-type-prop-test (op)
31  (flet ((%makename (n) (intern (format nil "~A.~A" op n) :cl-test)))
32    `(progn
33       (def-type-prop-test ,(%makename 1) ',op '(string string) 2)
34       (def-type-prop-test ,(%makename 2) ',op
35         `(string string (eql :start1) ,#'index-type-for-v1)
36         4)
37       (def-type-prop-test ,(%makename 3) ',op
38         `(string string (eql :start2) ,#'index-type-for-v2)
39         4)
40       (def-type-prop-test ,(%makename 4) ',op
41         `(string string (eql :end1) ,#'end-type-for-v1)
42         4)
43       (def-type-prop-test ,(%makename 5) ',op
44         `(string string (eql :end2) ,#'end-type-for-v2)
45         4)
46       (def-type-prop-test ,(%makename 6) ',op
47         `(string string
48                  (eql :start1) ,#'index-type-for-v1
49                  (eql :end1) ,#'end-type-for-v1)
50         6)
51       (def-type-prop-test ,(%makename 7) ',op
52         `(string string
53                  (eql :start1) ,#'index-type-for-v1
54                  (eql :end2) ,#'end-type-for-v2)
55         6)
56       (def-type-prop-test ,(%makename 8) ',op
57         `(string string
58                  (eql :start2) ,#'index-type-for-v2
59                  (eql :end1) ,#'end-type-for-v1)
60         6)
61       (def-type-prop-test ,(%makename 9) ',op
62         `(string string
63                  (eql :start2) ,#'index-type-for-v2
64                  (eql :end2) ,#'end-type-for-v2)
65         6)
66       (def-type-prop-test ,(%makename 10) ',op
67         `(string string
68                  (eql :start1) ,#'index-type-for-v1
69                  (eql :start2) ,#'index-type-for-v2
70                  (eql :end1) ,#'end-type-for-v1)
71         8)
72       (def-type-prop-test ,(%makename 11) ',op
73         `(string string
74                  (eql :start1) ,#'index-type-for-v1
75                  (eql :start2) ,#'index-type-for-v2
76                  (eql :end2) ,#'end-type-for-v2)
77         8)
78       (def-type-prop-test ,(%makename 12) ',op
79         `(string string
80                  (eql :start1) ,#'index-type-for-v1
81                  (eql :end2) ,#'end-type-for-v2
82                  (eql :end1) ,#'end-type-for-v1)
83         8)
84       (def-type-prop-test ,(%makename 13) ',op
85         `(string string
86                  (eql :start2) ,#'index-type-for-v2
87                  (eql :end2) ,#'end-type-for-v2
88                  (eql :end1) ,#'end-type-for-v1)
89         8)
90       (def-type-prop-test ,(%makename 14) ',op
91         `(string string
92                  (eql :start1) ,#'index-type-for-v1
93                  (eql :start2) ,#'index-type-for-v2
94                  (eql :end2) ,#'end-type-for-v2
95                  (eql :end1) ,#'end-type-for-v1)
96         10)
97       )))
98     
99(def-string-comparison-type-prop-test string=)
100(def-string-comparison-type-prop-test string/=)
101(def-string-comparison-type-prop-test string<)
102(def-string-comparison-type-prop-test string<=)
103(def-string-comparison-type-prop-test string>)
104(def-string-comparison-type-prop-test string>=)
105
106(def-string-comparison-type-prop-test string-equal)
107(def-string-comparison-type-prop-test string-not-equal)
108(def-string-comparison-type-prop-test string-lessp)
109(def-string-comparison-type-prop-test string-greaterp)
110(def-string-comparison-type-prop-test string-not-lessp)
111(def-string-comparison-type-prop-test string-not-greaterp)
112
113(def-type-prop-test stringp 'stringp '(t) 1)
114
115(def-type-prop-test make-string.1 'make-string '((integer 0 100) (eql :initial-element) character) 3)
116(def-type-prop-test make-string.2 'make-string `((integer 0 100) (eql :initial-element) character
117                                                 (eql :element-type)
118                                                 ,#'(lambda (&rest args)
119                                                      `(eql (and character
120                                                                 ,(make-random-type-containing (third args))))))
121  5)
Note: See TracBrowser for help on using the repository browser.