Changeset 25812 in project

Timestamp:

01/15/12 14:59:29 (9 years ago)

Author:

Christian Kellermann

Message:

Fix bug #762

Due to a missing conversion procedure in the define-foreign-type
definitions of cairo-font-extents-type and cairo-text-extents-type the
wrapping record has been handed to the C part and not the blob itself
causing stack corruption and segfaults on several systems.

This commit also fixes the record printers for these types.

Uses now C_return instead of a plain return call (just in case).

Thanks to Felix and Peter for teaching about the FFI and support.

File:

• release/4/cairo/trunk/cairo.scm (modified) (4 diffs)

release/4/cairo/trunk/cairo.scm

@@ -309 +309 @@
 
 (define-record-printer (cairo-text-extents-type te out)
-  (for-each (lambda (x) (display x out)
+  (for-each (lambda (x) (display x out))
                     (list "#<cairo-text-extents "
                           (cairo-text-extents-x-bearing te)" "
@@ -316 +316 @@
                           (cairo-text-extents-height te)" "
                           (cairo-text-extents-x-advance te)" "
-                          (cairo-text-extents-y-advance te)">"))))
-
-(define-foreign-type cairo_text_extents_t scheme-pointer)
-
-(define cairo-text-extents-x-bearing (foreign-lambda* double ((cairo_text_extents_t te)) "return(((cairo_text_extents_t*)te)->x_bearing);"))
-(define cairo-text-extents-y-bearing (foreign-lambda* double ((cairo_text_extents_t te)) "return(((cairo_text_extents_t*)te)->y_bearing);"))
-(define cairo-text-extents-width (foreign-lambda* double ((cairo_text_extents_t te)) "return(((cairo_text_extents_t*)te)->width);"))
-(define cairo-text-extents-height (foreign-lambda* double ((cairo_text_extents_t te)) "return(((cairo_text_extents_t*)te)->height);"))
-(define cairo-text-extents-x-advance (foreign-lambda* double ((cairo_text_extents_t te)) "return(((cairo_text_extents_t*)te)->x_advance);"))
-(define cairo-text-extents-y-advance (foreign-lambda* double ((cairo_text_extents_t te)) "return(((cairo_text_extents_t*)te)->y_advance);"))
+                          (cairo-text-extents-y-advance te)">")))
+
+(define-foreign-type cairo_text_extents_t scheme-pointer cairo-text-extents-type-buffer)
+
+(define cairo-text-extents-x-bearing (foreign-lambda* double ((cairo_text_extents_t te)) "C_return(((cairo_text_extents_t*)te)->x_bearing);"))
+(define cairo-text-extents-y-bearing (foreign-lambda* double ((cairo_text_extents_t te)) "C_return(((cairo_text_extents_t*)te)->y_bearing);"))
+(define cairo-text-extents-width (foreign-lambda* double ((cairo_text_extents_t te)) "C_return(((cairo_text_extents_t*)te)->width);"))
+(define cairo-text-extents-height (foreign-lambda* double ((cairo_text_extents_t te)) "C_return(((cairo_text_extents_t*)te)->height);"))
+(define cairo-text-extents-x-advance (foreign-lambda* double ((cairo_text_extents_t te)) "C_return(((cairo_text_extents_t*)te)->x_advance);"))
+(define cairo-text-extents-y-advance (foreign-lambda* double ((cairo_text_extents_t te)) "C_return(((cairo_text_extents_t*)te)->y_advance);"))
 
 (define cairo-text-extents-x-bearing-set! (foreign-lambda* double ((cairo_text_extents_t te) (double v)) "((cairo_text_extents_t*)te)->x_bearing = v;"))
@@ -342 +342 @@
 
 (define-record-printer (cairo-font-extents-type e out)
-  (for-each (lambda (x) (display x out)
+  (for-each (lambda (x) (display x out))
                     (list "#<cairo-font-extents "
                           (cairo-font-extents-ascent e)" "
@@ -348 +348 @@
                           (cairo-font-extents-height e)" "
                           (cairo-font-extents-max-x-advance e)" "
-                          (cairo-font-extents-max-y-advance e)">"))))
-
-(define-foreign-type cairo_font_extents_t scheme-pointer)
-
-(define cairo-font-extents-ascent (foreign-lambda* double ((cairo_font_extents_t e)) "return(((cairo_font_extents_t*)e)->ascent);"))
-(define cairo-font-extents-descent (foreign-lambda* double ((cairo_font_extents_t e)) "return(((cairo_font_extents_t*)e)->descent);"))
-(define cairo-font-extents-height (foreign-lambda* double ((cairo_font_extents_t e)) "return(((cairo_font_extents_t*)e)->height);"))
-(define cairo-font-extents-max-x-advance (foreign-lambda* double ((cairo_font_extents_t e)) "return(((cairo_font_extents_t*)e)->max_x_advance);"))
-(define cairo-font-extents-max-y-advance (foreign-lambda* double ((cairo_font_extents_t e)) "return(((cairo_font_extents_t*)e)->max_y_advance);"))
+                          (cairo-font-extents-max-y-advance e)">")))
+
+(define-foreign-type cairo_font_extents_t scheme-pointer cairo-font-extents-type-buffer)
+
+(define cairo-font-extents-ascent (foreign-lambda* double ((cairo_font_extents_t e)) "C_return(((cairo_font_extents_t*)e)->ascent);"))
+(define cairo-font-extents-descent (foreign-lambda* double ((cairo_font_extents_t e)) "C_return(((cairo_font_extents_t*)e)->descent);"))
+(define cairo-font-extents-height (foreign-lambda* double ((cairo_font_extents_t e)) "C_return(((cairo_font_extents_t*)e)->height);"))
+(define cairo-font-extents-max-x-advance (foreign-lambda* double ((cairo_font_extents_t e)) "C_return(((cairo_font_extents_t*)e)->max_x_advance);"))
+(define cairo-font-extents-max-y-advance (foreign-lambda* double ((cairo_font_extents_t e)) "C_return(((cairo_font_extents_t*)e)->max_y_advance);"))
 
 (define cairo-font-extents-ascent-set! (foreign-lambda* double ((cairo_font_extents_t e) (double v)) "((cairo_font_extents_t*)e)->ascent = v;"))