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
|
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
use lib qw(Apache-Test/lib lib xs/tables/current);
use strict;
use warnings qw(FATAL all);
use ModPerl::TypeMap ();
use ModPerl::FunctionMap ();
use ModPerl::StructureMap ();
use ModPerl::WrapXS ();
use ModPerl::MapUtil qw(disabled_reason);
my %check = (
types => ModPerl::TypeMap->new,
functions => ModPerl::FunctionMap->new,
structures => ModPerl::StructureMap->new,
);
my %missing;
while (my($things, $obj) = each %check) {
$missing{$things} = $obj->check;
if (my $missing = $missing{$things}) {
my $n = @$missing;
print "$n $things are not mapped:\n";
print " $_\n" for sort @$missing;
}
else {
print "all $things are mapped\n";
}
}
my %check_exists = (
functions => $check{functions},
structure_members => $check{structures},
types => $check{types},
);
while (my($things, $obj) = each %check_exists) {
if (my $missing = $obj->check_exists) {
my $n = @$missing;
print "$n mapped $things do not exist:\n";
print " $_\n" for sort @$missing;
}
else {
print "all mapped $things exist\n";
}
}
my %unmapped = map { $_,1 } @{ $missing{functions} } if $missing{functions};
my $typemap = $check{types};
my $function_map = $check{functions};
my @missing;
for my $entry (@$Apache2::FunctionTable) {
my $func;
my $name = $entry->{name};
next if $unmapped{$name};
next unless $function_map->{map}->{$name};
next if $func = $typemap->map_function($entry);
push @missing, $name;
}
if (@missing) {
my $n = @missing;
print "unable to glue $n mapped functions:\n";
print " $_\n" for sort @missing;
}
else {
print "all mapped functions are glued\n";
}
my $stats = ModPerl::WrapXS->new->stats;
my($total_modules, $total_xsubs);
while (my($module, $n) = each %$stats) {
$total_modules++;
$total_xsubs += $n;
}
print "$total_modules total modules, ",
"$total_xsubs total xsubs\n";
while (my($module, $n) = each %$stats) {
print "$module: $n\n";
}
for (qw(functions structure_members)) {
my $disabled = $check_exists{$_}->disabled;
my $total = 0;
for my $names (values %$disabled) {
$total += @$names;
}
print "$total $_ are not wrapped:\n";
while (my($r, $names) = each %$disabled) {
printf "%4d are %s\n", scalar @$names, disabled_reason($r);
}
}
if (@ARGV) {
my $key = '!';
for (qw(functions structure_members)) {
my $disabled = $check_exists{$_}->disabled;
my $names = $disabled->{$key};
printf "%s $_:\n", disabled_reason($key);
for my $name (sort @$names) {
print " $name\n";
}
}
}
|
