1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
#!/usr/bin/perl
### $Header: /usr/local/cvsrep/cl-interpol/test/create_perl_tests.pl,v 1.2 2008/07/23 14:30:45 edi Exp $
### Copyright (c) 2003-2008, Dr. Edmund Weitz. All rights reserved.
### Redistribution and use in source and binary forms, with or without
### modification, are permitted provided that the following conditions
### are met:
### * Redistributions of source code must retain the above copyright
### notice, this list of conditions and the following disclaimer.
### * Redistributions in binary form must reproduce the above
### copyright notice, this list of conditions and the following
### disclaimer in the documentation and/or other materials
### provided with the distribution.
### THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
### OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
### WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
### ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
### DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
### DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
### GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
### INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
### NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
### SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
my @chars = qw(\Q \L \U \E \l \u);
sub combine {
my $delim = shift;
my @result = ();
foreach my $char (@chars) {
foreach my $string (@_) {
push @result, "$char$delim$string";
}
}
@result;
}
sub quote {
local $_ = shift;
s/\\/\\\\/g;
$_;
}
print <<'HEAD';
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-UNICODE-TEST; Base: 10 -*-
;;; $Header: /usr/local/cvsrep/cl-interpol/test/create_perl_tests.pl,v 1.2 2008/07/23 14:30:45 edi Exp $
;;; some simple tests for CL-INTERPOL which were generated by a Perl script
HEAD
foreach my $a (('Aa-', 'aA-')) {
my $counter = 0;
my @arr = @chars;
while ($counter++ < 4) {
foreach my $str (@arr) {
print "(let ((a \"$a\"))\n";
my $test = "\${a}$str\${a}";
print " (string= #?\"$test\" \"" . (quote eval "\"$test\"") . "\"))\n";
}
@arr = combine '${a}', @arr;
}
}
print "\n";
|
