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
  29 use lib 't';
  30
  31 use Support::Files;
  32
  33 use Test::More tests => scalar(@Support::Files::testitems);
  34
  35 # Need this to get the available driver information
  36 #use DBI;
  37 #my @DBI_drivers = DBI->available_drivers;
  38
  39 # Bugzilla requires Perl 5.8.0 now.  Checksetup will tell you this if you run it, but
  40 # it tests it in a polite/passive way that won't make it fail at compile time.  We'll
  41 # slip in a compile-time failure if it's missing here so a tinderbox on < 5.8 won't
  42 # pass and mistakenly let people think Bugzilla works on any perl below 5.8.
  43 require 5.008;
  44
  45 # Capture the TESTOUT from Test::More or Test::Builder for printing errors.
  46 # This will handle verbosity for us automatically.
  47 my $fh;
  48 {
  49     local $^W = 0;  # Don't complain about non-existent filehandles
  50     if (-e \*Test::More::TESTOUT) {
  51         $fh = \*Test::More::TESTOUT;
  52     } elsif (-e \*Test::Builder::TESTOUT) {
  53         $fh = \*Test::Builder::TESTOUT;
  54     } else {
  55         $fh = \*STDOUT;
  56     }
  57 }
  58
  59 my @testitems = @Support::Files::testitems;
  60 my $perlapp = "\"$^X\"";
  61
  62 # Test the scripts by compiling them
  63
  64 foreach my $file (@testitems) {
  65     $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
  66     next if !$file;    # skip null entries
  67
  68     open (FILE,$file);
  69     my $bang = <FILE>;
  70     close (FILE);
  71     my $T = "";
  72     $T = "T" if $bang =~ m/#!\S*perl\s+-.*T/;
  73
  74     if (-l $file) {
  75         ok(1, "$file is a symlink");
  76     } else {
  77         local $TODO;
  78         $TODO = 'schema updates are not required to be strict now' if $file =~ m{^sql/Pg-upgrade2};
  79
  80         my $command = "$perlapp -c$T -I modules/fallback -I modules/override $file 2>&1";
  81         my $loginfo=`$command`;
  82
  83         if ($loginfo =~ /syntax ok$/im) {
  84             if ($loginfo ne "$file syntax OK\n") {
  85                 ok(0,$file." --WARNING");
  86                 print $fh $loginfo;
  87             } else {
  88                 ok(1,$file);
  89             }
  90         } else {
  91             ok(0,$file." --ERROR");
  92             print $fh $loginfo;
  93         }
  94     }
  95 }
  96
  97 exit 0;