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