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
127
128
129
130
131
132
133
134
|
# 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) = @_;
if (defined($e)) {
$warnings .= "$e->{FILE}:$e->{LINE}: $l\n";
} else {
$warnings .= "$l\n";
}
};
my $errors = "";
undef &Parse::Pidl::error;
*Parse::Pidl::error = sub {
my ($e, $l) = @_;
if (defined($e)) {
$errors .= "$e->{FILE}:$e->{LINE}: $l\n";
} else {
$errors .= "$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;
|
