| 1 | #!./perl -w
|
|---|
| 2 |
|
|---|
| 3 | #P = start of string Q = start of substr R = end of substr S = end of string
|
|---|
| 4 |
|
|---|
| 5 | BEGIN {
|
|---|
| 6 | chdir 't' if -d 't';
|
|---|
| 7 | @INC = '../lib';
|
|---|
| 8 | }
|
|---|
| 9 | use warnings ;
|
|---|
| 10 |
|
|---|
| 11 | $a = 'abcdefxyz';
|
|---|
| 12 | $SIG{__WARN__} = sub {
|
|---|
| 13 | if ($_[0] =~ /^substr outside of string/) {
|
|---|
| 14 | $w++;
|
|---|
| 15 | } elsif ($_[0] =~ /^Attempt to use reference as lvalue in substr/) {
|
|---|
| 16 | $w += 2;
|
|---|
| 17 | } elsif ($_[0] =~ /^Use of uninitialized value/) {
|
|---|
| 18 | $w += 3;
|
|---|
| 19 | } else {
|
|---|
| 20 | warn $_[0];
|
|---|
| 21 | }
|
|---|
| 22 | };
|
|---|
| 23 |
|
|---|
| 24 | require './test.pl';
|
|---|
| 25 |
|
|---|
| 26 | plan(325);
|
|---|
| 27 |
|
|---|
| 28 | $FATAL_MSG = qr/^substr outside of string/;
|
|---|
| 29 |
|
|---|
| 30 | is(substr($a,0,3), 'abc'); # P=Q R S
|
|---|
| 31 | is(substr($a,3,3), 'def'); # P Q R S
|
|---|
| 32 | is(substr($a,6,999), 'xyz'); # P Q S R
|
|---|
| 33 | $b = substr($a,999,999) ; # warn # P R Q S
|
|---|
| 34 | is ($w--, 1);
|
|---|
| 35 | eval{substr($a,999,999) = "" ; };# P R Q S
|
|---|
| 36 | like ($@, $FATAL_MSG);
|
|---|
| 37 | is(substr($a,0,-6), 'abc'); # P=Q R S
|
|---|
| 38 | is(substr($a,-3,1), 'x'); # P Q R S
|
|---|
| 39 |
|
|---|
| 40 | $[ = 1;
|
|---|
| 41 |
|
|---|
| 42 | is(substr($a,1,3), 'abc' ); # P=Q R S
|
|---|
| 43 | is(substr($a,4,3), 'def' ); # P Q R S
|
|---|
| 44 | is(substr($a,7,999), 'xyz');# P Q S R
|
|---|
| 45 | $b = substr($a,999,999) ; # warn # P R Q S
|
|---|
| 46 | is($w--, 1);
|
|---|
| 47 | eval{substr($a,999,999) = "" ; } ; # P R Q S
|
|---|
| 48 | like ($@, $FATAL_MSG);
|
|---|
| 49 | is(substr($a,1,-6), 'abc' );# P=Q R S
|
|---|
| 50 | is(substr($a,-3,1), 'x' ); # P Q R S
|
|---|
| 51 |
|
|---|
| 52 | $[ = 0;
|
|---|
| 53 |
|
|---|
| 54 | substr($a,3,3) = 'XYZ';
|
|---|
| 55 | is($a, 'abcXYZxyz' );
|
|---|
| 56 | substr($a,0,2) = '';
|
|---|
| 57 | is($a, 'cXYZxyz' );
|
|---|
| 58 | substr($a,0,0) = 'ab';
|
|---|
| 59 | is($a, 'abcXYZxyz' );
|
|---|
| 60 | substr($a,0,0) = '12345678';
|
|---|
| 61 | is($a, '12345678abcXYZxyz' );
|
|---|
| 62 | substr($a,-3,3) = 'def';
|
|---|
| 63 | is($a, '12345678abcXYZdef');
|
|---|
| 64 | substr($a,-3,3) = '<';
|
|---|
| 65 | is($a, '12345678abcXYZ<' );
|
|---|
| 66 | substr($a,-1,1) = '12345678';
|
|---|
| 67 | is($a, '12345678abcXYZ12345678' );
|
|---|
| 68 |
|
|---|
| 69 | $a = 'abcdefxyz';
|
|---|
| 70 |
|
|---|
| 71 | is(substr($a,6), 'xyz' ); # P Q R=S
|
|---|
| 72 | is(substr($a,-3), 'xyz' ); # P Q R=S
|
|---|
| 73 | $b = substr($a,999,999) ; # warning # P R=S Q
|
|---|
| 74 | is($w--, 1);
|
|---|
| 75 | eval{substr($a,999,999) = "" ; } ; # P R=S Q
|
|---|
| 76 | like($@, $FATAL_MSG);
|
|---|
| 77 | is(substr($a,0), 'abcdefxyz'); # P=Q R=S
|
|---|
| 78 | is(substr($a,9), ''); # P Q=R=S
|
|---|
| 79 | is(substr($a,-11), 'abcdefxyz'); # Q P R=S
|
|---|
| 80 | is(substr($a,-9), 'abcdefxyz'); # P=Q R=S
|
|---|
| 81 |
|
|---|
| 82 | $a = '54321';
|
|---|
| 83 |
|
|---|
| 84 | $b = substr($a,-7, 1) ; # warn # Q R P S
|
|---|
| 85 | is($w--, 1);
|
|---|
| 86 | eval{substr($a,-7, 1) = "" ; }; # Q R P S
|
|---|
| 87 | like($@, $FATAL_MSG);
|
|---|
| 88 | $b = substr($a,-7,-6) ; # warn # Q R P S
|
|---|
| 89 | is($w--, 1);
|
|---|
| 90 | eval{substr($a,-7,-6) = "" ; }; # Q R P S
|
|---|
| 91 | like($@, $FATAL_MSG);
|
|---|
| 92 | is(substr($a,-5,-7), ''); # R P=Q S
|
|---|
| 93 | is(substr($a, 2,-7), ''); # R P Q S
|
|---|
| 94 | is(substr($a,-3,-7), ''); # R P Q S
|
|---|
| 95 | is(substr($a, 2,-5), ''); # P=R Q S
|
|---|
| 96 | is(substr($a,-3,-5), ''); # P=R Q S
|
|---|
| 97 | is(substr($a, 2,-4), ''); # P R Q S
|
|---|
| 98 | is(substr($a,-3,-4), ''); # P R Q S
|
|---|
| 99 | is(substr($a, 5,-6), ''); # R P Q=S
|
|---|
| 100 | is(substr($a, 5,-5), ''); # P=R Q S
|
|---|
| 101 | is(substr($a, 5,-3), ''); # P R Q=S
|
|---|
| 102 | $b = substr($a, 7,-7) ; # warn # R P S Q
|
|---|
| 103 | is($w--, 1);
|
|---|
| 104 | eval{substr($a, 7,-7) = "" ; }; # R P S Q
|
|---|
| 105 | like($@, $FATAL_MSG);
|
|---|
| 106 | $b = substr($a, 7,-5) ; # warn # P=R S Q
|
|---|
| 107 | is($w--, 1);
|
|---|
| 108 | eval{substr($a, 7,-5) = "" ; }; # P=R S Q
|
|---|
| 109 | like($@, $FATAL_MSG);
|
|---|
| 110 | $b = substr($a, 7,-3) ; # warn # P Q S Q
|
|---|
| 111 | is($w--, 1);
|
|---|
| 112 | eval{substr($a, 7,-3) = "" ; }; # P Q S Q
|
|---|
| 113 | like($@, $FATAL_MSG);
|
|---|
| 114 | $b = substr($a, 7, 0) ; # warn # P S Q=R
|
|---|
| 115 | is($w--, 1);
|
|---|
| 116 | eval{substr($a, 7, 0) = "" ; }; # P S Q=R
|
|---|
| 117 | like($@, $FATAL_MSG);
|
|---|
| 118 |
|
|---|
| 119 | is(substr($a,-7,2), ''); # Q P=R S
|
|---|
| 120 | is(substr($a,-7,4), '54'); # Q P R S
|
|---|
| 121 | is(substr($a,-7,7), '54321');# Q P R=S
|
|---|
| 122 | is(substr($a,-7,9), '54321');# Q P S R
|
|---|
| 123 | is(substr($a,-5,0), ''); # P=Q=R S
|
|---|
| 124 | is(substr($a,-5,3), '543');# P=Q R S
|
|---|
| 125 | is(substr($a,-5,5), '54321');# P=Q R=S
|
|---|
| 126 | is(substr($a,-5,7), '54321');# P=Q S R
|
|---|
| 127 | is(substr($a,-3,0), ''); # P Q=R S
|
|---|
| 128 | is(substr($a,-3,3), '321');# P Q R=S
|
|---|
| 129 | is(substr($a,-2,3), '21'); # P Q S R
|
|---|
| 130 | is(substr($a,0,-5), ''); # P=Q=R S
|
|---|
| 131 | is(substr($a,2,-3), ''); # P Q=R S
|
|---|
| 132 | is(substr($a,0,0), ''); # P=Q=R S
|
|---|
| 133 | is(substr($a,0,5), '54321');# P=Q R=S
|
|---|
| 134 | is(substr($a,0,7), '54321');# P=Q S R
|
|---|
| 135 | is(substr($a,2,0), ''); # P Q=R S
|
|---|
| 136 | is(substr($a,2,3), '321'); # P Q R=S
|
|---|
| 137 | is(substr($a,5,0), ''); # P Q=R=S
|
|---|
| 138 | is(substr($a,5,2), ''); # P Q=S R
|
|---|
| 139 | is(substr($a,-7,-5), ''); # Q P=R S
|
|---|
| 140 | is(substr($a,-7,-2), '543');# Q P R S
|
|---|
| 141 | is(substr($a,-5,-5), ''); # P=Q=R S
|
|---|
| 142 | is(substr($a,-5,-2), '543');# P=Q R S
|
|---|
| 143 | is(substr($a,-3,-3), ''); # P Q=R S
|
|---|
| 144 | is(substr($a,-3,-1), '32');# P Q R S
|
|---|
| 145 |
|
|---|
| 146 | $a = '';
|
|---|
| 147 |
|
|---|
| 148 | is(substr($a,-2,2), ''); # Q P=R=S
|
|---|
| 149 | is(substr($a,0,0), ''); # P=Q=R=S
|
|---|
| 150 | is(substr($a,0,1), ''); # P=Q=S R
|
|---|
| 151 | is(substr($a,-2,3), ''); # Q P=S R
|
|---|
| 152 | is(substr($a,-2), ''); # Q P=R=S
|
|---|
| 153 | is(substr($a,0), ''); # P=Q=R=S
|
|---|
| 154 |
|
|---|
| 155 |
|
|---|
| 156 | is(substr($a,0,-1), ''); # R P=Q=S
|
|---|
| 157 | $b = substr($a,-2, 0) ; # warn # Q=R P=S
|
|---|
|
|---|
