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