source4/pidl/lib/Parse/Pidl/Test.pm

   1 # Simple system for running tests against pidl
   2 # (C) 2005 Jelmer Vernooij <jelmer@samba.org>
   3 # Published under the GNU General Public License
   4
   5 package Parse::Pidl::Test;
   6
   7 use strict;
   8 use Parse::Pidl::Util;
   9 use Getopt::Long;
  10
  11 my $cc = $ENV{CC};
  12 my @cflags = split / /, $ENV{CFLAGS};
  13 my @ldflags = split / /, $ENV{LDFLAGS};
  14
  15 $cc = "cc" if ($cc eq "");
  16
  17 sub generate_cfile($$$)
  18 {
  19         my ($filename, $fragment, $incfiles) = @_;
  20
  21         unless (open (OUT, ">$filename")) {
  22                 print STDERR "Unable to open $filename\n";
  23                 return -1;
  24         }
  25         print OUT '
  26 /* This file was autogenerated. All changes made will be lost! */
  27 #include "include/includes.h"
  28 ';
  29
  30         foreach (@$incfiles) {
  31                 print OUT "#include \"$_\"\n";
  32         }
  33
  34         print OUT '
  35 int main(int argc, char **argv)
  36 {
  37         TALLOC_CTX *mem_ctx = talloc_init(NULL);
  38         ';
  39         print OUT $fragment;
  40         print OUT "\treturn 0;\n}\n";
  41         close OUT;
  42
  43         return 0;
  44 }
  45
  46 sub generate_idlfile($$)
  47 {
  48         my ($filename,$fragment) = @_;
  49
  50         unless (open(OUT, ">$filename")) {
  51                 print STDERR "Unable to open $filename\n";
  52                 return -1;
  53         }
  54
  55         print OUT '
  56 [uuid("1-2-3-4-5")] interface test_if
  57 {
  58 ';
  59         print OUT $fragment;
  60         print OUT "\n}\n";
  61         close OUT;
  62
  63         return 0;
  64 }
  65
  66 sub compile_idl($$$)
  67 {
  68         my ($filename,$idl_path, $idlargs) = @_;
  69
  70         my @args = @$idlargs;
  71         push (@args, $filename);
  72
  73         unless (system($idl_path, @args) == 0) {
  74                 print STDERR "Error compiling IDL file $filename: $!\n";
  75                 return -1;
  76         }
  77 }
  78
  79 sub compile_cfile($)
  80 {
  81         my ($filename) = @_;
  82
  83         return system($cc, @cflags, '-I.', '-Iinclude', '-c', $filename);
  84 }
  85
  86 sub link_files($$)
  87 {
  88         my ($exe_name,$objs) = @_;
  89
  90         return system($cc, @ldflags, '-Lbin', '-lrpc', '-o', $exe_name, @$objs);
  91 }
  92
  93 sub test_idl($$$$)
  94 {
  95         my ($name,$settings,$idl,$c) = @_;
  96
  97         $| = 1;
  98
  99         print "Running $name... ";
 100
 101         my $outputdir = $settings->{OutputDir};
 102
 103         my $c_filename = $outputdir."/".$name."_test.c";
 104         my $idl_filename = $outputdir."/".$name."_idl.idl";
 105         my $exe_filename = $outputdir."/".$name."_exe";
 106
 107         return -1 if (generate_cfile($c_filename, $c, $settings->{IncludeFiles}) == -1);
 108
 109         return -1 if (generate_idlfile($idl_filename, $idl) == -1);
 110
 111         return -1 if (compile_idl($idl_filename, $settings->{'IDL-Compiler'}, $settings->{'IDL-Arguments'}) == -1);
 112
 113         my @srcs = ($c_filename);
 114         push (@srcs, @{$settings->{'ExtraFiles'}});
 115
 116         foreach (@srcs) {
 117                 next unless /\.c$/;
 118                 return -1 if (compile_cfile($_) == -1);
 119         }
 120
 121         my @objs;
 122         foreach (@srcs) {
 123                 if (/\.c$/) { s/\.c$/\.o/g; }
 124                 push(@objs, $_);
 125         }
 126
 127         return -1 if (link_files($exe_filename, \@objs) == -1);
 128
 129         my $ret = system("./$exe_filename");
 130         if ($ret != 0) {
 131                 $ret = $? >> 8;
 132                 print "failed with return value $ret\n";
 133                 return $ret;
 134         }
 135
 136         unless ($settings->{Keep}) {
 137                 unlink(@srcs, @objs, $exe_filename, $idl_filename);
 138         }
 139
 140         print "Ok\n";
 141
 142         return $ret;
 143 }
 144
 145 sub GetSettings($)
 146 {
 147         my $settings = {
 148                 OutputDir => ".",
 149                 'IDL-Compiler' => "./pidl"
 150         };
 151
 152         my %opts = ();
 153         GetOptions('idl-compiler=s' => \$settings->{'IDL-Compiler'},
 154                 'outputdir=s' => \$settings->{OutputDir},
 155                 'keep' => \$settings->{Keep},
 156                 'help' => sub { ShowHelp(); exit 1; } );
 157
 158         return %$settings;
 159 }
 160
 161 sub ShowHelp()
 162 {
 163         print " --idl-compiler=PATH-TO-PIDL  Override path to IDL compiler\n";
 164         print " --outputdir=OUTPUTDIR        Write temporary files to OUTPUTDIR rather then .\n";
 165         print " --keep                       Keep intermediate files after running test";
 166         print " --help                       Show this help message\n";
 167 }
 168
 169 1;