xref: /freebsd/cddl/contrib/opensolaris/cmd/dtrace/test/cmd/scripts/dstyle.pl (revision 38f0b757fd84d17d0fc24739a7cda160c4516d81)
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
28require 5.8.4;
29
30$PNAME = $0;
31$PNAME =~ s:.*/::;
32$USAGE = "Usage: $PNAME [file ...]\n";
33$errs = 0;
34
35sub err
36{
37	my($msg) = @_;
38
39	print "$file: $lineno: $msg\n";
40	$errs++;
41}
42
43sub 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
221foreach $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
229die $USAGE if (scalar(@files) == 0);
230
231foreach $file (@files) {
232	dstyle($file);
233}
234
235exit($errs != 0);
236