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
|
#!/usr/bin/perl -w
#
# handlerlive.pl
# ~~~~~~~~~~~~~~
#
# A tool for post-processing the debug output generated by Asio-based programs
# to print a list of "live" handlers. These are handlers that are associated
# with operations that have not yet completed, or running handlers that have
# not yet finished their execution. Programs write this output to the standard
# error stream when compiled with the define `BOOST_ASIO_ENABLE_HANDLER_TRACKING'.
#
# Copyright (c) 2003-2025 Christopher M. Kohlhoff (chris at kohlhoff dot com)
#
# Distributed under the Boost Software License, Version 1.0. (See accompanying
# file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
#
use strict;
my %pending_handlers = ();
my %running_handlers = ();
#-------------------------------------------------------------------------------
# Parse the debugging output and update the set of pending handlers.
sub parse_debug_output()
{
while (my $line = <>)
{
chomp($line);
if ($line =~ /\@asio\|([^|]*)\|([^|]*)\|(.*)$/)
{
my $action = $2;
# Handler creation.
if ($action =~ /^([0-9]+)\*([0-9]+)$/)
{
$pending_handlers{$2} = 1;
}
# Begin handler invocation.
elsif ($action =~ /^>([0-9]+)$/)
{
delete($pending_handlers{$1});
$running_handlers{$1} = 1;
}
# End handler invocation.
elsif ($action =~ /^<([0-9]+)$/)
{
delete($running_handlers{$1});
}
# Handler threw exception.
elsif ($action =~ /^!([0-9]+)$/)
{
delete($running_handlers{$1});
}
# Handler was destroyed without being invoked.
elsif ($action =~ /^~([0-9]+)$/)
{
delete($pending_handlers{$1});
}
}
}
}
#-------------------------------------------------------------------------------
# Print a list of incompleted handers, on a single line delimited by spaces.
sub print_handlers($)
{
my $handlers = shift;
my $prefix = "";
foreach my $handler (sort { $a <=> $b } keys %{$handlers})
{
print("$prefix$handler");
$prefix = " ";
}
print("\n") if ($prefix ne "");
}
#-------------------------------------------------------------------------------
parse_debug_output();
print_handlers(\%running_handlers);
print_handlers(\%pending_handlers);
|
