• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1#!/usr/bin/perl
2# SPDX-License-Identifier: GPL-2.0-or-later
3# Copyright (c) 2019 Cyril Hrubis <chrubis@suse.cz>
4# Copyright (c) 2020-2021 Petr Vorel <pvorel@suse.cz>
5
6use strict;
7use warnings;
8
9use JSON qw(decode_json);
10use Cwd qw(abs_path);
11use File::Basename qw(dirname);
12
13use constant OUTDIR => dirname(abs_path($0));
14
15# tags which expect git tree, also need constant for URL
16our @TAGS_GIT = ("linux-git", "linux-stable-git", "glibc-git");
17
18# tags should map these in lib/tst_test.c
19use constant LINUX_GIT_URL => "https://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git/commit/?id=";
20use constant LINUX_STABLE_GIT_URL => "https://git.kernel.org/pub/scm/linux/kernel/git/stable/linux.git/commit/?id=";
21use constant GLIBC_GIT_URL => "https://sourceware.org/git/?p=glibc.git;a=commit;h=";
22use constant CVE_DB_URL => "https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-";
23
24sub load_json
25{
26	my ($fname, $mode) = @_;
27	local $/;
28
29	open(my $fh, '<', $fname) or die("Can't open $fname $!");
30
31	return <$fh>;
32}
33
34sub log_info
35{
36	my $msg = shift;
37	print STDERR "INFO: $msg\n";
38}
39
40sub log_warn
41{
42	my $msg = shift;
43	print STDERR "WARN: $msg\n";
44}
45
46sub print_asciidoc_page
47{
48	my ($fh, $json, $title, $content) = @_;
49
50	print $fh <<EOL;
51// -*- mode:doc; -*-
52// vim: set syntax=asciidoc:
53
54$title
55
56$content
57EOL
58}
59
60sub tag_url {
61	my ($tag, $value, $scm_url_base) = @_;
62
63	if ($tag eq "fname") {
64		return $scm_url_base . $value;
65	}
66
67	if ($tag eq "CVE") {
68		return CVE_DB_URL . $value;
69	}
70
71	# *_GIT_URL
72	my $key = tag2env($tag) . "_URL";
73	if (defined($constant::declared{"main::$key"})) {
74		return eval("main::$key") . $value;
75	}
76
77	if ('known-fail') {
78		return '';
79	}
80
81	die("unknown constant '$key' for tag $tag, define it!");
82}
83
84sub bold
85{
86	return "*$_[0]*";
87}
88
89sub code
90{
91	return "+$_[0]+";
92}
93
94sub hr
95{
96	return "\n\n'''\n\n";
97}
98
99sub html_a
100{
101	my ($url, $text) = @_;
102
103	# escape: ] |
104	$text =~ s/([]|])/\\$1/g;
105
106	return "$url\[$text\]";
107}
108
109sub h1
110{
111	return "== $_[0]\n";
112}
113
114sub h2
115{
116	return "=== $_[0]\n";
117}
118
119sub h3
120{
121	return "==== $_[0]\n";
122}
123
124sub label
125{
126	return "[[$_[0]]]\n";
127}
128
129sub paragraph
130{
131	return "$_[0]\n\n";
132}
133
134sub reference
135{
136	my ($link, %args) = @_;
137
138	$args{text} //= $link;
139	$args{delimiter} //= "";
140
141	return "xref:$link\[$args{text}\]$args{delimiter}\n";
142}
143
144sub table
145{
146	return "|===\n";
147}
148
149sub table_escape
150{
151	my $out = $_[0];
152
153	$out =~ s/\|/\\|/g;
154	return $out;
155}
156
157sub print_defined
158{
159	my ($key, $val, $val2) = @_;
160
161	if (defined($val)) {
162		return paragraph(bold($key) . ": " . $val . (defined($val2) ? " $val2" : ""));
163	}
164}
165
166sub content_about
167{
168	my $json = shift;
169	my $content;
170
171	$content .= print_defined("URL", $json->{'testsuite'}->{'url'});
172	$content .= print_defined("Version", $json->{'testsuite'}->{'version'});
173	$content .= print_defined("Default timeout", $json->{'defaults'}->{'timeout'}, "seconds");
174
175	return $content;
176}
177
178sub uniq {
179	my %seen;
180	grep !$seen{$_}++, @_;
181}
182
183sub get_test_names
184{
185	my @names = @{$_[0]};
186	my ($letter, $prev_letter);
187	my $content;
188
189	for my $name (sort @names) {
190		$letter = substr($name, 0, 1);
191		if (defined($prev_letter) && $letter ne $prev_letter) {
192			$content .= "\n";
193		}
194
195		$content .= reference($name, delimiter => " ");
196		$prev_letter = $letter;
197	}
198	$content .= "\n";
199
200	return $content;
201}
202
203sub get_test_letters
204{
205	my @names = @{$_[0]};
206	my $letter;
207	my $prev_letter = "";
208	my $content;
209
210	for (@names) {
211		$_ = substr($_, 0, 1);
212	}
213	@names = uniq(@names);
214
215	for my $letter (@names) {
216		$content .= reference($letter);
217	}
218	$content .= "\n";
219
220	return $content;
221}
222
223sub tag2title
224{
225	my $tag = shift;
226	return code(".$tag");
227}
228
229sub get_filters
230{
231	my $json = shift;
232	my %data;
233
234	while (my ($k, $v) = each %{$json->{'tests'}}) {
235		for my $j (keys %{$v}) {
236			next if ($j eq 'fname' || $j eq 'doc');
237			$data{$j} = () unless (defined($data{$j}));
238
239			if ($j eq 'tags') {
240				for my $tags (@{$v}{'tags'}) {
241					for my $tag (@$tags) {
242						my $k2 = $$tag[0];
243						my $v2 = $$tag[1];
244						$data{$j}{$k2} = () unless (defined($data{$j}{$k2}));
245						push @{$data{$j}{$k2}}, $k unless grep{$_ eq $k} @{$data{$j}{$k2}};
246					}
247				}
248			} else {
249				push @{$data{$j}}, $k unless grep{$_ eq $k} @{$data{$j}};
250			}
251		}
252	}
253	return \%data;
254}
255
256sub content_filter
257{
258	my $k = $_[0];
259	my $title = $_[1];
260	my $desc = $_[2];
261	my $h = $_[3];
262	my ($letter, $prev_letter, $content);
263
264	$content = label($k);
265	$content .= $title;
266	$content .= paragraph("Tests containing $desc flag.");
267
268	$content .= get_test_names(\@{$h});
269
270	return $content;
271}
272
273sub content_filters
274{
275	my $json = shift;
276	my $data = get_filters($json);
277	my %h = %$data;
278	my $content;
279
280	for my $k (sort keys %$data) {
281		my $title = tag2title($k);
282		if (ref($h{$k}) eq 'HASH') {
283			$content .= label($k);
284			$content .= h2($title);
285			for my $k2 (sort keys %{$h{$k}}) {
286				my $title2 = code($k2);
287				$content .= content_filter($k2, h3($title2), "$title $title2", $h{$k}{$k2});
288			}
289		} else {
290			$content .= content_filter($k, h2($title), $title, \@{$h{$k}});
291		}
292	}
293
294	return $content;
295}
296
297sub tag2env
298{
299	my $tag = shift;
300	$tag =~ s/-/_/g;
301	return uc($tag);
302}
303
304sub detect_git
305{
306	my %data;
307
308	for my $tag (@TAGS_GIT) {
309		my $env = tag2env($tag);
310
311		unless (defined $ENV{$env} && $ENV{$env}) {
312			log_warn("git repository $tag not defined. Define it in \$$env");
313			next;
314		}
315
316		unless (-d $ENV{$env}) {
317			log_warn("\$$env does not exit ('$ENV{$env}')");
318			next;
319		}
320
321		if (system("which git >/dev/null")) {
322			log_warn("git not in \$PATH ('$ENV{'PATH'}')");
323			next;
324		}
325
326		chdir($ENV{$env});
327		if (!system("git log -1 > /dev/null")) {
328			log_info("using '$ENV{$env}' as $env repository");
329			$data{$tag} = $ENV{$env};
330		} else {
331			log_warn("git failed, git not installed or \$$env is not a git repository? ('$ENV{$env}')");
332		}
333		chdir(OUTDIR);
334	}
335
336	return \%data;
337}
338
339sub content_all_tests
340{
341	my $json = shift;
342	my @names = sort keys %{$json->{'tests'}};
343	my $letters = paragraph(get_test_letters(\@names));
344	my $git_url = detect_git();
345	my $tmp = undef;
346	my $printed = "";
347	my $content;
348
349	$content .= paragraph("Total $#names tests.");
350	$content .= $letters;
351	$content .= get_test_names(\@names);
352
353	for my $name (@names) {
354		my $letter = substr($name, 0, 1);
355
356		if ($printed ne $letter) {
357			$content .= label($letter);
358			$content .= h2($letter);
359			$printed = $letter;
360		}
361
362		$content .= hr() if (defined($tmp));
363		$content .= label($name);
364		$content .= h3($name);
365		$content .= $letters;
366
367		if (defined($json->{'testsuite'}->{'scm_url_base'}) &&
368			defined($json->{'tests'}{$name}{fname})) {
369			$content .= paragraph(html_a(tag_url("fname", $json->{'tests'}{$name}{fname},
370					$json->{'testsuite'}->{'scm_url_base'}), "source"));
371		}
372
373		if (defined $json->{'tests'}{$name}{doc}) {
374			for my $doc (@{$json->{'tests'}{$name}{doc}}) {
375
376				# fix formatting for asciidoc [DOCUMENTATION] => *Documentation*
377				if ($doc =~ s/^\[(.*)\]$/$1/) {
378					$doc = paragraph(bold(ucfirst(lc($doc))));
379				}
380
381				$content .= "$doc\n";
382			}
383			$content .= "\n";
384		}
385
386		if ($json->{'tests'}{$name}{timeout}) {
387			if ($json->{'tests'}{$name}{timeout} eq -1) {
388				$content .= paragraph("Test timeout is disabled");
389			} else {
390				$content .= paragraph("Test timeout is $json->{'tests'}{$name}{timeout} seconds");
391			}
392		} else {
393			$content .= paragraph("Test timeout defaults to $json->{'defaults'}->{'timeout'} seconds");
394		}
395
396		my $tmp2 = undef;
397		for my $k (sort keys %{$json->{'tests'}{$name}}) {
398			my $v = $json->{'tests'}{$name}{$k};
399			next if ($k eq "tags" || $k eq "fname" || $k eq "doc");
400			if (!defined($tmp2)) {
401				$content .= table . "|Key|Value\n\n"
402			}
403
404			$content .= "|" . reference($k, text => tag2title($k)) . "\n|";
405
406			if (ref($v) eq 'ARRAY') {
407				# two dimensional array
408				if (ref(@$v[0]) eq 'ARRAY') {
409					for my $v2 (@$v) {
410						$content .= paragraph(table_escape(join(' ', @$v2)));
411					}
412				} else {
413					# one dimensional array
414					$content .= table_escape(join(', ', @$v));
415				}
416			} else {
417				# plain content
418				$content .= table_escape($v);
419			}
420
421			$content .= "\n";
422
423			$tmp2 = 1;
424		}
425		if (defined($tmp2)) {
426			$content .= table . "\n";
427		}
428
429		$tmp2 = undef;
430		my %commits;
431		my @sorted_tags = sort { $a->[0] cmp $b->[0] } @{$json->{'tests'}{$name}{tags} // []};
432
433		for my $tag (@sorted_tags) {
434			if (!defined($tmp2)) {
435				$content .= table . "|Tag|Info\n"
436			}
437			my $k = @$tag[0];
438			my $v = @$tag[1];
439			my $url;
440
441			if (defined($$git_url{$k})) {
442				$commits{$k} = () unless (defined($commits{$k}));
443				unless (defined($commits{$k}{$v})) {
444					chdir($$git_url{$k});
445					$commits{$k}{$v} = `git log --pretty=format:'%s' -1 $v`;
446					chdir(OUTDIR);
447				}
448				$v .= ' ("' . $commits{$k}{$v} . '")';
449			}
450
451			$url = tag_url($k, @$tag[1]);
452			if ($url) {
453				$v = html_a($url, $v);
454			}
455
456			# tag value value can be split into more lines if too long
457			# i.e. URL in known-fail
458			for (@$tag[2 .. $#$tag]) {
459				$v .= " $_";
460			}
461
462			$content .= "\n|" . reference($k) . "\n|$v\n";
463			$tmp2 = 1;
464		}
465		if (defined($tmp2)) {
466			$content .= table . "\n";
467		}
468
469		$tmp = 1;
470	}
471
472	return $content;
473}
474
475
476my $json = decode_json(load_json($ARGV[0]));
477
478my $config = [
479    {
480		file => "about.txt",
481		title => h2("About $json->{'testsuite'}->{'name'}"),
482		content => \&content_about,
483    },
484    {
485		file => "filters.txt",
486		title => h1("Test filtered by used flags"),
487		content => \&content_filters,
488    },
489    {
490		file => "all-tests.txt",
491		title => h1("All tests"),
492		content => \&content_all_tests,
493    },
494];
495
496sub print_asciidoc_main
497{
498	my $config = shift;
499	my $file = "metadata.txt";
500	my $content;
501
502	open(my $fh, '>', $file) or die("Can't open $file $!");
503
504	$content = <<EOL;
505:doctype: inline
506:sectanchors:
507:toc:
508
509EOL
510	for my $c (@{$config}) {
511		$content .= "include::$c->{'file'}\[\]\n";
512	}
513	print_asciidoc_page($fh, $json, h1($json->{'testsuite'}->{'short_name'} . " test catalog"), $content);
514}
515
516for my $c (@{$config}) {
517	open(my $fh, '>', $c->{'file'}) or die("Can't open $c->{'file'} $!");
518	print_asciidoc_page($fh, $json, $c->{'title'}, $c->{'content'}->($json));
519}
520
521print_asciidoc_main($config);
522