epics/epics-base
0
0
Fork 0
Code Issues Pull Requests Projects Wiki Activity

Remove /o flags from Perl regex's

Browse Source 
Apparently they don't help in modern Perls, and can cause problems.
This commit also replaces \d with [0-9], \d also matches foreign digits.
This commit is contained in:
Andrew Johnson
2017-10-19 23:14:12 -05:00
parent 3011ac2143
commit 7a0b095fd3
7 changed files with 63 additions and 63 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/tools/DBD/Base.pm
+7 -7
View File
@@ -19,13 +19,13 @@ our $RXident = qr/ [a-zA-Z] [a-zA-Z0-9_]* /x;
our $RXname = qr/ [a-zA-Z0-9_\-:.\[\]<>;]+ /x;
our $RXhex = qr/ (?: 0 [xX] [0-9A-Fa-f]+ ) /x;
our $RXoct = qr/ 0 [0-7]* /x;
our $RXuint = qr/ \d+ /x;
our $RXint = qr/ -? $RXuint /ox;
our $RXuintx = qr/ ( $RXhex | $RXoct | $RXuint ) /ox;
our $RXintx = qr/ ( $RXhex | $RXoct | $RXint ) /ox;
our $RXnum = qr/ -? (?: \d+ | \d* \. \d+ ) (?: [eE] [-+]? \d+ )? /x;
our $RXdqs = qr/ " (?: [^"] | \\" )* " /x;
our $RXstr = qr/ ( $RXname | $RXnum | $RXdqs ) /ox;
our $RXuint = qr/ [0-9]+ /x;
our $RXint = qr/ -? $RXuint /x;
our $RXuintx = qr/ ( $RXhex | $RXoct | $RXuint ) /x;
our $RXintx = qr/ ( $RXhex | $RXoct | $RXint ) /x;
our $RXnum = qr/ -? (?: [0-9]+ | [0-9]* \. [0-9]+ ) (?: [eE] [-+]? [0-9]+ )? /x;
our $RXstr = qr/ ( $RXname | $RXnum | $RXdqs ) /x;
our @context;
@@ -73,7 +73,7 @@ sub identifier {
my ($this, $id, $what) = @_;
confess "DBD::Base::identifier: $what undefined!"
unless defined $id;
$id =~ m/^$RXident$/o or dieContext("Illegal $what '$id'",
$id =~ m/^$RXident$/ or dieContext("Illegal $what '$id'",
"Identifiers are used in C code so must start with a letter, followed",
"by letters, digits and/or underscore characters only.");
dieContext("Illegal $what '$id'",
src/tools/DBD/Device.pm
+11 -11
View File
@@ -3,17 +3,17 @@ use DBD::Base;
@ISA = qw(DBD::Base);
my %link_types = (
CONSTANT => qr/$RXnum/o,
PV_LINK => qr/$RXname \s+ [.NPCAMS ]*/ox,
JSON_LINK => qr/\{ .* \}/ox,
VME_IO => qr/\# (?: \s* [CS] \s* $RXintx)* \s* (?: @ .*)?/ox,
CAMAC_IO => qr/\# (?: \s* [BCNAF] \s* $RXintx)* \s* (?: @ .*)?/ox,
RF_IO => qr/\# (?: \s* [RMDE] \s* $RXintx)*/ox,
AB_IO => qr/\# (?: \s* [LACS] \s* $RXintx)* \s* (?: @ .*)?/ox,
GPIB_IO => qr/\# (?: \s* [LA] \s* $RXintx)* \s* (?: @ .*)?/ox,
BITBUS_IO => qr/\# (?: \s* [LNPS] \s* $RXuintx)* \s* (?: @ .*)?/ox,
BBGPIB_IO => qr/\# (?: \s* [LBG] \s* $RXuintx)* \s* (?: @ .*)?/ox,
VXI_IO => qr/\# (?: \s* [VCS] \s* $RXintx)* \s* (?: @ .*)?/ox,
CONSTANT => qr/$RXnum/,
PV_LINK => qr/$RXname \s+ [.NPCAMS ]*/x,
JSON_LINK => qr/\{ .* \}/x,
VME_IO => qr/\# (?: \s* [CS] \s* $RXintx)* \s* (?: @ .*)?/x,
CAMAC_IO => qr/\# (?: \s* [BCNAF] \s* $RXintx)* \s* (?: @ .*)?/x,
RF_IO => qr/\# (?: \s* [RMDE] \s* $RXintx)*/x,
AB_IO => qr/\# (?: \s* [LACS] \s* $RXintx)* \s* (?: @ .*)?/x,
GPIB_IO => qr/\# (?: \s* [LA] \s* $RXintx)* \s* (?: @ .*)?/x,
BITBUS_IO => qr/\# (?: \s* [LNPS] \s* $RXuintx)* \s* (?: @ .*)?/x,
BBGPIB_IO => qr/\# (?: \s* [LBG] \s* $RXuintx)* \s* (?: @ .*)?/x,
VXI_IO => qr/\# (?: \s* [VCS] \s* $RXintx)* \s* (?: @ .*)?/x,
INST_IO => qr/@.*/
);
src/tools/DBD/Output.pm
+1 -1
View File
@@ -60,7 +60,7 @@ sub OutputRecordtypes {
$field->name, $field->dbf_type;
while (my ($attr, $val) = each %{$field->attributes}) {
$val = "\"$val\""
if $val !~ m/^$RXname$/ox
if $val !~ m/^$RXname$/x
|| $attr eq 'prompt'
|| $attr eq 'initial';
printf $out " %s(%s)\n", $attr, $val;
src/tools/DBD/Parser.pm
+35 -35
View File
@@ -28,47 +28,47 @@ sub ParseDBD {
(my $dbd, $_) = @_;
while (1) {
parseCommon($dbd);
if (m/\G menu \s* \( \s* $RXstr \s* \) \s* \{/oxgc) {
if (m/\G menu \s* \( \s* $RXstr \s* \) \s* \{/xgc) {
print "Menu: $1\n" if $debug;
my ($menu_name) = unquote($1);
parse_menu($dbd, $menu_name);
}
elsif (m/\G driver \s* \( \s* $RXstr \s* \)/oxgc) {
elsif (m/\G driver \s* \( \s* $RXstr \s* \)/xgc) {
print "Driver: $1\n" if $debug;
my ($driver_name) = unquote($1);
$dbd->add(DBD::Driver->new($driver_name));
}
elsif (m/\G link \s* \( \s* $RXstr \s*, \s* $RXstr \s* \)/oxgc) {
elsif (m/\G link \s* \( \s* $RXstr \s*, \s* $RXstr \s* \)/xgc) {
print "Link $1, $2\n" if $debug;
my ($key, $lset) = unquote($1, $2);
$dbd->add(DBD::Link->new($key, $lset));
}
elsif (m/\G registrar \s* \( \s* $RXstr \s* \)/oxgc) {
elsif (m/\G registrar \s* \( \s* $RXstr \s* \)/xgc) {
print "Registrar: $1\n" if $debug;
my ($registrar_name) = unquote($1);
$dbd->add(DBD::Registrar->new($registrar_name));
}
elsif (m/\G function \s* \( \s* $RXstr \s* \)/oxgc) {
elsif (m/\G function \s* \( \s* $RXstr \s* \)/xgc) {
print "Function: $1\n" if $debug;
my ($function_name) = unquote($1);
$dbd->add(DBD::Function->new($function_name));
}
elsif (m/\G breaktable \s* \( \s* $RXstr \s* \) \s* \{/oxgc) {
elsif (m/\G breaktable \s* \( \s* $RXstr \s* \) \s* \{/xgc) {
print "Breaktable: $1\n" if $debug;
my ($breaktable_name) = unquote($1);
parse_breaktable($dbd, $breaktable_name);
}
elsif (m/\G recordtype \s* \( \s* $RXstr \s* \) \s* \{/oxgc) {
elsif (m/\G recordtype \s* \( \s* $RXstr \s* \) \s* \{/xgc) {
print "Recordtype: $1\n" if $debug;
my ($recordtype_name) = unquote($1);
parse_recordtype($dbd, $recordtype_name);
}
elsif (m/\G g?record \s* \( \s* $RXstr \s*, \s* $RXstr \s* \) \s* \{/oxgc) {
elsif (m/\G g?record \s* \( \s* $RXstr \s*, \s* $RXstr \s* \) \s* \{/xgc) {
print "Record: $1, $2\n" if $debug;
my ($record_type, $record_name) = unquote($1, $2);
parse_record($dbd, $record_type, $record_name);
}
elsif (m/\G alias \s* \( \s* $RXstr \s*, \s* $RXstr \s* \)/oxgc) {
elsif (m/\G alias \s* \( \s* $RXstr \s*, \s* $RXstr \s* \)/xgc) {
print "Alias: $1, $2\n" if $debug;
my ($record_name, $alias) = unquote($1, $2);
my $rec = $dbd->record($record_name);
@@ -79,18 +79,18 @@ sub ParseDBD {
$rec->add_alias($alias);
$dbd->add($rec, $alias);
}
elsif (m/\G variable \s* \( \s* $RXstr \s* \)/oxgc) {
elsif (m/\G variable \s* \( \s* $RXstr \s* \)/xgc) {
print "Variable: $1\n" if $debug;
my ($variable_name) = unquote($1);
$dbd->add(DBD::Variable->new($variable_name));
}
elsif (m/\G variable \s* \( \s* $RXstr \s* , \s* $RXstr \s* \)/oxgc) {
elsif (m/\G variable \s* \( \s* $RXstr \s* , \s* $RXstr \s* \)/xgc) {
print "Variable: $1, $2\n" if $debug;
my ($variable_name, $variable_type) = unquote($1, $2);
$dbd->add(DBD::Variable->new($variable_name, $variable_type));
}
elsif (m/\G device \s* \( \s* $RXstr \s* , \s* $RXstr \s* ,
\s* $RXstr \s* , \s*$RXstr \s* \)/oxgc) {
\s* $RXstr \s* , \s*$RXstr \s* \)/xgc) {
print "Device: $1, $2, $3, $4\n" if $debug;
my ($record_type, $link_type, $dset, $choice) =
unquote($1, $2, $3, $4);
@@ -112,7 +112,7 @@ sub parseCommon {
my ($obj) = @_;
while (1) {
# Skip leading whitespace
m/\G \s* /oxgc;
m/\G \s* /xgc;
# Extract POD
if (m/\G ( = [a-zA-Z] )/xgc) {
@@ -123,17 +123,17 @@ sub parseCommon {
$directive .= $1;
$obj->add_pod($directive, parsePod());
}
elsif (m/\G \# /oxgc) {
if (m/\G \# ! BEGIN \{ ( [^}]* ) \} ! \# \# \n/oxgc) {
elsif (m/\G \# /xgc) {
if (m/\G \# ! BEGIN \{ ( [^}]* ) \} ! \# \# \n/xgc) {
print "File-Begin: $1\n" if $debug;
pushContext("file '$1'");
}
elsif (m/\G \# ! END \{ ( [^}]* ) \} ! \# \# \n?/oxgc) {
elsif (m/\G \# ! END \{ ( [^}]* ) \} ! \# \# \n?/xgc) {
print "File-End: $1\n" if $debug;
popContext("file '$1'");
}
else {
m/\G (.*) \n/oxgc;
m/\G (.*) \n/xgc;
$obj->add_comment($1);
print "Comment: $1\n" if $debug;
}
@@ -144,21 +144,21 @@ sub parseCommon {
}
sub unquote {
return map { m/^ ("?) (.*) \1 $/ox; $2 } @_;
return map { m/^ ("?) (.*) \1 $/x; $2 } @_;
}
sub parsePod {
pushContext("Pod markup");
my @pod;
while (1) {
if (m/\G ( =cut .* ) \n?/oxgc) {
if (m/\G ( =cut .* ) \n?/xgc) {
popContext("Pod markup");
return @pod;
}
elsif (m/\G ( .* ) $/oxgc) {
elsif (m/\G ( .* ) $/xgc) {
dieContext("Unexpected end of input file, Pod block not closed");
}
elsif (m/\G ( .* ) \n/oxgc) {
elsif (m/\G ( .* ) \n/xgc) {
push @pod, $1
}
}
@@ -170,12 +170,12 @@ sub parse_menu {
my $menu = DBD::Menu->new($menu_name);
while(1) {
parseCommon($menu);
if (m/\G choice \s* \( \s* $RXstr \s* , \s* $RXstr \s* \)/oxgc) {
if (m/\G choice \s* \( \s* $RXstr \s* , \s* $RXstr \s* \)/xgc) {
print " Menu-Choice: $1, $2\n" if $debug;
my ($choice_name, $value) = unquote($1, $2);
$menu->add_choice($choice_name, $value);
}
elsif (m/\G \}/oxgc) {
elsif (m/\G \}/xgc) {
print " Menu-End:\n" if $debug;
$dbd->add($menu);
popContext("menu($menu_name)");
@@ -193,17 +193,17 @@ sub parse_breaktable {
my $bt = DBD::Breaktable->new($breaktable_name);
while(1) {
parseCommon($bt);
if (m/\G point\s* \(\s* $RXstr \s* , \s* $RXstr \s* \)/oxgc) {
if (m/\G point\s* \(\s* $RXstr \s* , \s* $RXstr \s* \)/xgc) {
print " Breaktable-Point: $1, $2\n" if $debug;
my ($raw, $eng) = unquote($1, $2);
$bt->add_point($raw, $eng);
}
elsif (m/\G $RXstr \s* (?: , \s*)? $RXstr (?: \s* ,)?/oxgc) {
elsif (m/\G $RXstr \s* (?: , \s*)? $RXstr (?: \s* ,)?/xgc) {
print " Breaktable-Data: $1, $2\n" if $debug;
my ($raw, $eng) = unquote($1, $2);
$bt->add_point($raw, $eng);
}
elsif (m/\G \}/oxgc) {
elsif (m/\G \}/xgc) {
print " Breaktable-End:\n" if $debug;
$dbd->add($bt);
popContext("breaktable($breaktable_name)");
@@ -221,16 +221,16 @@ sub parse_recordtype {
my $rtyp = DBD::Recordtype->new($record_type);
while(1) {
parseCommon($rtyp);
if (m/\G field \s* \( \s* $RXstr \s* , \s* $RXstr \s* \) \s* \{/oxgc) {
if (m/\G field \s* \( \s* $RXstr \s* , \s* $RXstr \s* \) \s* \{/xgc) {
print " Recordtype-Field: $1, $2\n" if $debug;
my ($field_name, $field_type) = unquote($1, $2);
parse_field($rtyp, $field_name, $field_type);
}
elsif (m/\G % (.*) \n/oxgc) {
elsif (m/\G % (.*) \n/xgc) {
print " Recordtype-Cdef: $1\n" if $debug;
$rtyp->add_cdef($1);
}
elsif (m/\G \}/oxgc) {
elsif (m/\G \}/xgc) {
print " Recordtype-End:\n" if $debug;
$dbd->add($rtyp);
popContext("recordtype($record_type)");
@@ -262,17 +262,17 @@ sub parse_record {
}
while (1) {
parseCommon($rec);
if (m/\G field \s* \( \s* $RXstr \s* , \s* $RXstr \s* \)/oxgc) {
if (m/\G field \s* \( \s* $RXstr \s* , \s* $RXstr \s* \)/xgc) {
print " Record-Field: $1, $2\n" if $debug;
my ($field_name, $value) = unquote($1, $2);
$rec->put_field($field_name, $value);
}
elsif (m/\G info \s* \( \s* $RXstr \s* , \s* $RXstr \s* \)/oxgc) {
elsif (m/\G info \s* \( \s* $RXstr \s* , \s* $RXstr \s* \)/xgc) {
print " Record-Info: $1, $2\n" if $debug;
my ($info_name, $value) = unquote($1, $2);
$rec->add_info($info_name, $value);
}
elsif (m/\G alias \s* \( \s* $RXstr \s* \)/oxgc) {
elsif (m/\G alias \s* \( \s* $RXstr \s* \)/xgc) {
print " Record-Alias: $1\n" if $debug;
my ($alias) = unquote($1);
dieContext("Can't create alias '$alias', name in use")
@@ -280,7 +280,7 @@ sub parse_record {
$rec->add_alias($alias);
$dbd->add($rec, $alias);
}
elsif (m/\G \}/oxgc) {
elsif (m/\G \}/xgc) {
print " Record-End:\n" if $debug;
$dbd->add($rec);
popContext("record($record_type, $record_name)");
@@ -298,12 +298,12 @@ sub parse_field {
pushContext("field($field_name, $field_type)");
while(1) {
parseCommon($fld);
if (m/\G (\w+) \s* \( \s* $RXstr \s* \)/oxgc) {
if (m/\G (\w+) \s* \( \s* $RXstr \s* \)/xgc) {
print " Field-Attribute: $1, $2\n" if $debug;
my ($attr, $value) = unquote($1, $2);
$fld->add_attribute($attr, $value);
}
elsif (m/\G \}/oxgc) {
elsif (m/\G \}/xgc) {
print " Field-End:\n" if $debug;
$rtyp->add_field($fld);
popContext("field($field_name, $field_type)");
src/tools/DBD/Recfield.pm
+1 -1
View File
@@ -37,7 +37,7 @@ our %field_attrs = (
base => qr/^(?:DECIMAL|HEX)$/,
size => qr/^\d+$/,
extra => qr/^.*$/,
menu => qr/^$RXident$/o,
menu => qr/^$RXident$/,
prop => qr/^(?:YES|NO)$/
);
src/tools/DBD/Record.pm
+1 -1
View File
@@ -36,7 +36,7 @@ sub identifier {
if ($macrosOk) {
# FIXME - Check name with macro
}
elsif ($id !~ m/^$RXname$/o) {
elsif ($id !~ m/^$RXname$/) {
my @message;
push @message, "A $what should contain only letters, digits and these",
"special characters: _ - : . [ ] < > ;" unless $warned++;
src/tools/EPICS/Readfile.pm
+7 -7
View File
@@ -79,13 +79,13 @@ sub splitPath {
return @path;
}
my $RXstr = qr/ " (?: [^"] | \\" )* "/ox;
my $RXnam = qr/[a-zA-Z0-9_\-:.[\]<>;]+/o;
my $string = qr/ ( $RXnam | $RXstr ) /ox;
my $RXstr = qr/ " (?: [^"] | \\" )* "/x;
my $RXnam = qr/ [a-zA-Z0-9_\-:.[\]<>;]+ /x;
my $string = qr/ ( $RXnam | $RXstr ) /x;
sub unquote {
my ($s) = @_;
$s =~ s/^"(.*)"$/$1/o;
$s =~ s/^"(.*)"$/$1/;
return $s;
}
@@ -147,17 +147,17 @@ sub Readfile {
my @input = split /\n/, $input;
my @output;
foreach (@input) {
if (m/^ \s* include \s+ $string /ox) {
if (m/^ \s* include \s+ $string /x) {
$arg = unquote($1);
print " include $arg\n" if $debug;
push @output, "##! include \"$arg\"";
push @output, Readfile($arg, $macros, $Rpath);
} elsif (m/^ \s* addpath \s+ $string /ox) {
} elsif (m/^ \s* addpath \s+ $string /x) {
$arg = unquote($1);
print " addpath $arg\n" if $debug;
push @output, "##! addpath \"$arg\"";
push @{$Rpath}, splitPath($arg);
} elsif (m/^ \s* path \s+ $string /ox) {
} elsif (m/^ \s* path \s+ $string /x) {
$arg = unquote($1);
print " path $arg\n" if $debug;
push @output, "##! path \"$arg\"";