t/re/subst_amp.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     require './test.pl';
   6     set_up_inc('../lib');
   7 }
   8
   9 use strict;
  10
  11 $_ = 'x' x 20;
  12 s/\d*|x/<$&>/g;
  13 my $foo = '<>' . ('<x><>' x 20) ;
  14 is($_, $foo);
  15
  16 my $t = 'aaa';
  17
  18 $_ = $t;
  19 my @res;
  20 pos = 1;
  21 s/\Ga(?{push @res, $_, $`})/xx/g;
  22 is("$_ @res", 'axxxx aaa a aaa aa');
  23
  24 $_ = $t;
  25 @res = ();
  26 pos = 1;
  27 s/\Ga(?{push @res, $_, $`})/x/g;
  28 is("$_ @res", 'axx aaa a aaa aa');
  29
  30 $_ = $t;
  31 @res = ();
  32 pos = 1;
  33 s/\Ga(?{push @res, $_, $`})/xx/;
  34 is("$_ @res", 'axxa aaa a');
  35
  36 $_ = $t;
  37 @res = ();
  38 pos = 1;
  39 s/\Ga(?{push @res, $_, $`})/x/;
  40 is("$_ @res", 'axa aaa a');
  41
  42 $a = $t;
  43 @res = ();
  44 pos ($a) = 1;
  45 $a =~ s/\Ga(?{push @res, $_, $`})/xx/g;
  46 is("$a @res", 'axxxx aaa a aaa aa');
  47
  48 $a = $t;
  49 @res = ();
  50 pos ($a) = 1;
  51 $a =~ s/\Ga(?{push @res, $_, $`})/x/g;
  52 is("$a @res", 'axx aaa a aaa aa');
  53
  54 $a = $t;
  55 @res = ();
  56 pos ($a) = 1;
  57 $a =~ s/\Ga(?{push @res, $_, $`})/xx/;
  58 is("$a @res", 'axxa aaa a');
  59
  60 $a = $t;
  61 @res = ();
  62 pos ($a) = 1;
  63 $a =~ s/\Ga(?{push @res, $_, $`})/x/;
  64 is("$a @res", 'axa aaa a');
  65
  66 sub x2 {'xx'}
  67 sub x1 {'x'}
  68
  69 $a = $t;
  70 @res = ();
  71 pos ($a) = 1;
  72 $a =~ s/\Ga(?{push @res, $_, $`})/x2/ge;
  73 is("$a @res", 'axxxx aaa a aaa aa');
  74
  75 $a = $t;
  76 @res = ();
  77 pos ($a) = 1;
  78 $a =~ s/\Ga(?{push @res, $_, $`})/x1/ge;
  79 is("$a @res", 'axx aaa a aaa aa');
  80
  81 $a = $t;
  82 @res = ();
  83 pos ($a) = 1;
  84 $a =~ s/\Ga(?{push @res, $_, $`})/x2/e;
  85 is("$a @res", 'axxa aaa a');
  86
  87 $a = $t;
  88 @res = ();
  89 pos ($a) = 1;
  90 $a =~ s/\Ga(?{push @res, $_, $`})/x1/e;
  91 is("$a @res", 'axa aaa a');
  92
  93 done_testing();