t/metaclasses/create_anon_with_required_attr.t

   1 #!/usr/bin/perl
   2
   3 # this functionality may be pushing toward parametric roles/classes
   4 # it's off in a corner and may not be that important
   5
   6 use strict;
   7 use warnings;
   8
   9 use Test::More;
  10 use Test::Fatal;
  11
  12 {
  13     package HasFoo;
  14     use Moose::Role;
  15     has 'foo' => (
  16         is       => 'ro',
  17         isa      => 'Str',
  18         required => 1,
  19     );
  20
  21 }
  22
  23 {
  24     package My::Metaclass;
  25     use Moose;
  26     extends 'Moose::Meta::Class';
  27     with 'HasFoo';
  28 }
  29
  30 package main;
  31
  32 my $anon;
  33 is( exception {
  34     $anon = My::Metaclass->create_anon_class( foo => 'this' );
  35 }, undef, 'create anon class with required attr' );
  36 isa_ok( $anon, 'My::Metaclass' );
  37 cmp_ok( $anon->foo, 'eq', 'this', 'foo is this' );
  38 isnt( exception {
  39     $anon = My::Metaclass->create_anon_class();
  40 }, undef, 'failed to create anon class without required attr' );
  41
  42 my $meta;
  43 is( exception {
  44     $meta
  45         = My::Metaclass->initialize( 'Class::Name1' => ( foo => 'that' ) );
  46 }, undef, 'initialize a class with required attr' );
  47 isa_ok( $meta, 'My::Metaclass' );
  48 cmp_ok( $meta->foo,  'eq', 'that',        'foo is that' );
  49 cmp_ok( $meta->name, 'eq', 'Class::Name1', 'for the correct class' );
  50 isnt( exception {
  51     $meta
  52         = My::Metaclass->initialize( 'Class::Name2' );
  53 }, undef, 'failed to initialize a class without required attr' );
  54
  55 is( exception {
  56     eval qq{
  57         package Class::Name3;
  58         use metaclass 'My::Metaclass' => (
  59             foo => 'another',
  60         );
  61         use Moose;
  62     };
  63     die $@ if $@;
  64 }, undef, 'use metaclass with required attr' );
  65 $meta = Class::Name3->meta;
  66 isa_ok( $meta, 'My::Metaclass' );
  67 cmp_ok( $meta->foo,  'eq', 'another',        'foo is another' );
  68 cmp_ok( $meta->name, 'eq', 'Class::Name3', 'for the correct class' );
  69 isnt( exception {
  70     eval qq{
  71         package Class::Name4;
  72         use metaclass 'My::Metaclass';
  73         use Moose;
  74     };
  75     die $@ if $@;
  76 }, undef, 'failed to use metaclass without required attr' );
  77
  78
  79 # how do we pass a required attribute to -traits?
  80 isnt( exception {
  81     eval qq{
  82         package Class::Name5;
  83         use Moose -traits => 'HasFoo';
  84     };
  85     die $@ if $@;
  86 }, undef, 'failed to use trait without required attr' );
  87
  88 done_testing;