From: Kartik Thakore <thakore.kartik@gmail.com>
Date: Wed, 4 Nov 2009 16:36:18 +0000 (-0500)
Subject: Fixed up new_from. It is usable but it cause wierd XS behaviour so we don't recommend... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b142e2011a2835e38c2a8b87afbcefa38ebf178a;p=sdlgit%2FSDL_perl.git

Fixed up new_from. It is usable but it cause wierd XS behaviour so we don't recommend anyone to use this right now
---

diff --git a/lib/pods/SDL/Surface.pod b/lib/pods/SDL/Surface.pod
index ff53dd5..8b9a8e8 100644
--- a/lib/pods/SDL/Surface.pod
+++ b/lib/pods/SDL/Surface.pod
@@ -17,7 +17,7 @@ The main surface (display) is provided by L<SDL::Video::set_video_mode>.
 All surfaces constructed from now on are attached to the $display. There are two constructors available to do this.
 
   my $surface  = SDL::Surface->new ( ... ); 
-  my $surface2 = SDL::Surface->new_from ( ... ); 
+  my $surface2 = SDL::Surface->new_from ( surface, ... ); 
   
 =head1 DESCRIPTION
 
@@ -27,11 +27,22 @@ An C<SDL_Surface> defines a surfaceangular area of pixels.
 
 =head2 new ( flags, width, height, depth, Rmask, Gmask, Bmask, Amask )
 
-The constructor creates a new surface with the specified x, y, w, h
-values:
+The constructor creates a new surface with the specified parameter values.
 
     my $surface = SDL::Surface->new( ... );
 
+=head2 new_from ( surface, width, height, depth, Rmask, Gmask, Bmask, Amask )
+
+The constructor creates a new surface with the specified parameter values. 
+
+    my $surface = SDL::Surface->new_from( $old_surface, ... );
+
+THIS WILL SEGFAULT!!! Read: http://sdlperl.ath.cx/projects/SDLPerl/ticket/53 
+
+=head3 Construtor Parameters
+
+
+
 =head2 w
 
 SDL::Surface width are defined at construction. Thus the following is read only. 
diff --git a/src/Core/objects/Surface.xs b/src/Core/objects/Surface.xs
index 640791f..f8ae399 100644
--- a/src/Core/objects/Surface.xs
+++ b/src/Core/objects/Surface.xs
@@ -47,8 +47,7 @@ surface_new (CLASS, flags, width, height, depth, Rmask, Gmask, Bmask, Amask )
 
 SDL_Surface *
 surface_new_from (CLASS, pixels, width, height, depth, pitch, Rmask, Gmask, Bmask, Amask )
-	char *CLASS
-	char *pixels
+	char* CLASS
 	int width
 	int height
 	int depth
@@ -57,18 +56,18 @@ surface_new_from (CLASS, pixels, width, height, depth, pitch, Rmask, Gmask, Bmas
 	Uint32 Gmask
 	Uint32 Bmask
 	Uint32 Amask
+	IV pixels
 	CODE:
-		void* pixeldata;
-		int len = pitch * height;
-		Newx(pixeldata,len,Uint8);
-		Copy(pixels,pixeldata,len,Uint8);
-		RETVAL = SDL_CreateRGBSurfaceFrom ( pixeldata, width, height,
-				depth, pitch, Rmask, Gmask, Bmask, Amask );
+		warn ("USING THIS WILL CAUSE YOUR CODE TO SEGFAULT ON EXIT! \n READ: http://sdlperl.ath.cx/projects/SDLPerl/ticket/53");
+		void *p = INT2PTR(void*, pixels);
+		RETVAL = SDL_CreateRGBSurfaceFrom ( p, width, height, depth, pitch, Rmask, Gmask, Bmask, Amask );
+		if( RETVAL == NULL)
+		croak ("SDL_CreateRGBSurfaceFrom failed: %s", SDL_GetError());
+
 	OUTPUT:	
 		RETVAL
 
 
-
 SDL_PixelFormat *
 surface_format ( surface )
 	SDL_Surface *surface
diff --git a/t/core_surface.t b/t/core_surface.t
index 6224818..ca0e2f9 100644
--- a/t/core_surface.t
+++ b/t/core_surface.t
@@ -17,11 +17,10 @@ use SDL::Rect;
 use SDL::Color;
 use SDL::Video;
 use SDL::PixelFormat;
-use Test::More tests => 37;
+use Test::More tests => 36;
 
 my $surface
     = SDL::Surface->new( SDL::SDL_ANYFORMAT(), 640, 320, 8, 0, 0, 0, 0 );
-    #TODO: test SDL::Surface->new_from
 isa_ok( $surface, 'SDL::Surface' );
 is( $surface->w,     640, 'surface has width' );
 is( $surface->h,     320, 'surface has height' );
@@ -98,7 +97,20 @@ SDL::Video::update_rects( $app, $small_rect );
 
 diag( 'This is in surface : ' . SDL::Surface::get_pixels($app) );
 
+SKIP:
+{
+	skip('new_form is segfaulting on DESTROY of created surface. Read: http://sdlperl.ath.cx/projects/SDLPerl/ticket/53', 1); 
 
-pass 'did this pass';
+my $other_surface =  SDL::Surface->new_from( $surface->get_pixels, 640, 320, 8, $surface->pitch, 0, 0, 0, 0 ); 
+
+isa_ok( $other_surface, 'SDL::Surface' );
+
+$surface->DESTROY();
+$other_surface->DESTROY();
+
+}
+pass 'Final SegFault test';
 
 SDL::delay(100);
+
+