source: trunk/third/perl/t/op/join.t @ 20075

Revision 20075, 2.6 KB checked in by zacheiss, 21 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r20074, which included commits to RCS files with non-trunk default branches.
  • Property svn:executable set to *
Line 
1#!./perl
2
3print "1..18\n";
4
5@x = (1, 2, 3);
6if (join(':',@x) eq '1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
7
8if (join('',1,2,3) eq '123') {print "ok 2\n";} else {print "not ok 2\n";}
9
10if (join(':',split(/ /,"1 2 3")) eq '1:2:3') {print "ok 3\n";} else {print "not ok 3\n";}
11
12my $f = 'a';
13$f = join ',', 'b', $f, 'e';
14if ($f eq 'b,a,e') {print "ok 4\n";} else {print "# '$f'\nnot ok 4\n";}
15
16$f = 'a';
17$f = join ',', $f, 'b', 'e';
18if ($f eq 'a,b,e') {print "ok 5\n";} else {print "not ok 5\n";}
19
20$f = 'a';
21$f = join $f, 'b', 'e', 'k';
22if ($f eq 'baeak') {print "ok 6\n";} else {print "# '$f'\nnot ok 6\n";}
23
24# 7,8 check for multiple read of tied objects
25{ package X;
26  sub TIESCALAR { my $x = 7; bless \$x };
27  sub FETCH { my $y = shift; $$y += 5 };
28  tie my $t, 'X';
29  my $r = join ':', $t, 99, $t, 99;
30  print "# expected '12:99:17:99' got '$r'\nnot " if $r ne '12:99:17:99';
31  print "ok 7\n";
32  $r = join '', $t, 99, $t, 99;
33  print "# expected '22992799' got '$r'\nnot " if $r ne '22992799';
34  print "ok 8\n";
35};
36
37# 9,10 and for multiple read of undef
38{ my $s = 5;
39  local ($^W, $SIG{__WARN__}) = ( 1, sub { $s+=4 } );
40  my $r = join ':', 'a', undef, $s, 'b', undef, $s, 'c';
41  print "# expected 'a::9:b::13:c' got '$r'\nnot " if $r ne 'a::9:b::13:c';
42  print "ok 9\n";
43  my $r = join '', 'a', undef, $s, 'b', undef, $s, 'c';
44  print "# expected 'a17b21c' got '$r'\nnot " if $r ne 'a17b21c';
45  print "ok 10\n";
46};
47
48{ my $s = join("", chr(0x1234), chr(0xff));
49  print "not " unless length($s) == 2 && $s eq "\x{1234}\x{ff}";
50  print "ok 11\n";
51}
52
53{ my $s = join(chr(0xff), chr(0x1234), "");
54  print "not " unless length($s) == 2 && $s eq "\x{1234}\x{ff}";
55  print "ok 12\n";
56}
57
58{ my $s = join(chr(0x1234), chr(0xff), chr(0x2345));
59  print "not " unless length($s) == 3 && $s eq "\x{ff}\x{1234}\x{2345}";
60  print "ok 13\n";
61}
62
63{ my $s = join(chr(0xff), chr(0x1234), chr(0xfe));
64  print "not " unless length($s) == 3 && $s eq "\x{1234}\x{ff}\x{fe}";
65  print "ok 14\n";
66}
67
68{ # [perl #24846] $jb2 should be in bytes, not in utf8.
69  my $b = "abc\304";
70  my $u = "abc\x{0100}";
71
72  sub join_into_my_variable {
73    my $r = join("", @_);
74    return $r;
75  }
76
77  my $jb1 = join_into_my_variable("", $b);
78  my $ju1 = join_into_my_variable("", $u);
79  my $jb2 = join_into_my_variable("", $b);
80  my $ju2 = join_into_my_variable("", $u);
81
82  print "not " unless unpack('H*', $jb1) eq unpack('H*', $b);
83  print "ok 15\n";
84
85  print "not " unless unpack('H*', $ju1) eq unpack('H*', $u);
86  print "ok 16\n";
87
88  print "not " unless unpack('H*', $jb2) eq unpack('H*', $b);
89  print "ok 17\n";
90
91  print "not " unless unpack('H*', $ju2) eq unpack('H*', $u);
92  print "ok 18\n";
93}
Note: See TracBrowser for help on using the repository browser.