1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
#!/usr/bin/perl -w
# SPDX-License-Identifier: GPL-2.0
# Copyright (c) 2008 Silicon Graphics, Inc. All Rights Reserved.
#
# Print headers of given tests
# Accepted parameter types:
# - nothing - list all tests from all subdirectories in tests/*
# - tests/DIR - list all tests from DIR
# - tests/DIR/123 - show header from single test
use strict;
use Getopt::Long;
sub help();
sub get_qa_header($);
sub get_qa_tests;
my %opt;
my @oa = (
['--help|?', "Show this help message.",
\$opt{'help'}],
['--head|h', "Shows only the head of the QA test",
\$opt{'head'}],
['--body|b', "Shows only the body of the QA test.",
\$opt{'body'}],
['--one-line|1', "Output everything on a single line.",
\$opt{'oneline'}],
);
# black magic
GetOptions(map { @{$_}[0] => @{$_}[2] } @oa);
if ($opt{'help'}) {
die help();
}
my @qatests;
if (!@ARGV) {
my $d="tests";
opendir(DIR, $d);
map { push @qatests,get_qa_tests("$d/$_") if -d "$d/$_" } readdir(DIR);
closedir(DIR);
}
foreach (@ARGV) {
push @qatests,$_ if -f && /\d{3}$/;
push @qatests,get_qa_tests($_) if -d;
}
foreach (@qatests) {
my @h = get_qa_header($_);
if ($opt{'head'}) {
@h = shift @h;
} elsif ($opt{'body'}) {
shift @h;
shift @h
}
if ($opt{'oneline'}) {
print map {s/\n/ /; $_} @h;
print "\n";
} else {
print @h;
}
print "--------------------------------------------------\n" unless (@qatests < 2);
}
sub help() {
my $sa = '';
foreach (@oa) {
# local $_ = @{$_}[0];
@{$_}[0] =~ s/=(.*)$//;
@{$_}[0] =~ s/\|/ \| -/;
@{$_}[0] =~ s/^/\[ /;
@{$_}[0] =~ s/$/ \] /;
$sa .= @{$_}[0];
}
print "Usage: $0\t$sa\n";
foreach (@oa) {
$$_[0] =~ s/\|/\t\|/;
print "\t$$_[0]\t$$_[1]\n";
}
}
sub get_qa_header($) {
my $f = shift || die "need an argument";
my @l;
open(my $FH, $f) || die "couldn't open '$f': $!";
while (<$FH>) {
#ignore.
m/^#\!/ and next; # shebang
m/^# SPDX/i and next; # SPDX tags
m/^# Copyright/i and next; # Copyright tags
m/^#\s*\-{10}/ and last; # dashed lines
m/^\. \.\/common\/preamble/ and last; # test start
s/^# *//;
push @l, $_;
}
close($FH);
return @l;
}
sub get_qa_tests {
my $d = shift || $ENV{'PWD'};
opendir(my $DIR, $d) || die "can't opendir $d: $!";
my @qa = sort grep { m/^\d\d\d$/ && -f "$d/$_" } readdir($DIR);
closedir($DIR);
return map { $_ = "$d/$_" } @qa;
}
|
