File Coverage

examples/perltypes.pl

Criterion	Covered	Total	%
statement	29	30	96.7
branch	2	4	50.0
condition	2	5	40.0
subroutine	3	3	100.0
pod			n/a
total	36	42	85.7

line	stmt	bran	cond	sub	time	code
1						#!/usr/local/pkg/cover/20070318/sw/bin/perl -w
2						################################################################################
3						#
4						# $Project: /Convert-Binary-C $
5						# $Author: mhx $
6						# $Date: 2006/11/02 12:44:38 +0100 $
7						# $Revision: 14 $
8						# $Source: /bin/perltypes.PL $
9						#
10						################################################################################
11						#
12						# Copyright (c) 2002-2006 Marcus Holland-Moritz. All rights reserved.
13						# This program is free software; you can redistribute it and/or modify
14						# it under the same terms as Perl itself.
15						#
16						################################################################################
17
18						#===============================================================================
19						#
20						# Parse perl's header files and play around with the types they define.
21						#
22						#===============================================================================
23
24	1			1	31	use Convert::Binary::C;
	1				10
	1				19
25	1			1	44	use Data::Dumper;
	1				51
	1				41
26	1			1	19	use strict;
	1				10
	1				16
27
28	1				12	my $base;
29	1		33		9	-d "$_/include" and $base = "$_/include" and last for qw( tests ../tests );
	1		50		44
30	1	50			11	defined $base or die <<MSG;
31						Please run this script from either the 'examples' directory
32						or the distribution base directory.
33						MSG
34
35						#-------------------------------------
36						# Create an object, set configuration.
37						#-------------------------------------
38
39	1				630	my $cfg = require "$base/config.pl";
40	1				2020	my $c = new Convert::Binary::C %$cfg;
41
42						#------------------
43						# Parse the C file.
44						#------------------
45
46	1				16	eval { $c->parse_file( "$base/include.c" ) };
	1				330680
47
48						#-----------------------
49						# Check for parse error.
50						#-----------------------
51
52	1	50			20	if( $@ ) {
53	0				0	die "Parse error: $@";
54						}
55
56						#----------------------------
57						# Dump out the configuration.
58						#----------------------------
59
60	1				111	print Dumper( $c->configure );
61
62						#----------------------------
63						# Print all the enumerations.
64						#----------------------------
65
66	1				15	my @enums = $c->enum_names;
67	1				128	print "\nenums: @enums\n\n";
68
69						#---------------------------------------------------------------------------
70						# Print all structs, sorted by size; skip all structs smaller than 50 bytes.
71						#---------------------------------------------------------------------------
72
73	1				10	print "large structs:\n\n";
74
75	139				2181	my @structs = sort { $c->sizeof( $b ) <=> $c->sizeof( $a ) }
	141				2358
76	1				128	grep { $c->sizeof( $_ ) >= 50 }
77						$c->struct_names;
78
79	1				63	for my $struct ( @structs ) {
80	35				601	printf "struct %-20s => %4d bytes\n", $struct, $c->sizeof( $struct );
81						}
82
83	1				12	print "\n";
84
85						#-----------------------------------------------
86						# Dump the definition of the __socket_type enum
87						#-----------------------------------------------
88
89	1				36	print Data::Dumper->Dump( [$c->enum('__socket_type')], ['__socket_type'] );
90