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 #define uint_t unsigned int
  80 #include <stdint.h>
  81 #include <stdlib.h>
  82 #include <stdio.h>
  83 #include <stdbool.h>
  84 #include <stdarg.h>
  85 #include <util/data_blob.h>
  86
  87 /* header start */
  88 $header
  89 /* header end */
  90
  91 /* ndrheader start */
  92 $ndrheader
  93 /* ndrheader end */
  94
  95 /* extra start */
  96 $extra
  97 /* extra end */
  98
  99 /* ndrparser start */
 100 $ndrparser
 101 /* ndrparser end */
 102
 103 /* main start */
 104 int main(int argc, const char **argv)
 105 {
 106         TALLOC_CTX *mem_ctx = talloc_init(NULL);
 107
 108 $c
 109
 110         talloc_free(mem_ctx);
 111
 112         return 0;
 113 }
 114 /* main end */
 115 \n";
 116
 117         my $main_debug = "# ".join("\n# ", split("\n", $main));
 118
 119         my $test_data_prefix = $ENV{TEST_DATA_PREFIX};
 120         my $outfile;
 121         if (defined($test_data_prefix)) {
 122                 $outfile = "$test_data_prefix/test-$name";
 123         } else {
 124                 $outfile = "./test-$name";
 125         }
 126
 127         my $cflags = $ENV{CFLAGS};
 128         unless (defined($cflags)) {
 129                 $cflags = "";
 130         }
 131
 132         my $ldflags = $ENV{LDFLAGS};
 133         unless (defined($ldflags)) {
 134                 $ldflags = "";
 135         }
 136
 137         my $cc = $ENV{CC};
 138         unless (defined($cc)) {
 139                 $cc = "cc";
 140         }
 141
 142         my $cmd = "$cc $cflags -x c - -o $outfile $flags $ldflags";
 143         $cmd =~ s/\n//g;
 144         open CC, "|$cmd";
 145         print CC $main;
 146         close CC;
 147
 148         ok(-f $outfile, "($name) compile");
 149
 150         my $ret = system($outfile, ()) >> 8;
 151         print "# code:\n#\n$main_debug\n" if ($ret != 0);
 152         print "# cmd: $cmd\n" if ($ret != 0);
 153         print "# return code: $ret\n" if ($ret != 0);
 154
 155         ok($ret == 0, "($name) run");
 156
 157         ok(unlink($outfile), "($name) remove");
 158
 159         }
 160 }
 161
 162 sub test_warnings($$)
 163 {
 164         my ($exp, $code) = @_;
 165
 166         $warnings = "";
 167
 168         $code->();
 169
 170         is($warnings, $exp);
 171 }
 172
 173 sub test_errors($$)
 174 {
 175         my ($exp, $code) = @_;
 176         $errors = "";
 177         $code->();
 178
 179         is($errors, $exp);
 180 }
 181
 182 1;