Skip to content
Browse files

Might as well keep track of our internal loader

  • Loading branch information...
1 parent a4a4a33 commit 761448baef6ab338d79e60bb95dc6b26911451bf @kthakore kthakore committed Jul 12, 2010
Showing with 31 additions and 24 deletions.
  1. +2 −1 CHANGELOG
  2. +23 −9 lib/SDL.pm
  3. +2 −0 lib/SDL/Internal/Loader.pm
  4. +4 −14 xt/07_core_memleak.t
View
3 CHANGELOG
@@ -1,8 +1,9 @@
Revision history for Perl extension SDL_perl.
-*
+* 2.502
- Displaying Alien::SDL's build option for every build step [FROGGS]
- Dispalying error message if required shared lib is missing [FROGGS]
+ - Added test and docs for SDLx::Surface
* 2.501 July 10 2010
- Fixes tests for SDLx::TTF and SDL::Surface [FROGGS, kthakore]
View
32 lib/SDL.pm
@@ -41,6 +41,7 @@ require DynaLoader;
use SDL_perl;
use SDL::Constants ':SDL';
+#use SDL::Internal::Loader; See TODO near END{}
our @ISA = qw(Exporter DynaLoader);
use base 'Exporter';
@@ -90,22 +91,35 @@ sub set_error {
SDL::set_error_real(sprintf($format, @arguments));
}
-=pod
+=pod
+#TODO: Make this unload correct for some mem leak fix
END{
return if ($^O =~ 'VMS' || $^O =~ 'darwin');
- my @loaded_modules = @DynaLoader::dl_modules;
+ my $first = pop( @SDL::Internal::Loader::LIBREFS);
+ my $dont_unload = '(^'.$first.'$';
- foreach my $libref ( reverse @DynaLoader::dl_librefs)
- {
- my $module = pop @loaded_modules;
+ $dont_unload .= '|^'.$_.'$' foreach @SDL::Internal::Loader::LIBREFS;
+
+ $dont_unload .= ')';
- if ( $module =~ /SDL/)
- {
- DynaLoader::dl_unload_file($libref); #only unload Modules
- }
+ warn $dont_unload;
+ foreach my $libref ( reverse @DynaLoader::dl_librefs)
+ {
+ unless ($libref =~ /$dont_unload/)
+ {
+ print STDERR 'unloading '.$libref.' ';
+ DynaLoader::dl_unload_file($libref);
+
+ }
+ else
+ {
+ print STDERR 'not unloading '.$libref.' ';
+
+ }
}
}
=cut
+
1;
View
2 lib/SDL/Internal/Loader.pm
@@ -4,6 +4,7 @@ use warnings;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(internal_load_dlls);
+our @LIBREFS = ();
use SDL::ConfigData;
use Alien::SDL;
@@ -44,6 +45,7 @@ sub internal_load_dlls($) {
if($file && -e $file) {
my $libref = DynaLoader::dl_load_file($file, 0);
push(@DynaLoader::dl_librefs, $libref) if $libref;
+ push (@LIBREFS, $libref) if $libref;
}
else {
print(STDERR "###ERROR### shared object file '$file' for '$n' not found.\n");
View
18 xt/07_core_memleak.t
@@ -3,34 +3,24 @@ use strict;
use warnings;
use Test::More;
use SDL;
+use SDL::Rect;
# Don't run tests for installs
use Test::More;
-unless ( $env{automated_testing} or $env{release_testing} ) {
- plan( skip_all => "author tests not required for installation" );
-}
-sub overlay_leak()
+sub leaky()
{
-SDL::Init(SDL_INIT_VIDEO);
-
-my $display = SDL::SetVideoMode(640,480,32, SDL_SWSURFACE );
-
-my $overlay = SDL::Overlay->new( 100, 100, SDL_YV12_OVERLAY, $display);
-
-$overlay = undef;
-
-$display = undef;
+ SDL::Rect->new(0,0,10,10);
}
eval 'use Test::Valgrind';
plan skip_all => 'Test::Valgrind is required to test your distribution with valgrind' if $@;
-overlay_leak();
+leaky();
sleep(2);

0 comments on commit 761448b

Please sign in to comment.
Something went wrong with that request. Please try again.