Commit | Line | Data |
8d063cd8 |
1 | #!./perl |
2 | |
79072805 |
3 | # $RCSfile: append.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:36 $ |
8d063cd8 |
4 | |
da450f52 |
5 | print "1..13\n"; |
8d063cd8 |
6 | |
7 | $a = 'ab' . 'c'; # compile time |
8 | $b = 'def'; |
9 | |
10 | $c = $a . $b; |
11 | print "#1\t:$c: eq :abcdef:\n"; |
12 | if ($c eq 'abcdef') {print "ok 1\n";} else {print "not ok 1\n";} |
13 | |
14 | $c .= 'xyz'; |
15 | print "#2\t:$c: eq :abcdefxyz:\n"; |
16 | if ($c eq 'abcdefxyz') {print "ok 2\n";} else {print "not ok 2\n";} |
17 | |
18 | $_ = $a; |
19 | $_ .= $b; |
20 | print "#3\t:$_: eq :abcdef:\n"; |
21 | if ($_ eq 'abcdef') {print "ok 3\n";} else {print "not ok 3\n";} |
15bb2692 |
22 | |
23 | # test that when right argument of concat is UTF8, and is the same |
24 | # variable as the target, and the left argument is not UTF8, it no |
25 | # longer frees the wrong string. |
26 | { |
27 | sub r2 { |
28 | my $string = ''; |
29 | $string .= pack("U0a*", 'mnopqrstuvwx'); |
30 | $string = "abcdefghijkl$string"; |
31 | } |
32 | |
33 | r2() and print "ok $_\n" for qw/ 4 5 /; |
34 | } |
35 | |
36 | # test that nul bytes get copied |
37 | { |
2fa10d08 |
38 | # Character 'b' occurs at codepoint 130 decimal or \202 octal |
39 | # under an EBCDIC coded character set. |
40 | # my($a, $ab) = ("a", "a\000b"); |
41 | my($a, $ab) = ("\141", "\141\000\142"); |
15bb2692 |
42 | my($u, $ub) = map pack("U0a*", $_), $a, $ab; |
43 | my $t1 = $a; $t1 .= $ab; |
2fa10d08 |
44 | print $t1 =~ /\142/ ? "ok 6\n" : "not ok 6\t# $t1\n"; |
15bb2692 |
45 | my $t2 = $a; $t2 .= $ub; |
1a2d3859 |
46 | if (ord('A') == 193) { |
47 | # print $t2 eq "\141\141\000" ? "ok 7\n" : "not ok 7\t# $t2\n"; |
48 | print $t2 =~ /\141/ ? "ok 7\n" : "not ok 7\t# $t2\n"; |
49 | } |
50 | else { |
51 | print $t2 =~ /\142/ ? "ok 7\n" : "not ok 7\t# $t2\n"; |
52 | } |
15bb2692 |
53 | my $t3 = $u; $t3 .= $ab; |
2fa10d08 |
54 | print $t3 =~ /\142/ ? "ok 8\n" : "not ok 8\t# $t3\n"; |
15bb2692 |
55 | my $t4 = $u; $t4 .= $ub; |
1a2d3859 |
56 | if (ord('A') == 193) { |
57 | print $t4 =~ /\141/ ? "ok 9\n" : "not ok 9\t# $t4\n"; |
58 | } |
59 | else { |
60 | print $t4 =~ /\142/ ? "ok 9\n" : "not ok 9\t# $t4\n"; |
61 | } |
15bb2692 |
62 | my $t5 = $a; $t5 = $ab . $t5; |
2fa10d08 |
63 | print $t5 =~ /\142/ ? "ok 10\n" : "not ok 10\t# $t5\n"; |
15bb2692 |
64 | my $t6 = $a; $t6 = $ub . $t6; |
1a2d3859 |
65 | if (ord('A') == 193) { |
66 | print $t6 =~ /\141/ ? "ok 11\n" : "not ok 11\t# $t6\n"; |
67 | } |
68 | else { |
69 | print $t6 =~ /\142/ ? "ok 11\n" : "not ok 11\t# $t6\n"; |
70 | } |
15bb2692 |
71 | my $t7 = $u; $t7 = $ab . $t7; |
2fa10d08 |
72 | print $t7 =~ /\142/ ? "ok 12\n" : "not ok 12\t# $t7\n"; |
15bb2692 |
73 | my $t8 = $u; $t8 = $ub . $t8; |
1a2d3859 |
74 | if (ord('A') == 193) { |
75 | print $t8 =~ /\141/ ? "ok 13\n" : "not ok 13\t# $t8\n"; |
76 | } |
77 | else { |
78 | print $t8 =~ /\142/ ? "ok 13\n" : "not ok 13\t# $t8\n"; |
79 | } |
15bb2692 |
80 | } |