cddl/contrib/opensolaris/cmd/dtrace/test/cmd/scripts/dstyle.pl

   1 #!/usr/local/bin/perl
   2 #
   3 # CDDL HEADER START
   4 #
   5 # The contents of this file are subject to the terms of the
   6 # Common Development and Distribution License (the "License").
   7 # You may not use this file except in compliance with the License.
   8 #
   9 # You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
  10 # or http://www.opensolaris.org/os/licensing.
  11 # See the License for the specific language governing permissions
  12 # and limitations under the License.
  13 #
  14 # When distributing Covered Code, include this CDDL HEADER in each
  15 # file and include the License file at usr/src/OPENSOLARIS.LICENSE.
  16 # If applicable, add the following below this CDDL HEADER, with the
  17 # fields enclosed by brackets "[]" replaced with your own identifying
  18 # information: Portions Copyright [yyyy] [name of copyright owner]
  19 #
  20 # CDDL HEADER END
  21 #
  22
  23 #
  24 # Copyright 2006 Sun Microsystems, Inc.  All rights reserved.
  25 # Use is subject to license terms.
  26 #
  27 #pragma ident   "%Z%%M% %I%     %E% SMI"
  28
  29 require 5.6.1;
  30
  31 $PNAME = $0;
  32 $PNAME =~ s:.*/::;
  33 $USAGE = "Usage: $PNAME [file ...]\n";
  34 $errs = 0;
  35
  36 sub err
  37 {
  38         my($msg) = @_;
  39
  40         print "$file: $lineno: $msg\n";
  41         $errs++;
  42 }
  43
  44 sub dstyle
  45 {
  46         open(FILE, "$file");
  47         $lineno = 0;
  48         $inclause = 0;
  49         $skipnext = 0;
  50
  51         while (<FILE>) {
  52                 $lineno++;
  53
  54                 chop;
  55
  56                 if ($skipnext) {
  57                         $skipnext = 0;
  58                         next;
  59                 }
  60
  61                 #
  62                 # Amazingly, some ident strings are longer than 80 characters!
  63                 #
  64                 if (/^#pragma ident/) {
  65                         next;
  66                 }
  67
  68                 #
  69                 # The algorithm to calculate line length from cstyle.
  70                 #
  71                 $line = $_;
  72                 if ($line =~ tr/\t/\t/ * 7 + length($line) > 80) {
  73                         # yes, there is a chance.
  74                         # replace tabs with spaces and check again.
  75                         $eline = $line;
  76                         1 while $eline =~
  77                             s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
  78
  79                         if (length($eline) > 80) {
  80                                 err "line > 80 characters";
  81                         }
  82                 }
  83
  84                 if (/\/\*DSTYLED\*\//) {
  85                         $skipnext = 1;
  86                         next;
  87                 }
  88
  89                 if (/^#pragma/) {
  90                         next;
  91                 }
  92
  93                 if (/^#include/) {
  94                         next;
  95                 }
  96
  97                 #
  98                 # Before we do any more analysis, we want to prune out any
  99                 # quoted strings.  This is a bit tricky because we need
 100                 # to be careful of backslashed quotes within quoted strings.
 101                 # I'm sure there is a very crafty way to do this with a
 102                 # single regular expression, but that will have to wait for
 103                 # somone with better regex juju that I; we do this by first
 104                 # eliminating the backslashed quotes, and then eliminating
 105                 # whatever quoted strings are left.  Note that we eliminate
 106                 # the string by replacing it with "quotedstr"; this is to
 107                 # allow lines to end with a quoted string.  (If we simply
 108                 # eliminated the quoted string, dstyle might complain about
 109                 # the line ending in a space or tab.)
 110                 #
 111                 s/\\\"//g;
 112                 s/\"[^\"]*\"/quotedstr/g;
 113
 114                 if (/[ \t]$/) {
 115                         err "space or tab at end of line";
 116                 }
 117
 118                 if (/^[\t]+[ ]+[\t]+/) {
 119                         err "spaces between tabs";
 120                 }
 121
 122                 if (/^[\t]* \*/) {
 123                         next;
 124                 }
 125
 126                 if (/^        /) {
 127                         err "indented by spaces not tabs";
 128                 }
 129
 130                 if (/^{}$/) {
 131                         next;
 132                 }
 133
 134                 if (!/^enum/ && !/^\t*struct/ && !/^\t*union/ && !/^typedef/ &&
 135                     !/^translator/ && !/^provider/) {
 136                         if (/[\w\s]+{/) {
 137                                 err "left brace not on its own line";
 138                         }
 139
 140                         if (/{[\w\s]+/) {
 141                                 err "left brace not on its own line";
 142                         }
 143                 }
 144
 145                 if (!/;$/) {
 146                         if (/[\w\s]+}/) {
 147                                 err "right brace not on its own line";
 148                         }
 149
 150                         if (/}[\w\s]+/) {
 151                                 err "right brace not on its own line";
 152                         }
 153                 }
 154
 155                 if (/^}/) {
 156                         $inclause = 0;
 157                 }
 158
 159                 if (!$inclause && /^[\w ]+\//) {
 160                         err "predicate not at beginning of line";
 161                 }
 162
 163                 if (!$inclause && /^\/[ \t]+\w/) {
 164                         err "space between '/' and expression in predicate";
 165                 }
 166
 167                 if (!$inclause && /\w[ \t]+\/$/) {
 168                         err "space between expression and '/' in predicate";
 169                 }
 170
 171                 if (!$inclause && /\s,/) {
 172                         err "space before comma in probe description";
 173                 }
 174
 175                 if (!$inclause && /\w,[\w\s]/ && !/;$/) {
 176                         if (!/extern/ && !/\(/ && !/inline/) {
 177                                 err "multiple probe descriptions on same line";
 178                         }
 179                 }
 180
 181                 if ($inclause && /sizeof\(/) {
 182                         err "missing space after sizeof";
 183                 }
 184
 185                 if ($inclause && /^[\w ]/) {
 186                         err "line doesn't begin with a tab";
 187                 }
 188
 189                 if ($inclause && /,[\w]/) {
 190                         err "comma without trailing space";
 191                 }
 192
 193                 if (/\w&&/ || /&&\w/ || /\w\|\|/ || /\|\|\w/) {
 194                         err "logical operator not set off with spaces";
 195                 }
 196
 197                 #
 198                 # We want to catch "i<0" variants, but we don't want to
 199                 # erroneously flag translators.
 200                 #
 201                 if (!/\w<\w+>\(/) {
 202                         if (/\w>/ || / >\w/ || /\w</ || /<\w/) {
 203                                 err "comparison operator not set " .
 204                                     "off with spaces";
 205                         }
 206                 }
 207
 208                 if (/\w==/ || /==\w/ || /\w<=/ || />=\w/ || /\w!=/ || /!=\w/) {
 209                         err "comparison operator not set off with spaces";
 210                 }
 211
 212                 if (/\w=/ || /=\w/) {
 213                         err "assignment operator not set off with spaces";
 214                 }
 215
 216                 if (/^{/) {
 217                         $inclause = 1;
 218                 }
 219         }
 220 }
 221
 222 foreach $arg (@ARGV) {
 223         if (-f $arg) {
 224                 push(@files, $arg);
 225         } else {
 226                 die "$PNAME: $arg is not a valid file\n";
 227         }
 228 }
 229
 230 die $USAGE if (scalar(@files) == 0);
 231
 232 foreach $file (@files) {
 233         dstyle($file);
 234 }
 235
 236 exit($errs != 0);