[perl-Cairo] Cairo::FtFontFace: Keep the FT_Face alive long enough to avoid segfaults

[Torsten Schönfeld <tsch src gnome org>]

commit 9ccb90e596779b375565084e212329a073e549cc
Author: Torsten Schönfeld <kaffeetisch gmx de>
Date:   Sun May 24 21:31:06 2009 +0200

    Cairo::FtFontFace: Keep the FT_Face alive long enough to avoid segfaults
    
    Link the lifetime of the FT_Face to that of the newly created cairo_font_face_t
    by initially increasing the reference count of the SV wrapping the FT_Face and
    decreasing it when the cairo_font_face_t is destroyed.
    
    Test this with a unit test provided by Cornelius.
    
    Also remove FT_Face typemap in favor of manual unwrapping in the only place
    it's used.
---
 CairoFt.xs         |   25 +++++++++++++++++++++++--
 cairo-perl.typemap |    7 -------
 t/CairoFt.t        |   28 ++++++++++++++++++++++++++++
 3 files changed, 51 insertions(+), 9 deletions(-)

diff --git a/CairoFt.xs b/CairoFt.xs
index 971bf5e..a065b34 100644
--- a/CairoFt.xs
+++ b/CairoFt.xs
@@ -8,12 +8,33 @@
 
 #include <cairo-perl.h>
 
+static const cairo_user_data_key_t face_key;
+
 MODULE = Cairo::Ft	PACKAGE = Cairo::FtFontFace PREFIX = cairo_ft_font_face_
 
 # cairo_font_face_t * cairo_ft_font_face_create_for_ft_face (FT_Face face, int load_flags);
 cairo_font_face_t_noinc *
-cairo_ft_font_face_create (class, FT_Face face, int load_flags=0)
+cairo_ft_font_face_create (class, SV *face, int load_flags=0)
+    PREINIT:
+	FT_Face real_face = NULL;
+	cairo_status_t status;
     CODE:
-	RETVAL = cairo_ft_font_face_create_for_ft_face (face, load_flags);
+	if (sv_isobject (face) && sv_derived_from (face, "Font::FreeType::Face")) {
+		real_face = (FT_Face) SvIV ((SV *) SvRV (face));
+	} else {
+		croak("'%s' is not of type Font::FreeType::Face",
+		      SvPV_nolen (face));
+	}
+	RETVAL = cairo_ft_font_face_create_for_ft_face (real_face, load_flags);
+	/* Keep the face SV (and thus the FT_Face) alive long enough */
+	SvREFCNT_inc (face);
+	status = cairo_font_face_set_user_data (
+			RETVAL,
+			&face_key,
+			face, (cairo_destroy_func_t) Perl_sv_free);
+	if (status) {
+		warn ("Couldn't install a user data handler, "
+		      "so an FT_Face will be leaked");
+	}
     OUTPUT:
 	RETVAL
diff --git a/cairo-perl.typemap b/cairo-perl.typemap
index 85adf9f..ed782c7 100644
--- a/cairo-perl.typemap
+++ b/cairo-perl.typemap
@@ -30,13 +30,6 @@ T_CAIRO_GLYPH
 T_CAIRO_PATH
 	$var = SvCairoPath ($arg);
 
-T_FT_FACE
-	if (sv_isobject ($arg) && sv_derived_from ($arg, \"Font::FreeType::Face\")) {
-		$var = ($type) SvIV ((SV *) SvRV ($arg));
-	} else {
-		croak(\"$var is not of type Font::FreeType::Face\");
-	}
-
 OUTPUT
 
 T_CAIRO_FONT_EXTENTS
diff --git a/t/CairoFt.t b/t/CairoFt.t
index 0636f56..aa0ac4a 100644
--- a/t/CairoFt.t
+++ b/t/CairoFt.t
@@ -29,3 +29,31 @@ my $ft_face = Font::FreeType->new->face ($file);
 my $cr_ft_face = Cairo::FtFontFace->create ($ft_face);
 isa_ok ($cr_ft_face, 'Cairo::FontFace');
 is ($cr_ft_face->status, 'success');
+
+
+# make sure freetype font object is correctly referenced
+{
+  sub draw_text {
+    my $cr = shift;
+
+    my $ft_face = Font::FreeType->new->face( $file );
+    my $face = Cairo::FtFontFace->create($ft_face);
+    $cr->set_font_face( $face );
+    $cr->set_font_size( 12 );
+    $cr->translate( 10 , 10 );
+    $cr->show_text( "123 123123" );
+    $cr->stroke;
+  }
+
+  my $surface = Cairo::PdfSurface->create( "test.pdf", 500 , 500 );
+  my $cr = Cairo::Context->create($surface);
+  $cr->save;
+  draw_text( $cr );
+  $cr->set_font_size( 12 );
+  $cr->restore;
+
+  # must call finish() here so that cairo attemps to use the FtFontFace
+  $surface->finish;
+
+  unlink "test.pdf";
+}