t/op/concat2.t

   1 #!./perl
   2
   3 # This file is for concatenation tests that require test.pl.
   4 #
   5 # t/opbasic/concat.t cannot use test.pl as
   6 # it needs to avoid using concatenation in
   7 # its ok() function.
   8
   9 BEGIN {
  10     chdir 't' if -d 't';
  11     @INC = '../lib';
  12     require './test.pl';
  13 }
  14
  15 plan 3;
  16
  17 SKIP: {
  18 skip("no encoding pragma in EBCDIC", 1) if $::IS_EBCDIC;
  19 skip_if_miniperl("no dynamic loading on miniperl, no Encode", 1);
  20 fresh_perl_is <<'end', "ok\n", {},
  21     no warnings 'deprecated';
  22     use encoding 'utf8';
  23     map { "a" . $a } ((1)x5000);
  24     print "ok\n";
  25 end
  26  "concat does not lose its stack pointer after utf8 upgrade [perl #78674]";
  27 }
  28
  29 # This test is in the file because overload.pm uses concatenation.
  30 { package o; use overload '""' => sub { $_[0][0] } }
  31 $x = bless[chr 256],o::;
  32 "$x";
  33 $x->[0] = "\xff";
  34 $x.= chr 257;
  35 $x.= chr 257;
  36 is $x, "\xff\x{101}\x{101}", '.= is not confused by changing utf8ness';
  37
  38 # Ops should not share the same TARG between recursion levels.  This may
  39 # affect other ops, too, but concat seems more susceptible to this than
  40 # others, since it can call itself recursively.  (Where else would I put
  41 # this test, anyway?)
  42 fresh_perl_is <<'end', "tmp\ntmp\n", {},
  43  sub canonpath {
  44      my ($path) = @_;
  45      my $node = '';
  46      $path =~ s|/\z||;
  47      return "$node$path";
  48  }
  49
  50  {
  51   package Path::Class::Dir;
  52   use overload q[""] => sub { ::canonpath("tmp") };
  53  }
  54
  55  print canonpath("tmp"), "\n";
  56  print canonpath(bless {},"Path::Class::Dir"), "\n";
  57 end
  58  "recursive concat does not share TARGs";