<?php

require_once("Regexp_Assemble.php");

require_once("testutil.php");

{

$r = new Regexp_Assemble();

$r->add( 'a b' );

is( $r->dump(), "[a ' ' b]", 'dump path with space' );

$r->insert( 'a', ' ', 'b', 'c', 'd' );

is( $r->dump(), "[a ' ' b {* c=>[c d]}]",

'dump path with space 2' );

}

/*

# 06_general.t

#

# Test suite for Regexp::Assemble

# Check out the general functionality, now that all the subsystems have been exercised

#

# copyright (C) 2004-2007 David Landgren

use strict;

use Regexp::Assemble;

eval qq{use Test::More tests => 142 };

if( $@ ) {

warn "# Test::More not available, no tests performed\n";

print "1..1\nok 1\n";

exit 0;

}

use constant NR_GOOD => 45;

use constant NR_BAD => 529;

use constant NR_ERROR => 0;

my $fixed = 'The scalar remains the same';

$_ = $fixed;

*/

$ra = new Regexp_Assemble();

$ra->add( 'foo' ,'bar', 'rat' );

foreach(array('unfooled', 'disembark', 'vibration') as $target){

like( $target, "/$ra/", "match ok $target" );

}

ok( ! $ra->source(), 'source() undefined' );

foreach(array('unfooled', 'disembark', 'vibration') as $target){

unlike( $target, "/^$ra/", "anchored match not ok $target" );

}

$ra->reset();

foreach(array('unfooled', 'disembark', 'vibration') as $target){

unlike( $target, "/$ra/", "fail after reset $target" );

}

$ra->add( 'who', 'what', 'where', 'why', 'when' );

foreach(array('unfooled', 'disembark', 'vibration') as $target){

unlike( $target, "/$ra/", "fail ok $target" );

}

foreach(array('snowhouse', 'somewhat', 'nowhereness', 'whyever', 'nowhence') as $target){

like( $target, "/$ra/", "new match ok $target" );

}

$ra->reset()->mutable(1);

unlike( 'nothing', "/$ra/", "match nothing after reset" );

$ra->add( '^foo\\d+' );

like( 'foo12', "/$ra/", "match 1 ok foo12" );

unlike( 'nfoo12', "/$ra/", "match 1 nok nfoo12" );

unlike( 'bar6', "/$ra/", "match 1 nok bar6" );

ok( ! $ra->mvar(), 'mvar() undefined' );

$ra->add( 'bar\\d+' );

like( 'foo12', "/$ra/", "match 2 ok foo12" );

unlike( 'nfoo12', "/$ra/", "match 2 nok nfoo12" );

like( 'bar6', "/$ra/", "match 2 ok bar6" );

$ra->reset()->filter( function($arr) {

$r = [];

foreach($arr as $_) {

if ( preg_match("/\d /" , $_) ) {

$r[] = $_;

}

}

return ! count($r);

} );

$ra->add( '1 2 4' );

$ra->insert( '1', '2', '8*' );

unlike( '3 4 1 2', "/$ra/", 'filter nok 3 4 1 2' );

like( '3 1 2 4', "/$ra/", 'filter ok 3 1 2 4' );

unlike( '5 2 3 4', "/$ra/", 'filter ok 5 2 3 4' );

$ra->add( '2 3 a+' );

$ra->insert( '2', ' ', '3', ' ', 'a+' );

unlike( '5 2 3 4', "/$ra/", 'filter ok 5 2 3 4 (2)' );

//unlike( '5 2 3 aaa', "/$ra/", 'filter nok 5 2 3 a+' );

$ra->reset()->filter( NULL );

$ra->add( '1 2 a+' );

like( '5 1 2 aaaa', "/$ra/", 'filter now ok 5 1 2 a+' );

$ra->reset()->pre_filter( function ($p1){

$r = [];

if ( preg_match("/^#/" , $p1) ) {

return false;

}

return true;

} );

$ra->add( '#de' );

$ra->add( 'abc' );

unlike( '#de', "/^$ra$/", '#de not matched by comment-filtered assembly' );

like( 'abc', "/^$ra$/", 'abc matched by comment-filtered assembly' );

/* PHP CLONE するから意味はない

SKIP: {

skip( "is_deeply is broken in this version of Test::More (v$Test::More::VERSION)", 5 )

unless $Test::More::VERSION > 0.47;

{

my $orig = Regexp::Assemble->new;

my $clone = $orig->clone;

is_deeply( $orig, $clone, 'clone empty' );

}

{

my $orig = Regexp::Assemble->new->add( qw/ dig dug dog / );

my $clone = $orig->clone;

is_deeply( $orig, $clone, 'clone path' );

}

{

my $orig = Regexp::Assemble->new->add( qw/ dig dug dog / );

my $clone = $orig->clone;

$orig->add( 'digger' );

$clone->add( 'digger' );

is_deeply( $orig, $clone, 'clone then add' );

}

{

my $orig = Regexp::Assemble->new

->add( qw/ bird cat dog elephant fox/ );

my $clone = $orig->clone;

is_deeply( $orig, $clone, 'clone node' );

}

{

my $orig = Regexp::Assemble->new

->add( qw/ after alter amber cheer steer / );

my $clone = $orig->clone;

is_deeply( $orig, $clone, 'clone more' );

}

}

SKIP: {

# If the Storable module is available, we will have used

# that above, however, we will not have tested the pure-Perl

# fallback routines.

skip( 'Pure-Perl clone() already tested', 5 )

unless $Regexp::Assemble::have_Storable;

skip( "is_deeply is broken in this version of Test::More (v$Test::More::VERSION)", 5 )

unless $Test::More::VERSION > 0.47;

local $Regexp::Assemble::have_Storable = 0;

{

my $orig = Regexp::Assemble->new;

my $clone = $orig->clone;

is_deeply( $orig, $clone, 'clone empty' );

}

{

my $orig = Regexp::Assemble->new->add( qw/ dig dug dog / );

my $clone = $orig->clone;

is_deeply( $orig, $clone, 'clone path' );

}

{

my $orig = Regexp::Assemble->new->add( qw/ dig dug dog / );

my $clone = $orig->clone;

$orig->add( 'digger' );

$clone->add( 'digger' );

is_deeply( $orig, $clone, 'clone then add' );

}

{

my $orig = Regexp::Assemble->new

->add( qw/ bird cat dog elephant fox/ );

my $clone = $orig->clone;

is_deeply( $orig, $clone, 'clone node' );

}

{

my $orig = Regexp::Assemble->new

->add( qw/ after alter amber cheer steer / );

my $clone = $orig->clone;

is_deeply( $orig, $clone, 'clone more' );

}

}

*/

{

$r = new Regexp_Assemble();

$r->add( 'dig', 'dug' );

is( $r->dump(), '[d {i=>[i g] u=>[u g]}]', 'dump path' );

}

{

$r = new Regexp_Assemble();

$r->add( 'a b' );

is( $r->dump(), "[a ' ' b]", 'dump path with space' );

$r->insert( 'a', ' ', 'b', 'c', 'd' );

is( $r->dump(), "[a ' ' b {* c=>[c d]}]",

'dump path with space 2' );

}

{

$r = new Regexp_Assemble();

$r->add( 'dog', 'cat' );

is( $r->dump(), '[{c=>[c a t] d=>[d o g]}]', 'dump node' );

}

{

$r = new Regexp_Assemble();

$r->add( 'house', 'home' );

$r->insert();

is( $r->dump(), '[{* h=>[h o {m=>[m e] u=>[u s e]}]}]',

'add opt to path' );

}

{

$r = new Regexp_Assemble();

$r->add('dog', 'cat');

$r->insert();

is( $r->dump(), '[{* c=>[c a t] d=>[d o g]}]',

'add opt to node' );

}

{

$slide = new Regexp_Assemble();

is( $slide->add( 'schoolkids', 'acids', 'acidoids' )->as_string(),

'(?:ac(?:ido)?|schoolk)ids', 'schoolkids acids acidoids' );

is( $slide->add( 'schoolkids', 'acidoids' )->as_string(),

'(?:schoolk|acido)ids', 'schoolkids acidoids' );

is( $slide->add( 'nonschoolkids', 'nonacidoids' )->as_string(),

'non(?:schoolk|acido)ids', 'nonschoolkids nonacidoids' );

}

{

$r = new Regexp_Assemble();

is( $r

->add( 'sing', 'singing')

->as_string(), 'sing(?:ing)?', 'super slide sing singing' # no sliding done

);

$r = new Regexp_Assemble();

is( $r

->add( 'sing', 'singing', 'sling')

->as_string(), 's(?:(?:ing)?|l)ing',

'super slide sing singing sling'

);

$r = new Regexp_Assemble();

is( $r

->add( 'sing', 'singing', 'sling', 'slinging')

->as_string(), 'sl?(?:ing)?ing',

'super slide sing singing sling slinging'

);

$r = new Regexp_Assemble();

is( $r

->add( 'sing', 'singing', 'sling', 'slinging', 'sting', 'stinging')

->as_string(), 's[lt]?(?:ing)?ing',

'super slide sing singing sling slinging sting stinging'

);

$r = new Regexp_Assemble();

is( $r

->add( 'sing','singing','sling','slinging','sting','stinging','string','stringing','swing','swinging' )

->as_string(), 's(?:[lw]|tr?)?(?:ing)?ing',

'super slide sing singing sling slinging sting stinging string stringing swing swinging'

);

}

{

$re = new Regexp_Assemble([ 'flags' => 'i' ]);

$re->add( '^ab', '^are', 'de' );

like( 'able', "/$re/", '{^ab ^are de} /i matches able' );

like( 'About', "/$re/", '{^ab ^are de} /i matches About' );

unlike( 'bare', "/$re/", '{^ab ^are de} /i fails bare' );

like( 'death', "/$re/", '{^ab ^are de} /i matches death' );

like( 'DEEP', "/$re/", '{^ab ^are de} /i matches DEEP' );

}

{

$re = new Regexp_Assemble();

$re->add( 'abc', 'def', 'ghi' );

is( $re->stats_add(), 3, "stats add 3x3" );

is( $re->stats_raw(), 9, "stats raw 3x3" );

is( $re->stats_cooked(), 9, "stats cooked 3x3" );

ok( ! $re->stats_dup() , "stats dup 3x3" );

$re->add( 'de' );

is( $re->stats_add(), 4, "stats add 3x3 +1" );

is( $re->stats_raw(), 11, "stats raw 3x3 +1" );

is( $re->stats_cooked(), 11, "stats cooked 3x3 +1" );

}

{

$re = new Regexp_Assemble();

$re->add( '\\Qabc.def.ghi\\E' );

is( $re->stats_add(), 1, "stats add qm" );

is( $re->stats_raw(), 15, "stats raw qm" );

is( $re->stats_cooked(), 13, "stats cooked qm" );

ok( ! $re->stats_dup() , "stats dup qm" );

}

{

$re = new Regexp_Assemble();

$re->add( 'abc\\,def', 'abc\\,def' );

is( $re->stats_add(), 1, "stats add unqm dup" );

is( $re->stats_raw(), 16, "stats raw unqm dup" );

is( $re->stats_cooked(), 7, "stats cooked unqm dup" );

is( $re->stats_dup(), 1, "stats dup unqm dup" );

is( $re->stats_length(), 0, "stats_length unqm dup" );

$str = $re->as_string();

is( $str, 'abc,def', "stats str unqm dup" );

is( $re->stats_length(), 7, "stats len unqm dup" );

}

{

$re = new Regexp_Assemble();

$re->add( '' );

is( $re->stats_add(), 1, "stats add empty" );

is( $re->stats_raw(), 0, "stats raw empty" );

ok( ! $re->stats_cooked() , "stats cooked empty" );

ok( ! $re->stats_dup() , "stats dup empty" );

}

{

$re = new Regexp_Assemble();

is( $re->stats_add(), 0, "stats_add empty" );

is( $re->stats_raw(), 0, "stats_raw empty" );

is( $re->stats_cooked(), 0, "stats_cooked empty" );

is( $re->stats_dup(), 0, "stats_dup empty" );

is( $re->stats_length(), 0, "stats_length empty" );

$str = $re->as_string();

is( $str, Regexp_Assemble::Always_Fail, "stats str empty" ); # tricky!

is( $re->stats_length(), 0, "stats len empty" );

}

{

$re = new Regexp_Assemble();

$re->add( '\\Q.+\\E', '\\Q.+\\E', '\\Q.*\\E' );

is( $re->stats_add(), 2, "stats_add 2" );

is( $re->stats_raw(), 18, "stats_raw 2" );

is( $re->stats_cooked(), 8, "stats_cooked 2" );

is( $re->stats_dup(), 1, "stats_dup 2" );

is( $re->stats_length(), 0, "stats_length 2" );

$str = $re->as_string();

is( $str, '\\.[*+]', "stats str 2" );

is( $re->stats_length(), 6, "stats len 2 <$str>" );

}

{

# CPAN bug #24171

# given a list of strings

$str = [ 'a b', 'awb', 'a1b', 'bar', "a\nb" ];

foreach( array('s', 'w', 'd') as $meta) {

# given a list of patterns

$re_list = [ "a\\{$meta}b", "a\\@{[uc{$meta}]}b" ];

# produce an assembled pattern

$r = new Regexp_Assemble();

$re = $r->add($re_list)->re();

$r2 = new Regexp_Assemble();

$re_fold = $r2->fold_meta_pairs(0)->add($re_list)->re();

# test it against the strings

foreach($str as $s) {

# any match?

$ok = 0;

foreach($re_list as $_) {

if ( preg_match("/$_/" , $s) ) {

$ok = 1;

}

}

# does the assemble regexp match as well?

$ptr = $s;

// $ptr =~ s/\\/\\\\/;

$ptr = preg_replace('/\\\\/' , '/\\\\\\\\/' , $ptr);

// $ptr =~ s/\n/\\n/;

$ptr = preg_replace('/\n/' , '/\\\\n/' , $ptr);

// my $bug_success = ($s =~ /\n/) ? 0 : 1;

$bug_success = (preg_match("/\n/" , $s)) ? 0 : 1;

$bug_fail = 1 - $bug_success;

////保留

// is( preg_match("/$re/" , $s ) ? $bug_success : $bug_fail, $ok,

// "Folded meta pairs behave as list for \\$meta ($ptr,ok=$ok/$bug_success/$bug_fail)"

// );

is( ( preg_match("/$re_fold/",$s)) ? 1 : 0, $ok,

"Unfolded meta pairs behave as list for \\$meta ($ptr,ok=$ok)"

);

}

}

}

{

$u = new Regexp_Assemble(['unroll_plus' => 1]);

$u->add( "a+b", 'ac' );

$str = $u->as_string();

is( $str, 'a(?:a*b|c)', 'unroll plus a+b ac' );

$u->add( "\\LA+B", "ac" );

$str = $u->as_string();

is( $str, 'a(?:a*b|c)', 'unroll plus \\LA+B ac' );

$u->add( "\\Ua+?b", "AC" );

$str = $u->as_string();

is( $str, 'A(?:A*?B|C)', 'unroll plus \\Ua+?b AC' );

$u->add( '\\d+d', '\\de', '\\w+?x', '\\wy');

$str = $u->as_string();

is( $str, '(?:\\w(?:\\w*?x|y)|\\d(?:\d*d|e))', 'unroll plus \\d and \\w' );

//

//PHPではUTF-8以外のマルチバイトは扱えません。

// $u->add( '\\xab+f', '\\xabg', '\\xcd+?h', '\\xcdi');

// $str = $u->as_string();

// is( $str, "(?:\xcd(?:\xcd*?h|i)|\xab(?:\xab*f|g))", 'unroll plus meta x' );

$u->add( '[a-e]+h', '[a-e]i', '[f-j]+?k', '[f-j]m');

$str = $u->as_string();

is( $str, "(?:[f-j](?:[f-j]*?k|m)|[a-e](?:[a-e]*h|i))", 'unroll plus class' );

$u->add( "a+b" );

$str = $u->as_string();

is( $str, "a+b", 'reroll a+b' );

$u->add( "a+b", "a+" );

$str = $u->as_string();

is( $str, "a+b?", 'reroll a+b?' );

$u->add( "a+?b", "a+?" );

$str = $u->as_string();

is( $str, "a+?b?", 'reroll a+?b?' );

$u->unroll_plus(0)->add( '1+2', '13' );

$str = $u->as_string();

is( $str, "(?:1+2|13)", 'no unrolling' );

$u->unroll_plus()->add( '1+2', '13' );

$str = $u->as_string();

is( $str, "1(?:1*2|3)", 'unrolling again via implicit' );

$u->add('d+ldrt', 'd+ndrt', 'd+ldt', 'd+ndt', 'd+x');

$str = $u->as_string();

is( $str, 'd+(?:[ln]dr?t|x)', 'visit ARRAY codepath' );

}

/*

is( $_, 'eq', $fixed, '$_ has not been altered' );

*/

echo "===OK===\n";