pidl/tests/Util.pm

   1 # Some simple utility functions for pidl tests
   2 # Copyright (C) 2005-2006 Jelmer Vernooij
   3 # Published under the GNU General Public License
   4
   5 package Util;
   6
   7 require Exporter;
   8 @ISA = qw(Exporter);
   9 @EXPORT = qw(test_samba4_ndr test_warnings test_errors);
  10
  11 use strict;
  12
  13 use FindBin qw($RealBin);
  14 use lib "$RealBin/../lib";
  15
  16 use Parse::Pidl::Samba4 qw(is_intree);
  17
  18 use Parse::Pidl;
  19 my $warnings = "";
  20 undef &Parse::Pidl::warning;
  21 *Parse::Pidl::warning = sub {
  22         my ($e, $l) = @_;
  23         if (defined($e)) {
  24                 $warnings .= "$e->{FILE}:$e->{LINE}: $l\n";
  25         } else {
  26                 $warnings .= "$l\n";
  27         }
  28 };
  29
  30 my $errors = "";
  31 undef &Parse::Pidl::error;
  32 *Parse::Pidl::error = sub {
  33         my ($e, $l) = @_;
  34         if (defined($e)) {
  35                 $errors .= "$e->{FILE}:$e->{LINE}: $l\n";
  36         } else {
  37                 $errors .= "$l\n";
  38         }
  39 };
  40
  41 use Test::More;
  42 use Parse::Pidl::IDL;
  43 use Parse::Pidl::NDR;
  44 use Parse::Pidl::Samba4::NDR::Parser;
  45 use Parse::Pidl::Samba4::Header;
  46
  47 # Generate a Samba4 parser for an IDL fragment and run it with a specified
  48 # piece of code to check whether the parser works as expected
  49 sub test_samba4_ndr
  50 {
  51         my ($name,$idl,$c,$extra) = @_;
  52
  53         $extra = "" unless defined($extra);
  54
  55         my $pidl = Parse::Pidl::IDL::parse_string("interface echo { $idl }; ", "<$name>");
  56         ok(defined($pidl), "($name) parse idl");
  57
  58         my $pndr = Parse::Pidl::NDR::Parse($pidl);
  59         ok(defined($pndr), "($name) generate NDR tree");
  60
  61         my $header = Parse::Pidl::Samba4::Header::Parse($pndr);
  62         ok(defined($header), "($name) generate generic header");
  63
  64         my $generator = new Parse::Pidl::Samba4::NDR::Parser();
  65         my ($ndrheader,$ndrparser) = $generator->Parse($pndr, undef, undef);
  66         ok(defined($ndrparser), "($name) generate NDR parser");
  67         ok(defined($ndrheader), "($name) generate NDR header");
  68
  69 SKIP: {
  70
  71         my $flags;
  72         if (system("pkg-config --exists ndr") == 0 and !is_intree()) {
  73                 $flags = `pkg-config --libs --cflags ndr`;
  74         } else {
  75                 skip "no samba environment available, skipping compilation", 3;
  76         }
  77
  78         my $main = "
  79 #include <stdint.h>
  80 #include <stdlib.h>
  81 #include <stdio.h>
  82 #include <stdbool.h>
  83 #include <stdarg.h>
  84 #include <util/data_blob.h>
  85
  86 /* header start */
  87 $header
  88 /* header end */
  89
  90 /* ndrheader start */
  91 $ndrheader
  92 /* ndrheader end */
  93
  94 /* extra start */
  95 $extra
  96 /* extra end */
  97
  98 /* ndrparser start */
  99 $ndrparser
 100 /* ndrparser end */
 101
 102 /* main start */
 103 int main(int argc, const char **argv)
 104 {
 105         TALLOC_CTX *mem_ctx = talloc_init(NULL);
 106
 107 $c
 108
 109         talloc_free(mem_ctx);
 110
 111         return 0;
 112 }
 113 /* main end */
 114 \n";
 115
 116         my $main_debug = "# ".join("\n# ", split("\n", $main));
 117
 118         my $test_data_prefix = $ENV{TEST_DATA_PREFIX};
 119         my $outfile;
 120         if (defined($test_data_prefix)) {
 121                 $outfile = "$test_data_prefix/test-$name";
 122         } else {
 123                 $outfile = "./test-$name";
 124         }
 125
 126         my $cflags = $ENV{CFLAGS};
 127         unless (defined($cflags)) {
 128                 $cflags = "";
 129         }
 130
 131         my $ldflags = $ENV{LDFLAGS};
 132         unless (defined($ldflags)) {
 133                 $ldflags = "";
 134         }
 135
 136         my $cc = $ENV{CC};
 137         unless (defined($cc)) {
 138                 $cc = "cc";
 139         }
 140
 141         my $cmd = "$cc $cflags -x c - -o $outfile $flags $ldflags";
 142         $cmd =~ s/\n//g;
 143         open CC, "|$cmd";
 144         print CC $main;
 145         close CC;
 146
 147         ok(-f $outfile, "($name) compile");
 148
 149         my $ret = system($outfile, ()) >> 8;
 150         print "# code:\n#\n$main_debug\n" if ($ret != 0);
 151         print "# cmd: $cmd\n" if ($ret != 0);
 152         print "# return code: $ret\n" if ($ret != 0);
 153
 154         ok($ret == 0, "($name) run");
 155
 156         ok(unlink($outfile), "($name) remove");
 157
 158         }
 159 }
 160
 161 sub test_warnings($$)
 162 {
 163         my ($exp, $code) = @_;
 164
 165         $warnings = "";
 166
 167         $code->();
 168
 169         is($warnings, $exp);
 170 }
 171
 172 sub test_errors($$)
 173 {
 174         my ($exp, $code) = @_;
 175         $errors = "";
 176         $code->();
 177
 178         is($errors, $exp);
 179 }
 180
 181 1;