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
|
#!/usr/bin/env perl
use warnings;
use strict;
#
# libslack - https://libslack.org
#
# Copyright (C) 1999-2004, 2010, 2020-2023 raf <raf@raf.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, see <https://www.gnu.org/licenses/>.
#
# 20230824 raf <raf@raf.org>
#
$| = 1;
# Compiles and executes the examples from the manpages.
# Run this from the source directory.
die("usage: $0 *.c\n") if $#ARGV == -1;
my $total = 0;
for my $src (@ARGV)
{
next unless $src =~ /\.c$/;
#next if $src =~ /getopt\.c$/;
warn("Failed to open $src for reading: $!\n"), next unless open SRC, $src;
my $state = '';
my $desc = '';
my $code = '';
my $num = 0;
while (<SRC>)
{
$state = 'X', next if /^=head\d EXAMPLE/;
$state = '', next if $state eq 'X' && (/^=head/ || /^=cut/);
next unless $state eq 'X';
s/\s*(?<!http:)\/\/.*$//;
next if /^$/;
check($src, ++$num, $desc, $code), $desc = $_, $code = '', next if /^\S/ && $code ne '';
$desc .= $_, next if /^\S/;
$code .= $_;
}
check($src, ++$num, $desc, $code) if $code ne '';
close SRC;
print "WARNING: $src has no EXAMPLES section\n" unless $num;
$total += $num;
}
print "There were $total examples in total\n";
exit;
sub check
{
my $src = shift;
my $num = shift;
my $desc = shift;
my $code = shift;
return unless $code =~ /\bint\s+main\s*\(/m;
print "$src:$num\n$desc\n$code\nExecute ([y]/n): ";
my $response = <STDIN>;
return if $response =~ /n/i;
warn("Failed to open example.c for writing: $!\n"), return
unless open(EXAMPLE, "> example.c");
print EXAMPLE $code;
close EXAMPLE;
print 'Arguments: ';
chop(my $args = <STDIN>);
system("echo Compiling...; cc -o example example.c `libslack-config --cflags --libs` && echo Executing... && ./example $args; echo rc=\$?");
unlink 'example', 'example.c';
print 'Press return to continue or Ctrl-C to quit.';
<STDIN>;
}
# vi:set ts=4 sw=4:
|
