File: test_xsub.pl

package info (click to toggle)
icheck 0.9.7-9
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 2,352 kB
  • sloc: perl: 12,152; makefile: 202; ansic: 100
file content (131 lines) | stat: -rwxr-xr-x 2,548 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
#!/usr/bin/perl

use strict;
use 5.6.0;
use warnings;

use File::Spec;
use POSIX;
use Text::Diff;
use File::Find;
use IO::Handle;
use IPC::Open3;
use IO::File;

my $fail = 0;

sub compare_str
  {
    my $desc = shift;
    my $expect = shift;
    my $got = shift;

    return if $expect eq $got;

    print STDERR "Differences in $desc\n";
    if (length $expect)
      {
        diff \$expect, \$got, {STYLE => 'Unified', OUTPUT => \*STDOUT};
      }
    else
      {
        print STDERR "Expected nothing, got:\n";
        print STDERR "---\n";
        print STDERR $got;
        print STDERR "---\n"
      }
    $fail = 1;
  }

sub compare_int
  {
    my $desc = shift;
    my $expect = shift;
    my $got = shift;

    return if $expect == $got;

    print STDERR "Differences in $desc: expected $expect, got $got\n";
    $fail = 1;
  }

my ($perl_output, $perl_errors, $perl_result) = ("", "", undef);

{
  my ($write, $read, $err) = (new IO::Handle, new IO::Handle, new IO::Handle);
  $ENV{ICHECK_PARSER_XSUB} = 0;
  my @cmd = ('./icheck', @ARGV);
  if ($ENV{TEST_VERBOSE})
    {
      print "ICHECK_PARSER_XSUB=0 " . join(' ', @cmd) . "\n";
    }
  my $pid = open3($write, $read, $err, @cmd);

  close $write;

  $perl_output .= $_ while <$read>;
  close $read;

  $perl_errors .= $_ while <$err>;
  close $err;

  waitpid $pid, 0;
  if (WIFSIGNALED($?))
    {
      die "icheck killed by signal " . WTERMSIG($?) . "\n";
    }

  unless (WIFEXITED($?))
    {
      die "icheck died wierdly (waitpid gave $?)\n";
    }

  $perl_result = WEXITSTATUS($?);
}

if (length $perl_errors)
  {
    print STDERR $perl_errors;
  }

print STDOUT $perl_output;

my ($xsub_output, $xsub_errors, $xsub_result) = ("", "", undef);

{
  my ($write, $read, $err) = (new IO::Handle, new IO::Handle, new IO::Handle);
  $ENV{ICHECK_PARSER_XSUB} = 1;
  my @cmd = ('./icheck', @ARGV);
  if ($ENV{TEST_VERBOSE})
    {
      print "ICHECK_PARSER_XSUB=1 " . join(' ', @cmd) . "\n";
    }
  my $pid = open3($write, $read, $err, @cmd);

  close $write;

  $xsub_output .= $_ while <$read>;
  close $read;

  $xsub_errors .= $_ while <$err>;
  close $err;

  waitpid $pid, 0;
  if (WIFSIGNALED($?))
    {
      die "icheck killed by signal " . WTERMSIG($?) . "\n";
    }

  unless (WIFEXITED($?))
    {
      die "icheck died wierdly (waitpid gave $?)\n";
    }

  $xsub_result = WEXITSTATUS($?);
}

compare_str('output', $perl_errors, $xsub_errors);
compare_str('errors', $perl_errors, $xsub_errors);
compare_int('result', $perl_result, $xsub_result);

exit 1 if $fail;