Blame build-aux/check-symsorting.pl

Packit a07778
#!/usr/bin/env perl
Packit a07778
Packit a07778
# Copyright (C) 2012-2013 Red Hat, Inc.
Packit a07778
#
Packit a07778
# This library is free software; you can redistribute it and/or
Packit a07778
# modify it under the terms of the GNU Lesser General Public
Packit a07778
# License as published by the Free Software Foundation; either
Packit a07778
# version 2.1 of the License, or (at your option) any later version.
Packit a07778
#
Packit a07778
# This library is distributed in the hope that it will be useful,
Packit a07778
# but WITHOUT ANY WARRANTY; without even the implied warranty of
Packit a07778
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Packit a07778
# Lesser General Public License for more details.
Packit a07778
#
Packit a07778
# You should have received a copy of the GNU Lesser General Public
Packit a07778
# License along with this library.  If not, see
Packit a07778
# <http://www.gnu.org/licenses/>.
Packit a07778
Packit a07778
use strict;
Packit a07778
use warnings;
Packit a07778
Packit a07778
die "syntax: $0 SYMFILE..." unless int(@ARGV) >= 1;
Packit a07778
Packit a07778
my $ret = 0;
Packit a07778
my $incomment = 0;
Packit a07778
my $name;
Packit a07778
foreach my $symfile (@ARGV) {
Packit a07778
    open SYMFILE, $symfile or die "cannot read $symfile: $!";
Packit a07778
Packit a07778
    my $line = 0;
Packit a07778
    my @group;
Packit a07778
Packit a07778
    while (<SYMFILE>) {
Packit a07778
        chomp;
Packit a07778
Packit a07778
	if ($incomment) {
Packit a07778
	    if (m,\*/,) {
Packit a07778
		$incomment = 0;
Packit a07778
	    } else {
Packit a07778
		# skip
Packit a07778
	    }
Packit a07778
	} else {
Packit a07778
	    if (m,/\*,) {
Packit a07778
		$incomment = 1;
Packit a07778
	    } elsif (/^(.*)\s*{\s*$/) {
Packit a07778
		@group = ();
Packit a07778
		$line = $.;
Packit a07778
		$name = $1;
Packit a07778
	    } elsif (/^\s*}(.*);$/) {
Packit a07778
		&check_sorting(\@group, $symfile, $line, $name);
Packit a07778
	    } elsif (/^\s*(global|local):/) {
Packit a07778
		# skip
Packit a07778
	    } elsif (/^\s*\*;\s*$/) {
Packit a07778
		# skip
Packit a07778
	    } elsif (/^\s*$/) {
Packit a07778
		# skip
Packit a07778
	    } else {
Packit a07778
		$_ =~ s/;//;
Packit a07778
		push @group, $_;
Packit a07778
	    }
Packit a07778
	}
Packit a07778
    }
Packit a07778
Packit a07778
    close SYMFILE;
Packit a07778
}
Packit a07778
Packit a07778
sub check_sorting {
Packit a07778
    my $group = shift;
Packit a07778
    my $symfile = shift;
Packit a07778
    my $line = shift;
Packit a07778
    my $name = shift;
Packit a07778
Packit a07778
    my @group = @{$group};
Packit a07778
    my @sorted = sort { lc $a cmp lc $b } @group;
Packit a07778
    my $sorted = 1;
Packit a07778
    my $first;
Packit a07778
    my $last;
Packit a07778
Packit a07778
    # Check that symbols within a group are in order
Packit a07778
    for (my $i = 0 ; $i <= $#sorted ; $i++) {
Packit a07778
        if ($sorted[$i] ne $group[$i]) {
Packit a07778
            $first = $i unless defined $first;
Packit a07778
            $last = $i;
Packit a07778
            $sorted = 0;
Packit a07778
        }
Packit a07778
    }
Packit a07778
    if (!$sorted) {
Packit a07778
        @group = splice @group, $first, ($last-$first+1);
Packit a07778
        @sorted = splice @sorted, $first, ($last-$first+1);
Packit a07778
        print "Symbol block $name at $symfile:$line: symbols not sorted\n";
Packit a07778
        print map { "  " . $_ . "\n" } @group;
Packit a07778
        print "Correct ordering\n";
Packit a07778
        print map { "  " . $_ . "\n" } @sorted;
Packit a07778
        print "\n";
Packit a07778
        $ret = 1;
Packit a07778
    }
Packit a07778
}
Packit a07778
Packit a07778
exit $ret;