sin/samba-mirror
1
0
Fork 0
mirror of https://github.com/samba-team/samba.git synced 2024-12-23 17:34:34 +03:00
Code

r20547: Add tests for expected errors/warnings.

Browse Source 
(This used to be commit 2d960d4d7b)
This commit is contained in:
Jelmer Vernooij 2007-01-05 14:55:26 +00:00 committed by Gerald (Jerry) Carter
parent 306dc32687
commit 2963c63987
4 changed files with 90 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
source4/pidl/lib/Parse/Pidl.pm
View File

@ -9,7 +9,7 @@ package Parse::Pidl;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(warning error fatal);
@EXPORT_OK = qw(warning error fatal);
use strict;

41
source4/pidl/tests/Util.pm
View File

@ -6,10 +6,28 @@ package Util;
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(test_samba4_ndr);
@EXPORT = qw(test_samba4_ndr test_warnings test_errors);
use strict;
use FindBin qw($RealBin);
use lib "$RealBin/../lib";
use Parse::Pidl;
my $warnings = "";
sub Parse::Pidl::warning($$)
{
my ($e, $l) = @_;
$warnings .= "$e->{FILE}:$e->{LINE}: $l\n";
};
my $errors = "";
sub Parse::Pidl::error($$)
{
my ($e, $l) = @_;
$errors .= "$e->{FILE}:$e->{LINE}: $l\n";
};
use Test::More;
use Parse::Pidl::IDL;
use Parse::Pidl::NDR;
@ -84,4 +102,25 @@ SKIP: {
}
}
sub test_warnings($$)
{
my ($exp, $code) = @_;
$warnings = "";
$code->();
is($warnings, $exp);
}
sub test_errors($$)
{
my ($exp, $code) = @_;
$errors = "";
$code->();
is($errors, $exp);
}
1;

27
source4/pidl/tests/ndr_compat.pl Executable file
View File

@ -0,0 +1,27 @@
#!/usr/bin/perl
# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
# Published under the GNU General Public License
use strict;
use Test::More tests => 3;
use FindBin qw($RealBin);
use lib "$RealBin";
use Util;
use Parse::Pidl;
use Parse::Pidl::IDL;
sub parse_idl($)
{
my $idl = shift;
my $pidl = Parse::Pidl::IDL::parse_string("interface echo { $idl }; ", "nofile");
Parse::Pidl::NDR::Parse($pidl);
}
test_warnings("", sub {parse_idl("void x();"); });
test_warnings("nofile:0: top-level [out] pointer `x' is not a [ref] pointer\n", sub {parse_idl("void x([out,unique] int *x);"); });
test_warnings("nofile:0: pointer_default_top() is a pidl extension and should not be used\n", sub {
my $pidl = Parse::Pidl::IDL::parse_string("[pointer_default_top(unique)] interface echo { void x(); }; ", "nofile");
Parse::Pidl::NDR::Parse($pidl);
});

22
source4/pidl/tests/test_util.pl Executable file
View File

@ -0,0 +1,22 @@
#!/usr/bin/perl
# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
# Published under the GNU General Public License
use strict;
use Test::More tests => 6;
use FindBin qw($RealBin);
use lib "$RealBin/../lib";
use lib "$RealBin";
use Util qw(test_warnings test_errors);
use Parse::Pidl qw(warning error);
test_warnings("", sub {});
test_warnings("x:1: msg\n", sub { warning({FILE => "x", LINE => 1}, "msg"); });
test_warnings("", sub {});
test_errors("", sub {});
test_errors("x:1: msg\n", sub { error({FILE => "x", LINE => 1}, "msg"); });
test_errors("", sub {});