t/op/study.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 watchdog(10);
  10 plan(tests => 43);
  11 use strict;
  12
  13 use Config;
  14 my $have_alarm = $Config{d_alarm};
  15
  16 our $x = "abc\ndef\n";
  17 study($x);
  18
  19 ok($x =~ /^abc/);
  20 ok($x !~ /^def/);
  21
  22 # used to be a test for $*
  23 ok($x =~ /^def/m);
  24
  25 $_ = '123';
  26 study;
  27 ok(/^([0-9][0-9]*)/);
  28
  29 ok(!($x =~ /^xxx/));
  30 ok(!($x !~ /^abc/));
  31
  32 ok($x =~ /def/);
  33 ok(!($x !~ /def/));
  34
  35 study($x);
  36 ok($x !~ /.def/);
  37 ok(!($x =~ /.def/));
  38
  39 ok($x =~ /\ndef/);
  40 ok(!($x !~ /\ndef/));
  41
  42 $_ = 'aaabbbccc';
  43 study;
  44 ok(/(a*b*)(c*)/);
  45 is($1, 'aaabbb');
  46 is($2,'ccc');
  47 ok(/(a+b+c+)/);
  48 is($1, 'aaabbbccc');
  49
  50 ok(!/a+b?c+/);
  51
  52 $_ = 'aaabccc';
  53 study;
  54 ok(/a+b?c+/);
  55 ok(/a*b+c*/);
  56
  57 $_ = 'aaaccc';
  58 study;
  59 ok(/a*b?c*/);
  60 ok(!/a*b+c*/);
  61
  62 $_ = 'abcdef';
  63 study;
  64 ok(/bcd|xyz/);
  65 ok(/xyz|bcd/);
  66
  67 ok(m|bc/*d|);
  68
  69 ok(/^$_$/);
  70
  71 # used to be a test for $*
  72 ok("ab\ncd\n" =~ /^cd/m);
  73
  74 TODO: {
  75     # Even with the alarm() OS/390 and BS2000 can't manage these tests
  76     # (Perl just goes into a busy loop, luckily an interruptable one)
  77     todo_skip('busy loop - compiler bug?', 2)
  78               if $^O eq 'os390' or $^O eq 'posix-bc';
  79
  80     # [ID ] tests 25..26 may loop
  81
  82     $_ = 'FGF';
  83     study;
  84     ok(!/G.F$/, 'bug 20010618.006 (#7126)');
  85     ok(!/[F]F$/, 'bug 20010618.006 (#7126)');
  86 }
  87
  88 {
  89     my $a = 'QaaQaabQaabbQ';
  90     study $a;
  91     my @a = split /aab*/, $a;
  92     is("@a", 'Q Q Q Q', 'split with studied string passed to the regep engine');
  93 }
  94
  95 {
  96     $_ = "AABBAABB";
  97     study;
  98     is(s/AB+/1/ge, 2, 'studied scalar passed to pp_substconst');
  99     is($_, 'A1A1');
 100 }
 101
 102 {
 103     $_ = "AABBAABB";
 104     study;
 105     is(s/(A)B+/1/ge, 2,
 106        'studied scalar passed to pp_substconst with RX_MATCH_COPIED() true');
 107     is($1, 'A');
 108     is($2, undef);
 109     is($_, 'A1A1');
 110 }
 111
 112 {
 113     my @got;
 114     $a = "ydydydyd";
 115     $b = "xdx";
 116     push @got, $_ foreach $a =~ /[^x]d(?{})[^x]d/g;
 117     is("@got", 'ydyd ydyd', '#92696 control');
 118
 119     @got = ();
 120     $a = "ydydydyd";
 121     $b = "xdx";
 122     study $a;
 123     push @got, $_ foreach $a =~ /[^x]d(?{})[^x]d/g;
 124     is("@got", 'ydyd ydyd', '#92696 study $a');
 125
 126     @got = ();
 127     $a = "ydydydyd";
 128     $b = "xdx";
 129     study $b;
 130     push @got, $_ foreach $a =~ /[^x]d(?{})[^x]d/g;
 131     is("@got", 'ydyd ydyd', '#92696 study $b');
 132
 133     @got = ();
 134     $a = "ydydydyd";
 135     $b = "xdx";
 136     push @got, $_ foreach $a =~ /[^x]d(?{study $b})[^x]d/g;
 137     is("@got", 'ydyd ydyd', '#92696 study $b inside (?{}), nothing studied');
 138
 139     @got = ();
 140     $a = "ydydydyd";
 141     $b = "xdx";
 142     my $c = 'zz';
 143     study $c;
 144     push @got, $_ foreach $a =~ /[^x]d(?{study $b})[^x]d/g;
 145     is("@got", 'ydyd ydyd', '#92696 study $b inside (?{}), $c studied');
 146
 147     @got = ();
 148     $a = "ydydydyd";
 149     $b = "xdx";
 150     study $a;
 151     push @got, $_ foreach $a =~ /[^x]d(?{study $b})[^x]d/g;
 152     is("@got", 'ydyd ydyd', '#92696 study $b inside (?{}), $a studied');
 153
 154     @got = ();
 155     $a = "ydydydyd";
 156     $b = "xdx";
 157     study $a;
 158     push @got, $_ foreach $a =~ /[^x]d(?{$a .= ''})[^x]d/g;
 159     is("@got", 'ydyd ydyd', '#92696 $a .= \'\' inside (?{}), $a studied');
 160 }