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 use warnings;
  13
  14 use FindBin qw($RealBin);
  15 use lib "$RealBin/../lib";
  16
  17 use Parse::Pidl::Samba4 qw(is_intree);
  18
  19 use Parse::Pidl;
  20 my $warnings = "";
  21 undef &Parse::Pidl::warning;
  22 *Parse::Pidl::warning = sub {
  23         my ($e, $l) = @_;
  24         if (defined($e)) {
  25                 $warnings .= "$e->{FILE}:$e->{LINE}: $l\n";
  26         } else {
  27                 $warnings .= "$l\n";
  28         }
  29 };
  30
  31 my $errors = "";
  32 undef &Parse::Pidl::error;
  33 *Parse::Pidl::error = sub {
  34         my ($e, $l) = @_;
  35         if (defined($e)) {
  36                 $errors .= "$e->{FILE}:$e->{LINE}: $l\n";
  37         } else {
  38                 $errors .= "$l\n";
  39         }
  40 };
  41
  42 use Test::More;
  43 use Parse::Pidl::IDL;
  44 use Parse::Pidl::NDR;
  45 use Parse::Pidl::Samba4::NDR::Parser;
  46 use Parse::Pidl::Samba4::Header;
  47
  48 # Generate a Samba4 parser for an IDL fragment and run it with a specified
  49 # piece of code to check whether the parser works as expected
  50 sub test_samba4_ndr
  51 {
  52         my ($name,$idl,$c,$extra) = @_;
  53
  54         $extra = "" unless defined($extra);
  55
  56         my $pidl = Parse::Pidl::IDL::parse_string("interface echo { $idl }; ", "<$name>");
  57         ok(defined($pidl), "($name) parse idl");
  58
  59         my $pndr = Parse::Pidl::NDR::Parse($pidl);
  60         ok(defined($pndr), "($name) generate NDR tree");
  61
  62         my $header = Parse::Pidl::Samba4::Header::Parse($pndr);
  63         ok(defined($header), "($name) generate generic header");
  64
  65         my $generator = new Parse::Pidl::Samba4::NDR::Parser();
  66         my ($ndrheader,$ndrparser) = $generator->Parse($pndr, undef, undef);
  67         ok(defined($ndrparser), "($name) generate NDR parser");
  68         ok(defined($ndrheader), "($name) generate NDR header");
  69
  70 SKIP: {
  71
  72         my $flags;
  73         if (system("pkg-config --exists ndr") == 0 and !is_intree()) {
  74                 $flags = `pkg-config --libs --cflags ndr`;
  75         } else {
  76                 skip "no samba environment available, skipping compilation", 3;
  77         }
  78
  79         my $main = "
  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;