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