t/surfaceML.t

   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
  31 BEGIN {
  32         unshift @INC, 'blib/lib', 'blib/arch';
  33 }
  34
  35 use strict;
  36
  37 use Test::More;
  38
  39 # Don't run tests for installs
  40  unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) {
  41          plan( skip_all => "Author tests not required for installation" );
  42          }
  43
  44
  45 # This is stolen for Gabor's examples in padre's SDL plugin
  46 sub surface_leak()
  47 {
  48         use SDL;
  49         use SDL::App;
  50         use SDL::Rect;
  51         use SDL::Color;
  52
  53         my $window = SDL::App->new(
  54                 -width => 640,
  55                 -height => 480,
  56                 -depth => 16,
  57                 -title => 'SDL Demo',
  58                 -init => SDL_INIT_VIDEO
  59
  60         );
  61
  62         my $rect = SDL::Rect->new(0,0, 10, 20);
  63
  64         my $blue = SDL::Color->new(
  65                 -r => 0x00,
  66                 -g => 0x00,
  67                 -b => 0xff,
  68         );
  69         $window->fill($rect, $blue);
  70         $window->update($rect);
  71
  72 }
  73
  74 eval 'use Test::Valgrind';
  75 plan skip_all => 'Test::Valgrind is required to test your distribution with valgrind' if $@;
  76
  77 surface_leak();
  78
  79
  80