source: A2P/a2p/test/a2p-test.pl @ 15

Last change on this file since 15 was 3, checked in by guillaume, 17 years ago
  • AUTHORS: Ajout des différents contributeurs
  • COPYING: Ajout de la licence GPL v3
  • a2p: Préparation des sources pour leur publication sous GPL
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 4.2 KB
Line 
1#! /usr/bin/perl -w
2#
3# Copyright (c) 2004-2007 - Consultas, PKG.fr
4#
5# This file is part of A2P.
6#
7# A2P is free software; you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation; either version 2 of the License, or
10# (at your option) any later version.
11#
12# A2P is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with A2P; if not, write to the Free Software
19# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
20#
21# $Id: a2p-test.pl 3 2007-10-18 16:20:19Z guillaume $
22#
23# Unit tests launcher
24#
25
26use Carp qw(longmess);
27
28$quiet = defined($ENV{DEBUG}) ? $ENV{DEBUG} == 0 : 1 ;
29
30die "Environment A2P_PATH not set\n"
31    unless (defined($ENV{A2P_PATH}));
32
33die "A2P_PATH not set to a valid folder\n"
34    unless ( -d $ENV{A2P_PATH} );
35
36$| = 1 ;
37
38chdir $ENV{A2P_PATH} ;
39$folder = `pwd` ;
40chomp $folder ;
41die "Specified A2P_PATH ($folder) not contains the required 'test' folder\n"
42    unless ( -d $folder .'/test' );
43
44print "PID=$$\nScript=$0\nFolder=$folder\n" unless $quiet ;
45$0 = '__A2P_TEST__' ;
46
47%scripts = () ;
48
49# 1. Scan test folders
50# 1.1. Scan base test folder
51opendir TEST, $folder . '/test'
52    or die "Can't opendir 'test'\n" ;
53
54foreach ( readdir TEST ) {
55    if ( -d $_ and /\w+/ ) {
56        push @test_folders, $_ ;
57    } elsif ( /\.pl$/ and ! m|a2p-test\.pl$| and -x $_ ) {
58        push @test_scripts, $folder . '/test/' . $_  ;
59    }
60}
61close TEST ;
62
63# 1.2. Sort base test scripts
64@test_scripts = sort(@test_scripts) ;
65
66# 1.3. Scan sub test folder
67for $dir (sort(@test_folders)) {
68    @scripts = () ;
69    $clean = "" ;
70    $thisfolder = "$folder/test/$dir" ;
71    opendir TEST, $thisfolder
72        or die "Can't opendir '$thisfolder'\n" ;
73    foreach ( readdir TEST ) {
74        next if /Defaults\.pm$/ ;
75        next unless /\.p[lm]$/ ;
76        $thisfile = $thisfolder . '/' . $_ ;
77        next unless ( ! -d $thisfile and -x $thisfile );
78        if (m|test-init.pl$|) {
79            push @test_scripts , $thisfile ;
80        } elsif (m|test-clean.pl$|) {
81            $clean = $thisfile ;
82        } else {
83            push @scripts, $thisfile ;
84        }
85    }
86    close TEST ;
87    push @test_scripts, sort(@scripts);
88    push @test_scripts, $clean if $clean ;
89}
90
91print "Found ".(@test_scripts)." scripts to run: " ;
92print join( ", ", map { m|([^/]+)$| } @test_scripts ), "\n" unless ($quiet) ;
93
94$stdout = "" ;
95
96sub head {
97    return "=" x 80 , "\n", "=== UNIT TEST @_: ",
98        $script =~ m|^$folder/(test/.*)$|, "\n",
99        "=" x 80 , "\n",
100}
101
102my @checks_re = (
103    "^untie attempted while"
104);
105@checks_re = map { qr/$_/ } @checks_re ;
106
107sub known_warns {
108    my $ref = shift ;
109    my @warn = () ;
110    foreach my $line (@{$ref}) {
111        push @warn, $line if ( grep { $line =~ $_ } @checks_re );
112    }
113    $quiet = 0 if @warn ;
114    return @warn ;
115}
116
117@warns = () ;
118$count = 0 ;
119
120$SIG{__WARN__} = $SIG{__DIE__} =sub {
121    $quiet = 0 ;
122    my $mesg = &longmesg(@_) ;
123    push @{$warns[$count]}, $mesg ;
124    print "$mesg\n" ;
125    } ;
126
127# 2. Do tests
128@scripts = () ;
129@failed = () ;
130foreach $script (@test_scripts) {
131    $count ++ ;
132    $scripts[$count] = $script ;
133    $quiet = defined($ENV{DEBUG}) ? $ENV{DEBUG} == 0 : 1 ;
134    @stdout = qx( perl -W $script 2>&1 ) ;
135    push @{$warns[$count]}, &known_warns(\@stdout) ;
136    if ($?) {
137        $quiet = 0 ;
138        print "unit test #$count failed\n" ;
139        my @KOs = map { /(\d+)/ } grep { /^not ok \d+$/ } @stdout ;
140        $" = ', ' ;
141        push @{$warns[$count]}, "KO tests: @KOs" if @KOs ;
142        push @failed, $count ;
143    }
144
145    $" = "\n" ;
146    print $quiet ? "." : ( &head($count), "@stdout\n" ) ;
147}
148
149print "\nGood: ".($count-@failed)."/$count\nKO: ".@failed."\n" ;
150
151$" = "\n" ;
152map {
153    print "Failed: $scripts[$_]\n" ;
154    print "@{$warns[$_]}\n" if (ref($warns[$_]) =~ /^ARRAY/ and @{$warns[$_]}) ;
155    $warns[$_] = 0 ;
156    } @failed ;
157@warns = grep { defined($_) and ref($_) =~ /^ARRAY/ and @{$_} } @warns ;
158print "Other warnings:\n" if (@warns);
159map { print "@{$_}" } @warns ;
160
161exit(0);
Note: See TracBrowser for help on using the repository browser.