note
AnomalousMonk
<p>
Implementing the criteria given by [Corion] [id://1219109|here], and just for completness, here's a single-regex solution. Note that this accepts the empty string as a substring of any non-empty string.
<readmore>
<c>
c:\@Work\Perl\monks>perl -le
"use warnings;
use strict;
;;
use Test::More 'no_plan';
use Test::NoWarnings;
;;
use constant SUBSTRINGS => (
'the empty string is a substring of any non-empty string',
[ 'x', '' ],
[ 'helloworld', '' ],
[ 'xx', 'x' ],
[ 'xy', 'x' ],
[ 'yx', 'x' ],
[ 'yxy', 'x' ],
[ 'helloworld', 'hello' ],
[ 'helloworld', 'world' ],
[ 'hellohello', 'hello' ],
[ 'hello world', 'hello' ],
[ 'hello world', 'world' ],
[ 'hello hello', 'hello' ],
[ 'xhelloworldx', 'hello' ],
[ 'xhelloworldx', 'world' ],
[ 'xhello worldx', 'hello' ],
[ 'xhello worldx', 'world' ],
);
;;
use constant NO_SUBSTRINGS => (
'the empty string is not a substring of itself',
[ '', '' ],
[ '', 'x' ],
[ 'x', 'x' ],
[ 'x', 'xx' ],
[ 'x', 'y' ],
[ 'foo', 'bar' ],
[ 'hello', 'hello' ],
[ 'hello', 'xhello' ],
[ 'hello', 'hellox' ],
[ 'xhello', 'hellox' ],
[ 'hello', 'helloworld' ],
);
;;
note 'each of these strings has a substring';
VECTOR_SUBSTRING:
for my $ar_vector (SUBSTRINGS) {
if (not ref $ar_vector) {
note $ar_vector;
next VECTOR_SUBSTRING;
}
;;
my ($string, $substring) = @$ar_vector;
;;
ok $string =~ m{ \A .+ \Q$substring\E | \Q$substring\E .+ \z }xms,
qq{'$string' contains '$substring'};
}
;;
note 'none of these strings has a substring';
VECTOR_NO_SUBSTRING:
for my $ar_vector (NO_SUBSTRINGS) {
if (not ref $ar_vector) {
note $ar_vector;
next VECTOR_NO_SUBSTRING;
}
;;
my ($string, $substring) = @$ar_vector;
;;
ok $string !~ m{ \A .+ \Q$substring\E | \Q$substring\E .+ \z }xms,
qq{'$string' does not contain '$substring'};
}
;;
done_testing;
;;
exit;
"
# each of these strings has a substring
# the empty string is a substring of any non-empty string
ok 1 - 'x' contains ''
ok 2 - 'helloworld' contains ''
ok 3 - 'xx' contains 'x'
ok 4 - 'xy' contains 'x'
ok 5 - 'yx' contains 'x'
ok 6 - 'yxy' contains 'x'
ok 7 - 'helloworld' contains 'hello'
ok 8 - 'helloworld' contains 'world'
ok 9 - 'hellohello' contains 'hello'
ok 10 - 'hello world' contains 'hello'
ok 11 - 'hello world' contains 'world'
ok 12 - 'hello hello' contains 'hello'
ok 13 - 'xhelloworldx' contains 'hello'
ok 14 - 'xhelloworldx' contains 'world'
ok 15 - 'xhello worldx' contains 'hello'
ok 16 - 'xhello worldx' contains 'world'
# none of these strings has a substring
# the empty string is not a substring of itself
ok 17 - '' does not contain ''
ok 18 - '' does not contain 'x'
ok 19 - 'x' does not contain 'x'
ok 20 - 'x' does not contain 'xx'
ok 21 - 'x' does not contain 'y'
ok 22 - 'foo' does not contain 'bar'
ok 23 - 'hello' does not contain 'hello'
ok 24 - 'hello' does not contain 'xhello'
ok 25 - 'hello' does not contain 'hellox'
ok 26 - 'xhello' does not contain 'hellox'
ok 27 - 'hello' does not contain 'helloworld'
1..27
ok 28 - no warnings
1..28
</C>
</READMORE>
(Should work on any Perl version 5.8.9+.)
</P>
<!-- Node text goes above. Div tags should contain sig only -->
<div class="pmsig"><div class="pmsig-634253">
<hr><p>Give a man a fish<b>:</B> <c> <%-{-{-{-<</C></P>
</div></div>
1219107
1219107