Contents of /code/trunk/perltest.pl

Applied Bob and Daniel's patches to convert the build system to automake. Added
the maintain directory, containing files that are used for maintenance, but are
not distributed. This is an intermediate step.

1

#! /usr/bin/env perl

2

3

# Program for testing regular expressions with perl to check that PCRE handles

4

# them the same. This is the version that supports /8 for UTF-8 testing. As it

5

# stands, it requires at least Perl 5.8 for UTF-8 support. However, it needs to

6

# have "use utf8" at the start for running the UTF-8 tests, but *not* for the

7

# other tests. The only way I've found for doing this is to cat this line in

8

# explicitly in the RunPerlTest script.

9

10

# use locale; # With this included, \x0b matches \s!

11

12

# Function for turning a string into a string of printing chars. There are

13

# currently problems with UTF-8 strings; this fudges round them.

14

15

sub pchars {

16

my($t) = "";

17

18

if ($utf8)

19

{

20

@p = unpack('U*', $_[0]);

21

foreach $c (@p)

22

{

23

if ($c >= 32 && $c < 127) { $t .= chr $c; }

24

else { $t .= sprintf("\\x{%02x}", $c); }

25

}

26

}

27

28

else

29

{

30

foreach $c (split(//, $_[0]))

31

{

32

if (ord $c >= 32 && ord $c < 127) { $t .= $c; }

33

else { $t .= sprintf("\\x%02x", ord $c); }

34

}

35

}

36

37

$t;

38

}

39

40

41

# Read lines from named file or stdin and write to named file or stdout; lines

42

# consist of a regular expression, in delimiters and optionally followed by

43

# options, followed by a set of test data, terminated by an empty line.

44

45

# Sort out the input and output files

46

47

if (@ARGV > 0)

48

{

49

open(INFILE, "<$ARGV[0]") || die "Failed to open $ARGV[0]\n";

50

$infile = "INFILE";

51

}

52

else { $infile = "STDIN"; }

53

54

if (@ARGV > 1)

55

{

56

open(OUTFILE, ">$ARGV[1]") || die "Failed to open $ARGV[1]\n";

57

$outfile = "OUTFILE";

58

}

59

else { $outfile = "STDOUT"; }

60

61

printf($outfile "Perl $] Regular Expressions\n\n");

62

63

# Main loop

64

65

NEXT_RE:

66

for (;;)

67

{

68

printf " re> " if $infile eq "STDIN";

69

last if ! ($_ = <$infile>);

70

printf $outfile "$_" if $infile ne "STDIN";

71

next if ($_ eq "");

72

73

$pattern = $_;

74

75

while ($pattern !~ /^\s*(.).*\1/s)

76

{

77

printf " > " if $infile eq "STDIN";

78

last if ! ($_ = <$infile>);

79

printf $outfile "$_" if $infile ne "STDIN";

80

$pattern .= $_;

81

}

82

83

chomp($pattern);

84

$pattern =~ s/\s+$//;

85

86

# The private /+ modifier means "print $' afterwards".

87

88

$showrest = ($pattern =~ s/\+(?=[a-z]*$)//);

89

90

# Remove /8 from a UTF-8 pattern.

91

92

$utf8 = $pattern =~ s/8(?=[a-z]*$)//;

93

94

# Check that the pattern is valid

95

96

eval "\$_ =~ ${pattern}";

97

if ($@)

98

{

99

printf $outfile "Error: $@";

100

next NEXT_RE;

101

}

102

103

# If the /g modifier is present, we want to put a loop round the matching;

104

# otherwise just a single "if".

105

106

$cmd = ($pattern =~ /g[a-z]*$/)? "while" : "if";

107

108

# If the pattern is actually the null string, Perl uses the most recently

109

# executed (and successfully compiled) regex is used instead. This is a