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