t/op/study.t

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