summaryrefslogtreecommitdiffstats
path: root/gnu/usr.bin/perl/t/op/concat2.t
blob: a1cc0e6daf49b8ea70d29139f284bc7a7f18a76e (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
#!./perl

# This file is for concatenation tests that require test.pl.
#
# t/opbasic/concat.t cannot use test.pl as
# it needs to avoid using concatenation in
# its ok() function.

BEGIN {
    chdir 't' if -d 't';
    require './test.pl';
    set_up_inc('../lib');
}

plan 4;

# This test is in the file because overload.pm uses concatenation.
{ package o; use overload '""' => sub { $_[0][0] } }
$x = bless[chr 256],o::;
"$x";
$x->[0] = "\xff";
$x.= chr 257;
$x.= chr 257;
is $x, "\xff\x{101}\x{101}", '.= is not confused by changing utf8ness';

# RT #132385
# in multiconcat, each const TEMP used for overloading should be distinct

package RT132385 {
    my @a;
    use overload '.' => sub { push @a, \$_[1]; $_[0] };
    my $o = bless [];
    my $x = $o . "A" . $o . 'B';
    ::is "${$a[0]}${$a[2]}", "AB", "RT #132385";
}



# Ops should not share the same TARG between recursion levels.  This may
# affect other ops, too, but concat seems more susceptible to this than
# others, since it can call itself recursively.  (Where else would I put
# this test, anyway?)
fresh_perl_is <<'end', "tmp\ntmp\n", {},
 sub canonpath {
     my ($path) = @_;
     my $node = '';
     $path =~ s|/\z||;
     return "$node$path";
 }
 
 {
  package Path::Class::Dir;
  use overload q[""] => sub { ::canonpath("tmp") };
 }
 
 print canonpath("tmp"), "\n";
 print canonpath(bless {},"Path::Class::Dir"), "\n";
end
 "recursive concat does not share TARGs";

# don't include the assign as part of the multiconcat if the target
# includes 'local'. This used to screw up on magic vars because the
# 'local $~' was done (thus emptying the var) before multiconcat was
# called.


{
    local $~ = 'FOO';
    my $s;
    {
        local $~ = "$~X";
        $s = $~;
    }
    is($s, 'FOOX', 'local $magic_var = "...."');
}