t/002goodperl.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 #                 Jacob Steenhagen <jake@bugzilla.org>
  22 #                 David D. Kilzer <ddkilzer@theracingworld.com>
  23
  24
  25 #################
  26 #Bugzilla Test 2#
  27 ####GoodPerl#####
  28
  29 use strict;
  30
  31 use lib 't';
  32
  33 use Support::Files;
  34
  35 use Test::More tests => (scalar(@Support::Files::testitems) * 3);
  36
  37 my @testitems = @Support::Files::testitems; # get the files to test.
  38
  39 foreach my $file (@testitems) {
  40     $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
  41     next if (!$file); # skip null entries
  42     if (! open (FILE, $file)) {
  43         ok(0,"could not open $file --WARNING");
  44     }
  45     my $file_line1 = <FILE>;
  46     close (FILE);
  47
  48     $file =~ m/.*\.(.*)/;
  49     my $ext = $1;
  50
  51     if ($file_line1 !~ m/^#\!/) {
  52         ok(1,"$file does not have a shebang");
  53     } else {
  54         my $flags;
  55         if (!defined $ext || $ext eq "pl") {
  56             # standalone programs aren't taint checked yet
  57             $flags = "w";
  58         } elsif ($ext eq "pm") {
  59             ok(0, "$file is a module, but has a shebang");
  60             next;
  61         } elsif ($ext eq "cgi") {
  62             # cgi files must be taint checked
  63             $flags = "wT";
  64         } else {
  65             ok(0, "$file has shebang but unknown extension");
  66             next;
  67         }
  68
  69         if ($file_line1 =~ m#^\#\!/usr/bin/perl\s#) {
  70             if ($file_line1 =~ m#\s-$flags#) {
  71                 ok(1,"$file uses standard perl location and -$flags");
  72             } else {
  73                 ok(0,"$file is MISSING -$flags --WARNING");
  74             }
  75         } else {
  76             ok(0,"$file uses non-standard perl location");
  77         }
  78     }
  79 }
  80
  81 foreach my $file (@testitems) {
  82     my $found_use_strict = 0;
  83     $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
  84     next if (!$file); # skip null entries
  85     if (! open (FILE, $file)) {
  86         ok(0,"could not open $file --WARNING");
  87         next;
  88     }
  89     while (my $file_line = <FILE>) {
  90         if ($file_line =~ m/^\s*use strict/) {
  91             $found_use_strict = 1;
  92             last;
  93         }
  94     }
  95     close (FILE);
  96     if ($found_use_strict) {
  97         ok(1,"$file uses strict");
  98     } else {
  99         ok(0,"$file DOES NOT use strict --WARNING");
 100     }
 101 }
 102
 103 # Check to see that all error messages use tags (for l10n reasons.)
 104 foreach my $file (@testitems) {
 105     $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
 106     next if (!$file); # skip null entries
 107     if (! open (FILE, $file)) {
 108         ok(0,"could not open $file --WARNING");
 109         next;
 110     }
 111     my $lineno = 0;
 112     my $error = 0;
 113
 114     while (!$error && (my $file_line = <FILE>)) {
 115         $lineno++;
 116         if ($file_line =~ /Throw.*Error\("(.*?)"/) {
 117             if ($1 =~ /\s/) {
 118                 ok(0,"$file has a Throw*Error call on line $lineno which doesn't use a tag --ERROR");
 119                 $error = 1;
 120             }
 121         }
 122     }
 123
 124     ok(1,"$file uses Throw*Error calls correctly") if !$error;
 125
 126     close(FILE);
 127 }
 128
 129 exit 0;