From: Vincent Pit <vince@profvince.com>
Date: Sun, 22 Aug 2010 13:54:23 +0000 (+0200)
Subject: Fix and test parent validation in LT::Meta::TC::Autocoerce
X-Git-Tag: rt87282~32
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FLaTeX-TikZ.git;a=commitdiff_plain;h=cb4173493eb06b031615951a9deeee12a54361b1

Fix and test parent validation in LT::Meta::TC::Autocoerce
---

diff --git a/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm b/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm
index 0804c7f..c31508b 100644
--- a/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm
+++ b/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm
@@ -89,8 +89,9 @@ use Scalar::Util qw/blessed/;
 
 use Sub::Name ();
 
+use LaTeX::TikZ::Tools;
+
 use Any::Moose;
-use Any::Moose 'Util' => [ 'find_meta' ];
 
 =head1 RELATIONSHIPS
 
@@ -163,10 +164,10 @@ around 'new' => sub {
  }
 
  my $parent = delete $args{parent};
- unless (defined $parent and blessed $parent) {
-  $parent = find_meta($parent);
-  Carp::confess("No meta object for parent $parent");
-  $parent = $parent->type_constraint;
+ unless (blessed $parent) {
+  my $parent_name = defined $parent ? "parent $parent" : 'undefined parent';
+  $parent = LaTeX::TikZ::Tools::type_constraint($parent) if defined $parent;
+  Carp::confess("No meta object for $parent_name")   unless defined $parent;
  }
  __PACKAGE__->meta->find_attribute_by_name('parent')
                   ->type_constraint->assert_valid($parent);
diff --git a/t/02-autocoerce.t b/t/02-autocoerce.t
index 02ab12b..463614b 100644
--- a/t/02-autocoerce.t
+++ b/t/02-autocoerce.t
@@ -3,12 +3,40 @@
 use strict;
 use warnings;
 
-use Test::More tests => 7 * 4;
+use Test::More tests => 3 + 7 * 4;
 
 use lib 't/lib';
 
 use LaTeX::TikZ::Meta::TypeConstraint::Autocoerce;
 
+{
+ my $tc = eval {
+  LaTeX::TikZ::Meta::TypeConstraint::Autocoerce->new(
+   parent => undef,
+  );
+ };
+ like $@, qr/^No meta object for undefined parent/, 'Undef parent';
+}
+
+{
+ my $parent = 'LaTeX::TikZ::A::Class::Likely::Not::To::Exist';
+ my $tc = eval {
+  LaTeX::TikZ::Meta::TypeConstraint::Autocoerce->new(
+   parent => $parent,
+  );
+ };
+ like $@, qr/^No meta object for parent \Q$parent\E/, 'Nonexistent parent';
+}
+
+{
+ my $tc = eval {
+  LaTeX::TikZ::Meta::TypeConstraint::Autocoerce->new(
+   parent => 'LaTeX::TikZ::Meta::TypeConstraint::Autocoerce',
+  );
+ };
+ is $@, '', 'Valid parent';
+}
+
 {
  package LaTeX::TikZ::TestX;