Commit | Line | Data |
---|---|---|
1222f39e FC |
1 | #!./perl |
2 | ||
3 | # This file is for concatenation tests that require test.pl. | |
4 | # | |
3a069a00 FC |
5 | # t/opbasic/concat.t cannot use test.pl as |
6 | # it needs to avoid using concatenation in | |
1222f39e FC |
7 | # its ok() function. |
8 | ||
9 | BEGIN { | |
10 | chdir 't' if -d 't'; | |
1222f39e | 11 | require './test.pl'; |
624c42e2 | 12 | set_up_inc('../lib'); |
1222f39e FC |
13 | } |
14 | ||
1a98acd9 | 15 | plan 3; |
583a5589 FC |
16 | |
17 | # This test is in the file because overload.pm uses concatenation. | |
18 | { package o; use overload '""' => sub { $_[0][0] } } | |
19 | $x = bless[chr 256],o::; | |
20 | "$x"; | |
21 | $x->[0] = "\xff"; | |
22 | $x.= chr 257; | |
23 | $x.= chr 257; | |
24 | is $x, "\xff\x{101}\x{101}", '.= is not confused by changing utf8ness'; | |
f5a0fd1e | 25 | |
1a98acd9 DM |
26 | # RT #132385 |
27 | # in multiconcat, each const TEMP used for overloading should be distinct | |
28 | ||
29 | package RT132385 { | |
30 | my @a; | |
31 | use overload '.' => sub { push @a, \$_[1]; $_[0] }; | |
32 | my $o = bless []; | |
33 | my $x = $o . "A" . $o . 'B'; | |
34 | ::is "${$a[0]}${$a[2]}", "AB", "RT #132385"; | |
35 | } | |
36 | ||
37 | ||
38 | ||
f5a0fd1e FC |
39 | # Ops should not share the same TARG between recursion levels. This may |
40 | # affect other ops, too, but concat seems more susceptible to this than | |
41 | # others, since it can call itself recursively. (Where else would I put | |
42 | # this test, anyway?) | |
43 | fresh_perl_is <<'end', "tmp\ntmp\n", {}, | |
44 | sub canonpath { | |
45 | my ($path) = @_; | |
46 | my $node = ''; | |
47 | $path =~ s|/\z||; | |
48 | return "$node$path"; | |
49 | } | |
50 | ||
51 | { | |
52 | package Path::Class::Dir; | |
53 | use overload q[""] => sub { ::canonpath("tmp") }; | |
54 | } | |
55 | ||
56 | print canonpath("tmp"), "\n"; | |
57 | print canonpath(bless {},"Path::Class::Dir"), "\n"; | |
58 | end | |
59 | "recursive concat does not share TARGs"; |