From fd67feddab577f8e756c78a9c2b89a9b4a66dbb5 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 6 Aug 2014 08:48:19 +0100 Subject: [PATCH] racket/draw and racket/snip: avoid some undefined-checking wrappers The changes to `pen%` and `brush%` are related to the `racket/class` repair of the previous commit, while the `style%` change is because I didn't look at it before. --- .../draw-lib/racket/draw/private/brush.rkt | 6 +++-- .../draw-lib/racket/draw/private/pen.rkt | 5 ++-- pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl | 7 ++++++ .../gui-test/tests/gracket/editor.rktl | 10 ++++++++ .../snip-lib/racket/snip/private/style.rkt | 25 ++++++++++--------- 5 files changed, 37 insertions(+), 16 deletions(-) diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/brush.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/brush.rkt index 7c4018297b..1a47625c0d 100644 --- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/brush.rkt +++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/brush.rkt @@ -79,8 +79,7 @@ (unless (_stipple . is-a? . bitmap%) (raise-type-error (init-name 'brush%) "bitmap% or #f" - _stipple)) - (set-stipple _stipple)) + _stipple))) (when _transformation (unless (transformation-vector? _transformation) @@ -93,6 +92,9 @@ (super-new) + (when _stipple + (set-stipple _stipple)) + (define/public (set-immutable) (set! immutable? #t)) (define/public (is-immutable?) (or immutable? (positive? lock-count))) (define/public (adjust-lock v) (set! lock-count (+ lock-count v))) diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/pen.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/pen.rkt index 0b7dfa2123..6386ee9f0c 100644 --- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/pen.rkt +++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/pen.rkt @@ -98,11 +98,12 @@ (unless (_stipple . is-a? . bitmap%) (raise-type-error (init-name 'pen%) "bitmap% or #f" - _stipple)) - (set-stipple _stipple)) + _stipple))) (super-new) + (when _stipple (set-stipple _stipple)) + (define/public (set-immutable) (set! immutable? #t)) (define/public (is-immutable?) (or immutable? (positive? lock-count))) (define/public (adjust-lock v) (set! lock-count (+ lock-count v))) diff --git a/pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl b/pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl index 2ea5e80038..da20a6d628 100644 --- a/pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl +++ b/pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl @@ -843,6 +843,13 @@ (st #f (make-bitmap 1000000 1000000) ok?) +;; ---------------------------------------- +;; No # checks on certain class instances + +(test #f 'undef-pen (impersonator? (new pen%))) +(test #f 'undef-brush (impersonator? (new brush%))) +(test #f 'undef-color (impersonator? (new color%))) + ;; ---------------------------------------- (report-errs) diff --git a/pkgs/gui-pkgs/gui-test/tests/gracket/editor.rktl b/pkgs/gui-pkgs/gui-test/tests/gracket/editor.rktl index bdfaf93dff..dd454e76d7 100644 --- a/pkgs/gui-pkgs/gui-test/tests/gracket/editor.rktl +++ b/pkgs/gui-pkgs/gui-test/tests/gracket/editor.rktl @@ -649,6 +649,16 @@ (unless (<= 0 count2 (/ N 2)) (error 'notifications "not weak enough? ~e" count2))) +;; ---------------------------------------- +;; No # checks on certain class instances + +(test #f 'undef-snip (impersonator? (new snip%))) +(test #f 'undef-string-snip% (impersonator? (new string-snip%))) +(test #f 'undef-tab-snip% (impersonator? (new tab-snip%))) +(test #f 'undef-image-snip% (impersonator? (new image-snip%))) +(test #f 'undef-style-delta% (impersonator? (new style-delta%))) +(test #f 'undef-style<%> (impersonator? (send (new style-list%) basic-style))) + ;; ---------------------------------------- (report-errs) diff --git a/pkgs/snip-pkgs/snip-lib/racket/snip/private/style.rkt b/pkgs/snip-pkgs/snip-lib/racket/snip/private/style.rkt index bdf88a2846..90cfcc0bdd 100644 --- a/pkgs/snip-pkgs/snip-lib/racket/snip/private/style.rkt +++ b/pkgs/snip-pkgs/snip-lib/racket/snip/private/style.rkt @@ -599,8 +599,6 @@ s-text-space) (defclass style% object% - (super-new) - (define style-list #f) ;; points back to the list owning the style (define/public (set-s-style-list sl) (set! style-list sl)) @@ -611,15 +609,6 @@ (define join-shift-style #f) (define nonjoin-delta #f) - (define/public (get-s-name) name) - (define/public (set-s-name v) (set! name v)) - (define/public (get-s-base-style) base-style) - (define/public (set-s-base-style v) (set! base-style v)) - (define/public (get-s-join-shift-style) join-shift-style) - (define/public (get-s-nonjoin-delta) nonjoin-delta) - (define/public (set-s-join-shift-style v) (set! join-shift-style v)) - (define/public (set-s-nonjoin-delta v) (set! nonjoin-delta v)) - ;; cache computation: (define trans-text? #f) (field [s-foreground (new color%)] @@ -630,7 +619,7 @@ (field [s-alignment 'bottom]) (define cached-sizes 0) - (define/public (set-s-cached-sizes v) (set! cached-sizes v)) + (field [s-text-width 0.0] [s-text-height 0.0] [s-text-descent 0.0] @@ -638,6 +627,18 @@ (define children null) + (super-new) + + (define/public (get-s-name) name) + (define/public (set-s-name v) (set! name v)) + (define/public (get-s-base-style) base-style) + (define/public (set-s-base-style v) (set! base-style v)) + (define/public (get-s-join-shift-style) join-shift-style) + (define/public (get-s-nonjoin-delta) nonjoin-delta) + (define/public (set-s-join-shift-style v) (set! join-shift-style v)) + (define/public (set-s-nonjoin-delta v) (set! nonjoin-delta v)) + + (define/public (set-s-cached-sizes v) (set! cached-sizes v)) (define/public (s-set-as-basic slist) (set! style-list slist)