t/001compile.t

   1 # -*- Mode: perl; indent-tabs-mode: nil -*-
   2 #
   3 # The contents of this file are subject to the Mozilla Public
   4 # License Version 1.1 (the "License"); you may not use this file
   5 # except in compliance with the License. You may obtain a copy of
   6 # the License at http://www.mozilla.org/MPL/
   7 #
   8 # Software distributed under the License is distributed on an "AS
   9 # IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
  10 # implied. See the License for the specific language governing
  11 # rights and limitations under the License.
  12 #
  13 # The Original Code are the Bugzilla Tests.
  14 #
  15 # The Initial Developer of the Original Code is Zach Lipton
  16 # Portions created by Zach Lipton are
  17 # Copyright (C) 2001 Zach Lipton.  All
  18 # Rights Reserved.
  19 #
  20 # Contributor(s): Zach Lipton <zach@zachlipton.com>
  21
  22
  23 #################
  24 #Bugzilla Test 1#
  25 ###Compilation###
  26
  27 use strict;
  28 use threads;
  29
  30 use lib 't';
  31
  32 use Support::Files;
  33 use Sys::CPU;
  34 use Thread::Pool::Simple;
  35
  36 use Test::More tests => scalar(@Support::Files::testitems);
  37
  38 # Need this to get the available driver information
  39 #use DBI;
  40 #my @DBI_drivers = DBI->available_drivers;
  41
  42 # Bugzilla requires Perl 5.8.0 now.  Checksetup will tell you this if you run it, but
  43 # it tests it in a polite/passive way that won't make it fail at compile time.  We'll
  44 # slip in a compile-time failure if it's missing here so a tinderbox on < 5.8 won't
  45 # pass and mistakenly let people think Bugzilla works on any perl below 5.8.
  46 require 5.008;
  47
  48 # Capture the TESTOUT from Test::More or Test::Builder for printing errors.
  49 # This will handle verbosity for us automatically.
  50 my $fh;
  51 {
  52     local $^W = 0;  # Don't complain about non-existent filehandles
  53     if (-e \*Test::More::TESTOUT) {
  54         $fh = \*Test::More::TESTOUT;
  55     } elsif (-e \*Test::Builder::TESTOUT) {
  56         $fh = \*Test::Builder::TESTOUT;
  57     } else {
  58         $fh = \*STDOUT;
  59     }
  60 }
  61
  62 my @testitems = @Support::Files::testitems;
  63 my $perlapp = "\"$^X\"";
  64
  65 # Test the scripts by compiling them
  66
  67 my @to_compile;
  68
  69 sub test_compile_file {
  70   my ($file, $T) = @{ $_[0] };
  71
  72
  73   my $command = "$perlapp -w -c$T -Imodules/fallback -Imodules/override -It -MSupport::CanonialGlobals $file 2>&1";
  74   my $loginfo=`$command`;
  75
  76   if ($loginfo =~ /syntax ok$/im) {
  77     if ($loginfo ne "$file syntax OK\n") {
  78       ok(0,$file." --WARNING");
  79       print $fh $loginfo;
  80     } else {
  81       ok(1,$file);
  82     }
  83   } else {
  84     ok(0,$file." --ERROR");
  85     print $fh $loginfo;
  86   }
  87 }
  88
  89 foreach my $file (@testitems) {
  90   $file =~ s/\s.*$//;           # nuke everything after the first space (#comment)
  91   next if !$file;               # skip null entries
  92
  93   open (FILE,$file);
  94   my $bang = <FILE>;
  95   close (FILE);
  96   my $T = "";
  97   $T = "T" if $bang =~ m/#!\S*perl\s+-.*T/;
  98
  99   if (-l $file) {
 100     ok(1, "$file is a symlink");
 101   } else {
 102     push @to_compile, [ $file, $T ];
 103   }
 104 }
 105
 106 my $pool = Thread::Pool::Simple->new(
 107   min    => 2,
 108   max    => Sys::CPU::cpu_count() + 1,
 109   do     => [ \&test_compile_file ],
 110   passid => 0,
 111 );
 112
 113 $pool->add($_) for @to_compile;
 114
 115 $pool->join;
 116
 117 exit 0;