From: Vincent Pit Date: Mon, 2 Aug 2010 09:43:05 +0000 (+0200) Subject: Don't try to load the autocoercion package when calling ->check X-Git-Tag: v0.02~4 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FLaTeX-TikZ.git;a=commitdiff_plain;h=a721d9bb9525aca6118c567455adfc092ea6bba0 Don't try to load the autocoercion package when calling ->check This makes things a little lighter and is conceptually more correct. --- diff --git a/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm b/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm index 165794c..0dc4d9d 100644 --- a/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm +++ b/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm @@ -81,65 +81,58 @@ around 'new' => sub { } my $tc; - $args{constraint} = Sub::Name::subname('_load' => sub { - $tc->load(@_); + $args{constraint} = Sub::Name::subname('_constraint' => sub { + my ($thing) = @_; + + # Remember that when ->check is called inside coerce, a return value of 0 + # means that coercion should take place, while 1 signifies that the value is + # already OK. + + # First, try a possible user defined constraint + my $user = $tc->user_constraint; + if (defined $user) { + my $ok = $user->($thing); + return 1 if $ok; + } + + # Then, it's valid if and only if it passes the parent type constraint + return $tc->parent->check($thing); }); $tc = $class->$orig(%args); }; -=head2 C - -=cut - -sub load { - my ($tc, $thing) = @_; - - # When ->check is called inside coerce, a return value of 0 means that - # coercion should take place, while 1 signifies that the value is already - # OK. - - # First, try a possible user defined constraint - my $user = $tc->user_constraint; - if (defined $user) { - my $ok = $user->($thing); - return 1 if $ok; - } - - # Then, try the parent constraint - return 1 if $tc->parent->check($thing); - - # If $thing isn't even an object, don't bother trying to coerce it - my $class = blessed($thing); - return 0 unless defined $class; - - # Find the file to autoload - my $mapper = $tc->mapper; - my $pm = $class = $tc->$mapper($class); - $pm =~ s{::}{/}g; - $pm .= '.pm'; - return 0 if $INC{$pm}; # already loaded - - local $@; - eval { - # We die often here, even though we're not really interested in the error. - # However, if a die handler is set (e.g. to \&Carp::confess), this can get - # very slow. Resetting the handler shows a 10% total time improvement for the - # geodyn app. - local $SIG{__DIE__}; - require $pm; - }; - - return 0; -} - around 'coerce' => sub { my ($orig, $tc, $thing) = @_; # The original coerce gets an hold onto the type coercions *before* calling # the constraint. Thus, we have to force the loading before recalling into - # $orig. This is achieved by calling ->load. - return $thing if $tc->load($thing); + # $orig. + + # First, check whether $thing is already of the right kind. + return $thing if $tc->check($thing); + + # If $thing isn't even an object, don't bother trying to autoload a coercion + my $class = blessed($thing); + if (defined $class) { + # Find the file to autoload + my $mapper = $tc->mapper; + my $pm = $class = $tc->$mapper($class); + $pm =~ s{::}{/}g; + $pm .= '.pm'; + + unless ($INC{$pm}) { # Not loaded yet + local $@; + eval { + # We die often here, even though we're not really interested in the error. + # However, if a die handler is set (e.g. to \&Carp::confess), this can get + # very slow. Resetting the handler shows a 10% total time improvement for + # the geodyn app. + local $SIG{__DIE__}; + require $pm; + }; + } + } $tc->$orig($thing); };