Hide undefined sub from tests (#1160)

This commit is contained in:
Xavier Guimard 2017-02-10 16:46:19 +00:00
parent 57330851f8
commit 4b8db05b88
2 changed files with 54 additions and 11 deletions

View File

@ -30,7 +30,12 @@ sub types {
"\x54\x55\x55\x55\x15\x55\x55\x55\x55\x55\x51\x55\x55\x55\x55\x55\x55";
}
eval "$s $val";
return $@ ? ( 1, "__badExpression__: $@" ) : 1;
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
}
},
'catAndAppList' => {
@ -867,7 +872,12 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0-
"\x54\x55\x55\x55\x15\x55\x55\x55\x55\x55\x51\x55\x55\x55\x55\x55\x55";
}
eval $s;
return $@ ? ( 1, "__badExpression__: $@" ) : 1;
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
}
},
'type' => 'keyTextContainer'
@ -931,7 +941,12 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0-
"\x54\x55\x55\x55\x15\x55\x55\x55\x55\x55\x51\x55\x55\x55\x55\x55\x55";
}
eval "$s $val";
return $@ ? ( 1, "__badExpression__: $@" ) : 1;
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
},
'test' => sub {
1;
@ -949,7 +964,12 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0-
"\x54\x55\x55\x55\x15\x55\x55\x55\x55\x55\x51\x55\x55\x55\x55\x55\x55";
}
eval "$s $val";
return $@ ? ( 1, "__badExpression__: $@" ) : 1;
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
},
'type' => 'keyTextContainer'
},
@ -1256,7 +1276,12 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0-
"\x54\x55\x55\x55\x15\x55\x55\x55\x55\x55\x51\x55\x55\x55\x55\x55\x55";
}
eval $s;
return $@ ? ( 1, "__badExpression__: $@" ) : 1;
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
}
},
'type' => 'ruleContainer'
@ -1285,7 +1310,12 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0-
"\x54\x55\x55\x55\x15\x55\x55\x55\x55\x55\x51\x55\x55\x55\x55\x55\x55";
}
eval "$s $val";
return $@ ? ( 1, "__badExpression__: $@" ) : 1;
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
},
'type' => 'keyTextContainer'
},
@ -1904,7 +1934,12 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0-
"\x54\x55\x55\x55\x15\x55\x55\x55\x55\x55\x51\x55\x55\x55\x55\x55\x55";
}
eval "$s $val";
return $@ ? ( 1, "__badExpression__: $@" ) : 1;
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
},
'msgFail' => '__badValue__',
'test' => qr/^\w+$/,

View File

@ -12,10 +12,12 @@ use Regexp::Common qw/URI/;
my $perlExpr = sub {
my ( $val, $conf ) = @_;
my $s = '';
my $s = '';
no warnings( 'redefine', 'uninitialized' );
eval "$s $val";
return $@ ? ( 1, "__badExpression__: $@" ) : (1);
my $err = join( '',
grep { $_ =~ /Undefined subroutine/ ? () : $_ } split( /\n/, $@ ) );
return $err ? ( 1, "__badExpression__: $err" ) : (1);
};
my $url = $RE{URI}{HTTP}{ -scheme => "https?" };
@ -1043,7 +1045,10 @@ sub attributes {
$s =~ s/\b(accept|deny|unprotect|skip)\b/1/g;
no warnings( 'redefine', 'uninitialized' );
eval $s;
return $@ ? ( 1, "__badExpression__: $@" ) : (1);
my $err = join( '',
grep { $_ =~ /Undefined subroutine/ ? () : $_ }
split( /\n/, $@ ) );
return $err ? ( 1, "__badExpression__: $err" ) : (1);
},
msgFail => '__badExpression__',
},
@ -1067,7 +1072,10 @@ sub attributes {
my $s = $val;
no warnings( 'redefine', 'uninitialized' );
eval $s;
return $@ ? ( 1, "__badExpression__: $@" ) : (1);
my $err = join( '',
grep { $_ =~ /Undefined subroutine/ ? () : $_ }
split( /\n/, $@ ) );
return $err ? ( 1, "__badExpression__: $err" ) : (1);
}
},
documentation => 'Virtualhost headers',