This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Document tricks, work-arounds for user-defined casing
[perl5.git] / t / op / qq.t
CommitLineData
a4c04bdc
NC
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
f9d13529 8print q(1..23
a4c04bdc
NC
9);
10
11# This is() function is written to avoid ""
12my $test = 1;
13sub is {
14 my($left, $right) = @_;
15
16 if ($left eq $right) {
17 printf 'ok %d
18', $test++;
19 return 1;
20 }
21 foreach ($left, $right) {
22 # Comment out these regexps to map non-printables to ord if the perl under
23 # test is so broken that it's not helping
24 s/([^-+A-Za-z_0-9])/sprintf q{'.chr(%d).'}, ord $1/ge;
25 $_ = sprintf q('%s'), $_;
26 s/^''\.//;
27 s/\.''$//;
28 }
29 printf q(not ok %d - got %s expected %s
30), $test++, $left, $right;
31
32 printf q(# Failed test at line %d
33), (caller)[2];
34
35 return 0;
36}
37
38is ("\x53", chr 83);
39is ("\x4EE", chr (78) . 'E');
40is ("\x4i", chr (4) . 'i'); # This will warn
41is ("\xh", chr (0) . 'h'); # This will warn
42is ("\xx", chr (0) . 'x'); # This will warn
43is ("\xx9", chr (0) . 'x9'); # This will warn. \x9 is tab in EBCDIC too?
44is ("\x9_E", chr (9) . '_E'); # This will warn
45
46is ("\x{4E}", chr 78);
47is ("\x{6_9}", chr 105);
48is ("\x{_6_3}", chr 99);
49is ("\x{_6B}", chr 107);
50
51is ("\x{9__0}", chr 9); # multiple underscores not allowed.
52is ("\x{77_}", chr 119); # trailing underscore warns.
53is ("\x{6FQ}z", chr (111) . 'z');
54
55is ("\x{0x4E}", chr 0);
56is ("\x{x4E}", chr 0);
57
58is ("\x{0065}", chr 101);
59is ("\x{000000000000000000000000000000000000000000000000000000000000000072}",
60 chr 114);
61is ("\x{0_06_5}", chr 101);
62is ("\x{1234}", chr 4660);
b851fbc1 63is ("\x{10FFFD}", chr 1114109);
f9d13529
KW
64
65# These kludged tests should change when we remove the temporary fatal error
66# in util.c for "\c{"
67# BE SURE TO remove the message from the __DATA__ section of porting/diag.t,
68# and to verify the messages in util.c are adequately covered in perldiag.pod
69my $value = eval '"\c{ACK}"';
70if ($^V lt v5.13.0 || $^V ge v5.14.0) {
71 is ($@, "");
72 is ($value, ";ACK}");
73}
74elsif ($@ ne "") { # 5.13 series, should fail
75 is ("1", "1"); # This .t only has 'is' at its disposal
76 is ("1", "1");
77}
78else { # Something wrong; someone has removed the failure in util.c
79 is ("Should fail for 5.13 until fix test", "0");
80 is ("1", "1");
81}