view release on metacpan or  search on metacpan

misc/pX/Common/Regexp-Test-Perl5Tests/t/op/pat.t  view on Meta::CPAN

@a = ("foo\nbar" =~ /\C/g);
print "ok 678\n" if @a == 7 && "@a" eq "f o o \n b a r";

@a = ("foo\nbar" =~ /\C/gs);
print "ok 679\n" if @a == 7 && "@a" eq "f o o \n b a r";

@a = ("foo\n\x{100}bar" =~ /./g);
print "ok 680\n" if @a == 7 && "@a" eq "f o o \x{100} b a r";

@a = ("foo\n\x{100}bar" =~ /./gs);
print "ok 681\n" if @a == 8 && "@a" eq "f o o \n \x{100} b a r";

($a, $b) = map { chr } ord('A') == 65 ? (0xc4, 0x80) : (0x8c, 0x41);

@a = ("foo\n\x{100}bar" =~ /\C/g);
print "ok 682\n" if @a == 9 && "@a" eq "f o o \n $a $b b a r";

@a = ("foo\n\x{100}bar" =~ /\C/gs);
print "ok 683\n" if @a == 9 && "@a" eq "f o o \n $a $b b a r";

{
    # [ID 20010814.004] pos() doesn't work when using =~m// in list context
    $_ = "ababacadaea";
    $a = join ":", /b./gc;
    $b = join ":", /a./gc;
    $c = pos;
    print "$a $b $c" eq 'ba:ba ad:ae 10' ? "ok 684\n" : "not ok 684\t# $a $b $c\n";
}

{
    # [ID 20010407.006] matching utf8 return values from functions does not work

    package ID_20010407_006;

    sub x {
	"a\x{1234}";
    }

    my $x = x;
    my $y;

    $x =~ /(..)/; $y = $1;
    print "not " unless length($y) == 2 && $y eq $x;
    print "ok 685\n";

    x  =~ /(..)/; $y = $1;
    print "not " unless length($y) == 2 && $y eq $x;
    print "ok 686\n";
}


my $test = 687;

# Force scalar context on the patern match
sub ok ($$) {
    my($ok, $name) = @_;

    printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, $name;

    printf "# Failed test at line %d\n", (caller)[2] unless $ok;

    $test++;
    return $ok;
}

{
    # Check that \x## works. 5.6.1 and 5.005_03 fail some of these.
    $x = "\x4e" . "E";
    ok ($x =~ /^\x4EE$/, "Check only 2 bytes of hex are matched.");

    $x = "\x4e" . "i";
    ok ($x =~ /^\x4Ei$/, "Check that invalid hex digit stops it (2)");

    $x = "\x4" . "j";
    ok ($x =~ /^\x4j$/,  "Check that invalid hex digit stops it (1)");

    $x = "\x0" . "k";
    ok ($x =~ /^\xk$/,   "Check that invalid hex digit stops it (0)");

    $x = "\x0" . "x";
    ok ($x =~ /^\xx$/, "\\xx isn't to be treated as \\0");

    $x = "\x0" . "xa";
    ok ($x =~ /^\xxa$/, "\\xxa isn't to be treated as \\xa");

    $x = "\x9" . "_b";
    ok ($x =~ /^\x9_b$/, "\\x9_b isn't to be treated as \\x9b");

    print "# and now again in [] ranges\n";

    $x = "\x4e" . "E";
    ok ($x =~ /^[\x4EE]{2}$/, "Check only 2 bytes of hex are matched.");

    $x = "\x4e" . "i";
    ok ($x =~ /^[\x4Ei]{2}$/, "Check that invalid hex digit stops it (2)");

    $x = "\x4" . "j";
    ok ($x =~ /^[\x4j]{2}$/,  "Check that invalid hex digit stops it (1)");

    $x = "\x0" . "k";
    ok ($x =~ /^[\xk]{2}$/,   "Check that invalid hex digit stops it (0)");

    $x = "\x0" . "x";
    ok ($x =~ /^[\xx]{2}$/, "\\xx isn't to be treated as \\0");

    $x = "\x0" . "xa";
    ok ($x =~ /^[\xxa]{3}$/, "\\xxa isn't to be treated as \\xa");

    $x = "\x9" . "_b";
    ok ($x =~ /^[\x9_b]{3}$/, "\\x9_b isn't to be treated as \\x9b");

}

{
    # Check that \x{##} works. 5.6.1 fails quite a few of these.

    $x = "\x9b";
    ok ($x =~ /^\x{9_b}$/, "\\x{9_b} is to be treated as \\x9b");

    $x = "\x9b" . "y";