PageRenderTime 7ms CodeModel.GetById 2ms app.highlight 4ms RepoModel.GetById 1ms app.codeStats 0ms

/xt/06_surfaceML.t

http://github.com/PerlGameDev/SDL
Perl | 78 lines | 34 code | 13 blank | 31 comment | 2 complexity | 4c2f50be981fd4426e6892d394e3f1d9 MD5 | raw file
 1#!/usr/bin/perl -w
 2#
 3# Copyright (C) 2009 Kartik Thakore
 4#
 5# ------------------------------------------------------------------------------
 6#
 7# This library is free software; you can redistribute it and/or
 8# modify it under the terms of the GNU Lesser General Public
 9# License as published by the Free Software Foundation; either
10# version 2.1 of the License, or (at your option) any later version.
11#
12# This library is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15# Lesser General Public License for more details.
16#
17# You should have received a copy of the GNU Lesser General Public
18# License along with this library; if not, write to the Free Software
19# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
20#
21# ------------------------------------------------------------------------------
22#
23# Please feel free to send questions, suggestions or improvements to:
24#
25#	Kartik Thakore
26#	kthakore\@cpan.org
27#
28#
29# Memory leaks testing
30
31BEGIN {
32	unshift @INC, 'blib/lib', 'blib/arch';
33}
34
35use strict;
36
37use Test::More;
38
39# Don't run tests for installs
40unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) {
41	plan( skip_all => "Author tests not required for installation" );
42}
43
44# This is stolen for Gabor's examples in padre's SDL plugin
45sub surface_leak() {
46	use SDL;
47	use SDLx::App;
48	use SDL::Rect;
49	use SDL::Color;
50
51	my $window = SDLx::App->new(
52		width  => 640,
53		height => 480,
54		depth  => 16,
55		title  => 'SDL Demo',
56		init   => SDL_INIT_VIDEO
57
58	);
59
60	my $rect = SDL::Rect->new( 0, 0, 10, 20 );
61
62	my $blue = SDL::Color->new(
63		-r => 0x00,
64		-g => 0x00,
65		-b => 0xff,
66	);
67	$window->fill( $rect, $blue );
68	$window->update($rect);
69
70}
71
72eval 'use Test::Valgrind';
73plan skip_all => 'Test::Valgrind is required to test your distribution with valgrind'
74	if $@;
75
76surface_leak();
77
78sleep(2);