source4/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         my $pidl = Parse::Pidl::IDL::parse_string("interface echo { $idl }; ", "<$name>");
  51
  52         ok(defined($pidl), "($name) parse idl");
  53         my $header = Parse::Pidl::Samba4::Header::Parse($pidl);
  54         ok(defined($header), "($name) generate generic header");
  55         my $pndr = Parse::Pidl::NDR::Parse($pidl);
  56         ok(defined($pndr), "($name) generate NDR tree");
  57         my ($ndrheader,$ndrparser) = Parse::Pidl::Samba4::NDR::Parser::Parse($pndr, undef, undef);
  58         ok(defined($ndrparser), "($name) generate NDR parser");
  59         ok(defined($ndrheader), "($name) generate NDR header");
  60
  61 SKIP: {
  62
  63         skip "no samba environment available, skipping compilation", 3
  64                 if (system("pkg-config --exists ndr") != 0);
  65
  66         my $test_data_prefix = $ENV{TEST_DATA_PREFIX};
  67
  68         my $outfile;
  69         if (defined($test_data_prefix)) {
  70                 $outfile = "$test_data_prefix/test-$name";
  71         } else {
  72                 $outfile = "./test-$name";
  73         }
  74
  75         my $flags = `pkg-config --libs --cflags ndr samba-config`;
  76
  77         open CC, "|cc -x c - -o $outfile $flags";
  78         print CC "#define uint_t unsigned int\n";
  79         print CC "#define _GNU_SOURCE\n";
  80         print CC "#include <stdint.h>\n";
  81         print CC "#include <stdlib.h>\n";
  82         print CC "#include <stdio.h>\n";
  83         print CC "#include <stdbool.h>\n";
  84         print CC "#include <stdarg.h>\n";
  85         print CC "#include <core.h>\n";
  86         print CC $header;
  87         print CC $ndrheader;
  88         print CC $extra if ($extra);
  89         print CC $ndrparser;
  90         print CC "int main(int argc, const char **argv)
  91 {
  92         TALLOC_CTX *mem_ctx = talloc_init(NULL);
  93
  94         $c
  95
  96         talloc_free(mem_ctx);
  97
  98         return 0; }\n";
  99         close CC;
 100
 101         ok(-f $outfile, "($name) compile");
 102
 103         my $ret = system($outfile, ()) >> 8;
 104         print "# return code: $ret\n" if ($ret != 0);
 105
 106         ok($ret == 0, "($name) run");
 107
 108         ok(unlink($outfile), "($name) remove");
 109
 110         }
 111 }
 112
 113 sub test_warnings($$)
 114 {
 115         my ($exp, $code) = @_;
 116
 117         $warnings = "";
 118
 119         $code->();
 120
 121         is($warnings, $exp);
 122 }
 123
 124
 125 sub test_errors($$)
 126 {
 127         my ($exp, $code) = @_;
 128         $errors = "";
 129         $code->();
 130
 131         is($errors, $exp);
 132 }
 133
 134 1;