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