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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
# Some simple utility functions for pidl tests
# Copyright (C) 2005-2006 Jelmer Vernooij
# Published under the GNU General Public License
package Util;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(test_samba4_ndr test_warnings test_errors);
use strict;
use FindBin qw($RealBin);
use lib "$RealBin/../lib";
use Parse::Pidl;
my $warnings = "";
undef &Parse::Pidl::warning;
*Parse::Pidl::warning = sub {
my ($e, $l) = @_;
$warnings .= "$e->{FILE}:$e->{LINE}: $l\n";
};
my $errors = "";
undef &Parse::Pidl::error;
*Parse::Pidl::error = sub {
my ($e, $l) = @_;
$errors .= "$e->{FILE}:$e->{LINE}: $l\n";
};
use Test::More;
use Parse::Pidl::IDL;
use Parse::Pidl::NDR;
use Parse::Pidl::Samba4::NDR::Parser;
use Parse::Pidl::Samba4::Header;
# Generate a Samba4 parser for an IDL fragment and run it with a specified
# piece of code to check whether the parser works as expected
sub test_samba4_ndr
{
my ($name,$idl,$c,$extra) = @_;
my $pidl = Parse::Pidl::IDL::parse_string("interface echo { $idl }; ", "<$name>");
ok(defined($pidl), "($name) parse idl");
my $header = Parse::Pidl::Samba4::Header::Parse($pidl);
ok(defined($header), "($name) generate generic header");
my $pndr = Parse::Pidl::NDR::Parse($pidl);
ok(defined($pndr), "($name) generate NDR tree");
my ($ndrheader,$ndrparser) = Parse::Pidl::Samba4::NDR::Parser::Parse($pndr, undef, undef);
ok(defined($ndrparser), "($name) generate NDR parser");
ok(defined($ndrheader), "($name) generate NDR header");
SKIP: {
skip "no samba environment available, skipping compilation", 3
if (system("pkg-config --exists ndr") != 0);
my $test_data_prefix = $ENV{TEST_DATA_PREFIX};
my $outfile;
if (defined($test_data_prefix)) {
$outfile = "$test_data_prefix/test-$name";
} else {
$outfile = "./test-$name";
}
my $flags = `pkg-config --libs --cflags ndr samba-config`;
open CC, "|cc -x c - -o $outfile $flags";
print CC "#define uint_t unsigned int\n";
print CC "#define _GNU_SOURCE\n";
print CC "#include <stdint.h>\n";
print CC "#include <stdlib.h>\n";
print CC "#include <stdio.h>\n";
print CC "#include <stdbool.h>\n";
print CC "#include <stdarg.h>\n";
print CC "#include <core.h>\n";
print CC $header;
print CC $ndrheader;
print CC $extra if ($extra);
print CC $ndrparser;
print CC "int main(int argc, const char **argv)
{
TALLOC_CTX *mem_ctx = talloc_init(NULL);
$c
talloc_free(mem_ctx);
return 0; }\n";
close CC;
ok(-f $outfile, "($name) compile");
my $ret = system($outfile, ()) >> 8;
print "# return code: $ret\n" if ($ret != 0);
ok($ret == 0, "($name) run");
ok(unlink($outfile), "($name) remove");
}
}
sub test_warnings($$)
{
my ($exp, $code) = @_;
$warnings = "";
$code->();
is($warnings, $exp);
}
sub test_errors($$)
{
my ($exp, $code) = @_;
$errors = "";
$code->();
is($errors, $exp);
}
1;
|
