File: rt122747.t

package info (click to toggle)
perl 5.24.1-3%2Bdeb9u7
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 107,108 kB
  • sloc: perl: 559,649; ansic: 293,918; sh: 67,316; pascal: 7,632; cpp: 3,895; makefile: 2,436; xml: 2,410; yacc: 989; sed: 6; lisp: 1
file content (33 lines) | stat: -rw-r--r-- 704 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
#!./perl
use strict;
use warnings;

$| = 1;


BEGIN {
    chdir 't' if -d 't';
    @INC = ('../lib','.','../ext/re');
    require './test.pl';
    if (is_miniperl()) {
        skip_all_if_miniperl("Unicode tables not built yet", 2)
            unless eval 'require "unicore/Heavy.pl"';
    }
}

plan tests => 3;
use strict;

my(@body) = (
  "<mailto:xxxx.xxxx\@outlook.com>",
  "A\x{B9}ker\x{E8}eva xxxx.xxxx\@outlook.com \x{201D}",
);

for (@body) {
  s{ <? (?<!mailto:) \b ( [a-z0-9.]+ \@ \S+ ) \b
     (?: > | \s{1,10} (?!phone) [a-z]{2,11} : ) }{ }xgi;
  my $got= $1;
  is( $got, '.xxxx@outlook.com' );
}
ok("got to the end without dieing (note without DEBUGGING passing this test means nothing)");