This file is indexed.

/usr/lib/perl5/Gtk2/TestHelper.pm is in libgtk2-perl 2:1.223-1build3.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
#
# $Id$
#

package Gtk2::TestHelper;
use strict;
use warnings;
use Test::More;
use Carp;

our $VERSION = '0.02';

sub import
{
	shift;
	my %opts = (@_);

	plan skip_all => $opts{skip_all} if ($opts{skip_all});

	croak "tests must be provided at import" unless (exists ($opts{tests}));

	if ($opts{nowin32} && $^O eq 'MSWin32')
	{
		plan skip_all => "not appliciable on win32";
	}

	if ($opts{at_least_version})
	{
		my ($rmajor, $rminor, $rmicro, $text) = 
						@{$opts{at_least_version}};
		unless (Gtk2->CHECK_VERSION ($rmajor, $rminor, $rmicro))
		{
			plan skip_all => $text;
		}
	}

	# gtk+ 2.0.x can use X fonts, and requires a connection to the
	# display at all times; so, ignore noinit for those versions.
	delete $opts{noinit} unless Gtk2->CHECK_VERSION (2, 2, 0);

	if( $opts{noinit} || Gtk2->init_check )
	{
		plan tests => $opts{tests};
	}	
	else
	{	
		plan skip_all => 'Gtk2->init_check failed, probably '
				.'unable to open DISPLAY';
	}

	# ignore keyboard
	Gtk2->key_snooper_install (sub { 1; });

	# turn on strict and warnings in caller
	$^W = 1;
	@_ = ();
	goto &strict::import;
}

package main;

# go ahead and use Gtk2 for them.
use Gtk2;
# and obviously they'll need Test::More
use Test::More;

# encourage use of these constants in tests
use Glib qw(TRUE FALSE);


# useful wrappers
sub run_main (;&) {
	my $callback = shift;
	Glib::Idle->add (sub {
		if ($callback) {
			#print "# Entering run_main shutdown callback\n";
			$callback->();
			#print "# Leaving run_main shutdown callback\n";
		}
		Gtk2->main_quit;
		FALSE;
	});
	#print "# Entering main loop (run_main)\n";
	Gtk2->main;
	#print "# Leaving main loop (run_main)\n";
}
sub ok_idle ($;$) {
	my ($testsub, $test_name) = @_;
	run_main {
		# 0 Test::More::ok
		# 1 this block's ok() call
		# 2 idle callback in run_main
		# 3 Gtk2::main call in run_main
		# 4 Gtk2::main call in run_main (again)
		# 5 ok_idle
		# 6 the caller we want to print
		local $Test::Builder::Level = 6;
		ok ($testsub->(), $test_name);
	}
}
sub is_idle ($$;$) {
	my ($asub, $b, $test_name) = @_;
	run_main {
		local $Test::Builder::Level = 6; # see ok_idle()
		is ($asub->(), $b, $test_name);
	}
}


sub ginterfaces_ok {
	my ($object_or_package) = @_;
	my $type = ref $object_or_package || $object_or_package;
	my $i = 0;
	my @ifaces = Glib::Type->list_interfaces ($type);
	foreach my $iface (@ifaces) {
		if ($object_or_package->isa ($iface)) {
			$i++;
		} else {
			warn "GType $type is supposed to implement $iface, "
			   . "but \@type\::ISA doesn't contain $iface!\n";
		}
	}
	is ($i, scalar(@ifaces), "GInterface versus \@ISA for $type");
}


# Inspired by Test::Number::Delta
sub delta_ok ($$;$) {
	my ($a, $b, $msg) = @_;
	ok (abs ($a - $b) < 1e-6, $msg);
}


1;
__END__

=head1 NAME

Gtk2::TestHelper - Code to make testing Gtk2 and friends simpler.

=head1 SYNOPSIS

  use Gtk2::TestHelper tests => 10;

=head1 DESCRIPTION

A simplistic module that brings together code that would otherwise have to be
copied into each and every test. The magic happens during the importing process
and therefore all options are passed to the use call. The module also use's
strict, warnings, Gtk2, and Test::More so that the individual tests will not
have to. The only required option is the number of tests. The module installs a
key snooper that causes all keyboard input to be ignored.

=head1 OPTIONS

=over

=item tests

The number of tests to be completed.

=item noinit

Do not call Gtk2->init_check, assume that it is not necessary.

=item nowin32

Set to true if all tests are to be skipped on the win32 platform.

=item at_least_version

A reference to a list that is checked with Gtk2->CHECK_VERSION.

=item skip_all

Simply skip all tests with the reason provided.

=back

=head1 "EXPORTED" FUNCTIONS

This module also defines a few utility functions for use in tests; since
we already override import and pull the dirty trick of calling use in
the package main, these are defined in the package main rather than exported
by Exporter.

=over

=item run_main

=item run_main (CODEREF)

=item run_main BLOCK

Run a main loop, and stop when all pending events are handled.  This is
useful if you have a test that needs a main loop to run properly, because
it allows your program to remain noninteractive.  Important for a test
suite.

If the optional I<CODEREF> is supplied, it will be run right before killing
the mainloop.  The function is prototyped to allow two styles of invocation:

  run_main (\&some_sub);    # explicit code reference
  run_main { print "hi" };  # callback as a block

=item ok_idle (TEST_SUB [, TEST_NAME])

Run Test::Simple's ok() on the return value of I<TEST_SUB> after handling
pending events.  Implemented with C<run_main> and other special trickery.

=item is_idle (THIS_SUB, THAT [, NAME])

Like ok_idle(), but compares the return value of I<THIS_SUB> with I<THAT>
using Test::More's is().

=item ginterfaces_ok (GOBJECT_OR_PACKAGE)

Verify that the GObject subclass I<GOBJECT_OR_PACKAGE>'s @ISA is set up properly
with all of the GInterfaces that the type system claims it supports.  Something
like an isa_ok() in steroids.

=item delta_ok (A, B [, NAME])

Checks that the absolute difference of the numbers A and B is smaller than
1e-6.

=back

=head1 SEE ALSO

L<perl>(1), L<Gtk2>(3pm).

=head1 AUTHORS

The Gtk2-Perl Team.

=head1 COPYRIGHT AND LICENSE

Copyright 2003-2005 by the gtk2-perl team.

LGPL, See LICENSE file for more information.