This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
65e3e82724f3c3093a913527bfd85eb6b8cf4bb6
[perl5.git] / t / op / qq.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6 }
7
8 print q(1..30
9 );
10
11 # This is() function is written to avoid ""
12 my $test = 1;
13 sub 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
38 is ("\x53", chr 83);
39 is ("\x4EE", chr (78) . 'E');
40 is ("\x4i", chr (4) . 'i');     # This will warn
41 is ("\xh", chr (0) . 'h');      # This will warn
42 is ("\xx", chr (0) . 'x');      # This will warn
43 is ("\xx9", chr (0) . 'x9');    # This will warn. \x9 is tab in EBCDIC too?
44 is ("\x9_E", chr (9) . '_E');   # This will warn
45
46 is ("\x{4E}", chr 78);
47 is ("\x{6_9}", chr 105);
48 is ("\x{_6_3}", chr 99);
49 is ("\x{_6B}", chr 107);
50
51 is ("\x{9__0}", chr 9);         # multiple underscores not allowed.
52 is ("\x{77_}", chr 119);        # trailing underscore warns.
53 is ("\x{6FQ}z", chr (111) . 'z');
54
55 is ("\x{0x4E}", chr 0);
56 is ("\x{x4E}", chr 0);
57
58 is ("\x{0065}", chr 101);
59 is ("\x{000000000000000000000000000000000000000000000000000000000000000072}",
60     chr 114);
61 is ("\x{0_06_5}", chr 101);
62 is ("\x{1234}", chr 4660);
63 is ("\x{10FFFD}", chr 1114109);
64 is ("\400", chr 0x100);
65 is ("\600", chr 0x180);
66 is ("\777", chr 0x1FF);
67 is ("a\o{120}b", "a" . chr(0x50) . "b");
68 is ("a\o{400}b", "a" . chr(0x100) . "b");
69 is ("a\o{1000}b", "a" . chr(0x200) . "b");
70
71 # These kludged tests should change when we remove the temporary fatal error
72 # in util.c for "\c{".  And, the warning there should probably not be
73 # deprecated; See [perl #75138].
74 # BE SURE TO remove the message from the __DATA__ section of porting/diag.t,
75 # and to verify the messages in util.c are adequately covered in
76 # perldiag.pod, and to revise the explanatory wording that is there now.
77 my $value = eval '"\c{ACK}"';
78 if ($^V lt v5.13.0 || $^V ge v5.14.0) {
79     is ($@, "");
80     is ($value, ";ACK}");
81 }
82 elsif ($@ ne "") {  # 5.13 series, expect the eval to fail, so pass it.
83     is ("1", "1");  # This .t only has 'is' at its disposal
84     is ("1", "1");
85 }
86 else {  # Something wrong; someone has removed the failure in util.c
87     is ("Should fail for 5.13 until fix test", "0");
88     is ("1", "1");
89 }
90
91 # This caused a memory fault
92 no warnings "utf8";
93 is ("abc", eval qq[qq\x{8000_0000}abc\x{8000_0000}])