OLD | NEW |
(Empty) | |
| 1 #!perl |
| 2 |
| 3 use Data::Dumper; |
| 4 |
| 5 my @test_files = split('\s+',`ls generic/t.* xdg-*/t.*`); |
| 6 |
| 7 my $cvs_pre = "http://webcvs.freedesktop.org/portland/portland/xdg-utils/tests/"
; |
| 8 my $cvs_post = '?view=markup'; |
| 9 my $assert_doc = "assertions.html"; |
| 10 my $now = scalar localtime; |
| 11 my $style = "<style type=\"text/css\" media=\"all\">@import url(\"layout.css\");
</style></head>\n"; |
| 12 my $root_header = qq{| <a href="index.html">Tests</a> | <a href="$assert_doc">As
sertions</a> | <a href="http://portland.freedesktop.org/wiki/WritingXdgTests">Ov
erview</a> |<hr/>\n}; |
| 13 my $group_header = qq{| <a href="../index.html">Tests</a> | <a href="../$assert_
doc">Assertions</a> | <a href="http://portland.freedesktop.org/wiki/WritingXdgTe
sts">Overview</a> |<hr/>\n}; |
| 14 my $footer = "<hr><font size=\"-1\">xdg-utils test documentation generated $now<
/font>\n"; |
| 15 |
| 16 my %fcns; |
| 17 |
| 18 my %group; |
| 19 my %shortdesc; |
| 20 |
| 21 ## Read assertion file |
| 22 open IN, 'include/testassertions.sh' or die "Failed to open assertion file: $!\n
"; |
| 23 my $state = 'NULL'; |
| 24 my %assertions; |
| 25 while ( <IN> ) { |
| 26 if ( m/(\w+)\s*\(\)/ ) { |
| 27 $state = $1; |
| 28 $assertions{$state} = (); |
| 29 } |
| 30 elsif ( $state ne 'NULL' and m/^#(.*)/ ) { |
| 31 my $txt = $1; |
| 32 chomp $txt; |
| 33 push @{ $assertions{$state} }, $txt; |
| 34 } |
| 35 else { |
| 36 $state = 'NULL'; |
| 37 } |
| 38 } |
| 39 close IN; |
| 40 |
| 41 if ( ! -d 'doc' ) { mkdir 'doc'; } |
| 42 |
| 43 open OUT, ">doc/$assert_doc" or die "Failed to open $assert_doc: $!\n"; |
| 44 print OUT "<html><head><title>xdg-utils test assertions</title>$style</head><bod
y>\n$root_header"; |
| 45 |
| 46 my @s_assert = sort keys %assertions ; |
| 47 print OUT qq{<h2>Defined Assertions in <a href="$cvs_pre}.qq{include/testasserti
ons.sh$cvs_post">include/testassertions.sh</a></h2>\n}; |
| 48 for $a ( @s_assert ) { |
| 49 print OUT qq{<a href="#$a">$a</a><br>\n}; |
| 50 } |
| 51 for $a ( @s_assert ) { |
| 52 print OUT qq{<hr><h2><a name="$a">$a</a></h2>\n}; |
| 53 print OUT "<pre>", join("\n",@{ $assertions{$a} } ), "</pre>\n"; |
| 54 } |
| 55 print OUT "$footer</body></html>"; |
| 56 |
| 57 |
| 58 ## Read test files |
| 59 for $f ( @test_files ) { |
| 60 open IN, $f or die "Failed to open $f: $!\n"; |
| 61 $f =~ m{(.+)/t\.(.+)}; |
| 62 my $dir = $1; |
| 63 my $test = $2; |
| 64 `mkdir -p doc/$dir`; |
| 65 my $o = "doc/$dir/$test.html"; |
| 66 |
| 67 push @{ $group{$dir} }, $test; |
| 68 |
| 69 open HTM, ">$o" or die "Failed to open '$o': $!\n"; |
| 70 print HTM "<html><head><title>xdg-utils test: $f</title>\n"; |
| 71 print HTM $style; |
| 72 |
| 73 print HTM "<body>$group_header<h1>Test: <a href=\"$cvs_pre$f$cvs_post\">
$f</a></h1><hr/>\n"; |
| 74 my $fcn = ''; |
| 75 my $state = 'BEGIN'; |
| 76 while ( <IN> ) { |
| 77 #find the test function |
| 78 if ( m/(\w+)\s*\(\)/ ) { |
| 79 $fcn = $1; |
| 80 if (defined $fcns{$fcn} ){ |
| 81 print "WARNING in $f: $fcn already exists in $fc
ns{$fcn}!\n" |
| 82 } |
| 83 $fcns{$fcn} = $f; |
| 84 $state = 'FUNCTION'; |
| 85 } |
| 86 #find test_start |
| 87 elsif ( m/test_start (.*)/ ) { |
| 88 print HTM "<h2>Purpose of $fcn</h2>"; |
| 89 my $txt = $1; |
| 90 $txt =~ s/\$FUNCNAME:*\s*//; |
| 91 $txt =~ s/\"//g; |
| 92 $shortdesc{ $test } = $txt; |
| 93 print HTM "<p>$txt</p>\n"; |
| 94 $state = 'START'; |
| 95 } |
| 96 #find test_purpose |
| 97 elsif ( m/test_purpose (.*)/ ) { |
| 98 print HTM "<h2>Description</h2>"; |
| 99 my $txt = $1; |
| 100 $txt =~ s/\"//g; |
| 101 print HTM "<p>$txt</p>\n"; |
| 102 } |
| 103 #find initilization |
| 104 elsif ( m/test_init/ ) { |
| 105 print HTM "<h2>Depencencies</h2>\n"; |
| 106 $state = 'INIT'; |
| 107 next; |
| 108 } |
| 109 elsif ( m/test_procedure/ ) { |
| 110 print HTM "<h2>Test Procedure</h2>\n"; |
| 111 $state = 'TEST'; |
| 112 next; |
| 113 } |
| 114 elsif ( m/test_note (.*)/ ) { |
| 115 print HTM "<h2>Note</h2><p>$1</p>\n"; |
| 116 next; |
| 117 } |
| 118 elsif ( m/test_result/ ) { |
| 119 $state = 'DONE'; |
| 120 } |
| 121 if ( m/^#/ ) { |
| 122 next; |
| 123 } |
| 124 if ( $state eq 'INIT' or $state eq 'TEST' ) { |
| 125 $line = $_; |
| 126 $line =~ s/^\s*(\w+)/<a href="\.\.\/$assert_doc#$1">$1<\
/a>/; |
| 127 if ( $assertions{$1} ) { |
| 128 print HTM "<p>$line</p>\n"; |
| 129 #print "$f:\t'$1' found\n"; |
| 130 } |
| 131 else { |
| 132 #print "$f:\t'$1' not found\n"; |
| 133 print HTM "<p>$_</p>\n"; |
| 134 } |
| 135 #print HTM "<p>$_</p>\n"; |
| 136 } |
| 137 } |
| 138 print HTM "$footer</body></html>\n"; |
| 139 close HTM; |
| 140 close IN; |
| 141 } |
| 142 |
| 143 open INDEX, ">doc/index.html" or die "Could not open index: $!"; |
| 144 print INDEX "<html><head><title>xdg-utils test suite</title>\n"; |
| 145 print INDEX $style; |
| 146 |
| 147 print INDEX "<body>$root_header<h1>xdg-utils test documentation</h1>"; |
| 148 |
| 149 my @s_groups = sort keys %group; |
| 150 |
| 151 for $g ( @s_groups ) { |
| 152 print INDEX qq{<a href="#$g">$g</a> \n}; |
| 153 } |
| 154 print INDEX "<table border=0>\n"; |
| 155 for $k ( @s_groups ) { |
| 156 print INDEX qq{<tr><td colspan=2><hr><h2><a name="$k">$k</a></h2></td></
tr>\n}; |
| 157 for $i ( @{ $group{$k} } ) { |
| 158 print INDEX "<tr><td><a href=\"$k/$i.html\">$i</a></td><td>$shor
tdesc{$i}</td></tr>\n"; |
| 159 } |
| 160 } |
| 161 print INDEX "</table>$footer</body></html>\n"; |
| 162 close INDEX; |
| 163 |
| 164 #print Dumper keys %assertions; |
OLD | NEW |