Moo-2.005005/000755 000000 000000 00000000000 14355634557 012617 5ustar00rootwheel000000 000000 Moo-2.005005/README000644 000000 000000 00000066214 14355634557 013510 0ustar00rootwheel000000 000000 NAME Moo - Minimalist Object Orientation (with Moose compatibility) SYNOPSIS package Cat::Food; use Moo; use strictures 2; use namespace::clean; sub feed_lion { my $self = shift; my $amount = shift || 1; $self->pounds( $self->pounds - $amount ); } has taste => ( is => 'ro', ); has brand => ( is => 'ro', isa => sub { die "Only SWEET-TREATZ supported!" unless $_[0] eq 'SWEET-TREATZ' }, ); has pounds => ( is => 'rw', isa => sub { die "$_[0] is too much cat food!" unless $_[0] < 15 }, ); 1; And elsewhere: my $full = Cat::Food->new( taste => 'DELICIOUS.', brand => 'SWEET-TREATZ', pounds => 10, ); $full->feed_lion; say $full->pounds; DESCRIPTION "Moo" is an extremely light-weight Object Orientation system. It allows one to concisely define objects and roles with a convenient syntax that avoids the details of Perl's object system. "Moo" contains a subset of Moose and is optimised for rapid startup. "Moo" avoids depending on any XS modules to allow for simple deployments. The name "Moo" is based on the idea that it provides almost -- but not quite -- two thirds of Moose. As such, the Moose::Manual can serve as an effective guide to "Moo" aside from the MOP and Types sections. Unlike Mouse this module does not aim at full compatibility with Moose's surface syntax, preferring instead to provide full interoperability via the metaclass inflation capabilities described in "MOO AND MOOSE". For a full list of the minor differences between Moose and Moo's surface syntax, see "INCOMPATIBILITIES WITH MOOSE". WHY MOO EXISTS If you want a full object system with a rich Metaprotocol, Moose is already wonderful. But if you don't want to use Moose, you may not want "less metaprotocol" like Mouse offers, but you probably want "no metaprotocol", which is what Moo provides. "Moo" is ideal for some situations where deployment or startup time precludes using Moose and Mouse: * A command line or CGI script where fast startup is essential * code designed to be deployed as a single file via App::FatPacker * A CPAN module that may be used by others in the above situations "Moo" maintains transparent compatibility with Moose so if you install and load Moose you can use Moo classes and roles in Moose code without modification. Moo -- Minimal Object Orientation -- aims to make it smooth to upgrade to Moose when you need more than the minimal features offered by Moo. MOO AND MOOSE If Moo detects Moose being loaded, it will automatically register metaclasses for your Moo and Moo::Role packages, so you should be able to use them in Moose code without modification. Moo will also create Moose type constraints for Moo classes and roles, so that in Moose classes "isa => 'MyMooClass'" and "isa => 'MyMooRole'" work the same as for Moose classes and roles. Extending a Moose class or consuming a Moose::Role will also work. Extending a Mouse class or consuming a Mouse::Role will also work. But note that we don't provide Mouse metaclasses or metaroles so the other way around doesn't work. This feature exists for Any::Moose users porting to Moo; enabling Mouse users to use Moo classes is not a priority for us. This means that there is no need for anything like Any::Moose for Moo code - Moo and Moose code should simply interoperate without problem. To handle Mouse code, you'll likely need an empty Moo role or class consuming or extending the Mouse stuff since it doesn't register true Moose metaclasses like Moo does. If you need to disable the metaclass creation, add: no Moo::sification; to your code before Moose is loaded, but bear in mind that this switch is global and turns the mechanism off entirely so don't put this in library code. MOO AND CLASS::XSACCESSOR If a new enough version of Class::XSAccessor is available, it will be used to generate simple accessors, readers, and writers for better performance. Simple accessors are those without lazy defaults, type checks/coercions, or triggers. Simple readers are those without lazy defaults. Readers and writers generated by Class::XSAccessor will behave slightly differently: they will reject attempts to call them with the incorrect number of parameters. MOO VERSUS ANY::MOOSE Any::Moose will load Mouse normally, and Moose in a program using Moose - which theoretically allows you to get the startup time of Mouse without disadvantaging Moose users. Sadly, this doesn't entirely work, since the selection is load order dependent - Moo's metaclass inflation system explained above in "MOO AND MOOSE" is significantly more reliable. So if you want to write a CPAN module that loads fast or has only pure perl dependencies but is also fully usable by Moose users, you should be using Moo. For a full explanation, see the article which explains the differing strategies in more detail and provides a direct example of where Moo succeeds and Any::Moose fails. PUBLIC METHODS Moo provides several methods to any class using it. new Foo::Bar->new( attr1 => 3 ); or Foo::Bar->new({ attr1 => 3 }); The constructor for the class. By default it will accept attributes either as a hashref, or a list of key value pairs. This can be customized with the "BUILDARGS" method. does if ($foo->does('Some::Role1')) { ... } Returns true if the object composes in the passed role. DOES if ($foo->DOES('Some::Role1') || $foo->DOES('Some::Class1')) { ... } Similar to "does", but will also return true for both composed roles and superclasses. meta my $meta = Foo::Bar->meta; my @methods = $meta->get_method_list; Returns an object that will behave as if it is a Moose metaclass object for the class. If you call anything other than "make_immutable" on it, the object will be transparently upgraded to a genuine Moose::Meta::Class instance, loading Moose in the process if required. "make_immutable" itself is a no-op, since we generate metaclasses that are already immutable, and users converting from Moose had an unfortunate tendency to accidentally load Moose by calling it. LIFECYCLE METHODS There are several methods that you can define in your class to control construction and destruction of objects. They should be used rather than trying to modify "new" or "DESTROY" yourself. BUILDARGS around BUILDARGS => sub { my ( $orig, $class, @args ) = @_; return { attr1 => $args[0] } if @args == 1 && !ref $args[0]; return $class->$orig(@args); }; Foo::Bar->new( 3 ); This class method is used to transform the arguments to "new" into a hash reference of attribute values. The default implementation accepts a hash or hash reference of named parameters. If it receives a single argument that isn't a hash reference it will throw an error. You can override this method in your class to handle other types of options passed to the constructor. This method should always return a hash reference of named options. FOREIGNBUILDARGS sub FOREIGNBUILDARGS { my ( $class, $options ) = @_; return $options->{foo}; } If you are inheriting from a non-Moo class, the arguments passed to the parent class constructor can be manipulated by defining a "FOREIGNBUILDARGS" method. It will receive the same arguments as "BUILDARGS", and should return a list of arguments to pass to the parent class constructor. BUILD sub BUILD { my ($self, $args) = @_; die "foo and bar cannot be used at the same time" if exists $args->{foo} && exists $args->{bar}; } On object creation, any "BUILD" methods in the class's inheritance hierarchy will be called on the object and given the results of "BUILDARGS". They each will be called in order from the parent classes down to the child, and thus should not themselves call the parent's method. Typically this is used for object validation or possibly logging. DEMOLISH sub DEMOLISH { my ($self, $in_global_destruction) = @_; ... } When an object is destroyed, any "DEMOLISH" methods in the inheritance hierarchy will be called on the object. They are given boolean to inform them if global destruction is in progress, and are called from the child class upwards to the parent. This is similar to "BUILD" methods but in the opposite order. Note that this is implemented by a "DESTROY" method, which is only created on on the first construction of an object of your class. This saves on overhead for classes that are never instantiated or those without "DEMOLISH" methods. If you try to define your own "DESTROY", this will cause undefined results. IMPORTED SUBROUTINES extends extends 'Parent::Class'; Declares a base class. Multiple superclasses can be passed for multiple inheritance but please consider using roles instead. The class will be loaded but no errors will be triggered if the class can't be found and there are already subs in the class. Calling extends more than once will REPLACE your superclasses, not add to them like 'use base' would. with with 'Some::Role1'; or with 'Some::Role1', 'Some::Role2'; Composes one or more Moo::Role (or Role::Tiny) roles into the current class. An error will be raised if these roles cannot be composed because they have conflicting method definitions. The roles will be loaded using the same mechanism as "extends" uses. has has attr => ( is => 'ro', ); Declares an attribute for the class. package Foo; use Moo; has 'attr' => ( is => 'ro' ); package Bar; use Moo; extends 'Foo'; has '+attr' => ( default => sub { "blah" }, ); Using the "+" notation, it's possible to override an attribute. has [qw(attr1 attr2 attr3)] => ( is => 'ro', ); Using an arrayref with multiple attribute names, it's possible to declare multiple attributes with the same options. The options for "has" are as follows: "is" required, may be "ro", "lazy", "rwp" or "rw". "ro" stands for "read-only" and generates an accessor that dies if you attempt to write to it - i.e. a getter only - by defaulting "reader" to the name of the attribute. "lazy" generates a reader like "ro", but also sets "lazy" to 1 and "builder" to "_build_${attribute_name}" to allow on-demand generated attributes. This feature was my attempt to fix my incompetence when originally designing "lazy_build", and is also implemented by MooseX::AttributeShortcuts. There is, however, nothing to stop you using "lazy" and "builder" yourself with "rwp" or "rw" - it's just that this isn't generally a good idea so we don't provide a shortcut for it. "rwp" stands for "read-write protected" and generates a reader like "ro", but also sets "writer" to "_set_${attribute_name}" for attributes that are designed to be written from inside of the class, but read-only from outside. This feature comes from MooseX::AttributeShortcuts. "rw" stands for "read-write" and generates a normal getter/setter by defaulting the "accessor" to the name of the attribute specified. "isa" Takes a coderef which is used to validate the attribute. Unlike Moose, Moo does not include a basic type system, so instead of doing "isa => 'Num'", one should do use Scalar::Util qw(looks_like_number); ... isa => sub { die "$_[0] is not a number!" unless looks_like_number $_[0] }, Note that the return value for "isa" is discarded. Only if the sub dies does type validation fail. Sub::Quote aware Since Moo does not run the "isa" check before "coerce" if a coercion subroutine has been supplied, "isa" checks are not structural to your code and can, if desired, be omitted on non-debug builds (although if this results in an uncaught bug causing your program to break, the Moo authors guarantee nothing except that you get to keep both halves). If you want Moose compatible or MooseX::Types style named types, look at Type::Tiny. To cause your "isa" entries to be automatically mapped to named Moose::Meta::TypeConstraint objects (rather than the default behaviour of creating an anonymous type), set: $Moo::HandleMoose::TYPE_MAP{$isa_coderef} = sub { require MooseX::Types::Something; return MooseX::Types::Something::TypeName(); }; Note that this example is purely illustrative; anything that returns a Moose::Meta::TypeConstraint object or something similar enough to it to make Moose happy is fine. "coerce" Takes a coderef which is meant to coerce the attribute. The basic idea is to do something like the following: coerce => sub { $_[0] % 2 ? $_[0] : $_[0] + 1 }, Note that Moo will always execute your coercion: this is to permit "isa" entries to be used purely for bug trapping, whereas coercions are always structural to your code. We do, however, apply any supplied "isa" check after the coercion has run to ensure that it returned a valid value. Sub::Quote aware If the "isa" option is a blessed object providing a "coerce" or "coercion" method, then the "coerce" option may be set to just 1. "handles" Takes a string handles => 'RobotRole' Where "RobotRole" is a role that defines an interface which becomes the list of methods to handle. Takes a list of methods handles => [ qw( one two ) ] Takes a hashref handles => { un => 'one', } "trigger" Takes a coderef which will get called any time the attribute is set. This includes the constructor, but not default or built values. The coderef will be invoked against the object with the new value as an argument. If you set this to just 1, it generates a trigger which calls the "_trigger_${attr_name}" method on $self. This feature comes from MooseX::AttributeShortcuts. Note that Moose also passes the old value, if any; this feature is not yet supported. Sub::Quote aware "default" Takes a coderef which will get called with $self as its only argument to populate an attribute if no value for that attribute was supplied to the constructor. Alternatively, if the attribute is lazy, "default" executes when the attribute is first retrieved if no value has yet been provided. If a simple scalar is provided, it will be inlined as a string. Any non-code reference (hash, array) will result in an error - for that case instead use a code reference that returns the desired value. Note that if your default is fired during new() there is no guarantee that other attributes have been populated yet so you should not rely on their existence. Sub::Quote aware "predicate" Takes a method name which will return true if an attribute has a value. If you set this to just 1, the predicate is automatically named "has_${attr_name}" if your attribute's name does not start with an underscore, or "_has_${attr_name_without_the_underscore}" if it does. This feature comes from MooseX::AttributeShortcuts. "builder" Takes a method name which will be called to create the attribute - functions exactly like default except that instead of calling $default->($self); Moo will call $self->$builder; The following features come from MooseX::AttributeShortcuts: If you set this to just 1, the builder is automatically named "_build_${attr_name}". If you set this to a coderef or code-convertible object, that variable will be installed under "$class::_build_${attr_name}" and the builder set to the same name. "clearer" Takes a method name which will clear the attribute. If you set this to just 1, the clearer is automatically named "clear_${attr_name}" if your attribute's name does not start with an underscore, or "_clear_${attr_name_without_the_underscore}" if it does. This feature comes from MooseX::AttributeShortcuts. NOTE: If the attribute is "lazy", it will be regenerated from "default" or "builder" the next time it is accessed. If it is not lazy, it will be "undef". "lazy" Boolean. Set this if you want values for the attribute to be grabbed lazily. This is usually a good idea if you have a "builder" which requires another attribute to be set. "required" Boolean. Set this if the attribute must be passed on object instantiation. "reader" The name of the method that returns the value of the attribute. If you like Java style methods, you might set this to "get_foo" "writer" The value of this attribute will be the name of the method to set the value of the attribute. If you like Java style methods, you might set this to "set_foo". "weak_ref" Boolean. Set this if you want the reference that the attribute contains to be weakened. Use this when circular references, which cause memory leaks, are possible. "init_arg" Takes the name of the key to look for at instantiation time of the object. A common use of this is to make an underscored attribute have a non-underscored initialization name. "undef" means that passing the value in on instantiation is ignored. "moosify" Takes either a coderef or array of coderefs which is meant to transform the given attributes specifications if necessary when upgrading to a Moose role or class. You shouldn't need this by default, but is provided as a means of possible extensibility. before before foo => sub { ... }; See "before method(s) => sub { ... };" in Class::Method::Modifiers for full documentation. around around foo => sub { ... }; See "around method(s) => sub { ... };" in Class::Method::Modifiers for full documentation. after after foo => sub { ... }; See "after method(s) => sub { ... };" in Class::Method::Modifiers for full documentation. SUB QUOTE AWARE "quote_sub" in Sub::Quote allows us to create coderefs that are "inlineable," giving us a handy, XS-free speed boost. Any option that is Sub::Quote aware can take advantage of this. To do this, you can write use Sub::Quote; use Moo; use namespace::clean; has foo => ( is => 'ro', isa => quote_sub(q{ die "Not <3" unless $_[0] < 3 }) ); which will be inlined as do { local @_ = ($_[0]->{foo}); die "Not <3" unless $_[0] < 3; } or to avoid localizing @_, has foo => ( is => 'ro', isa => quote_sub(q{ my ($val) = @_; die "Not <3" unless $val < 3 }) ); which will be inlined as do { my ($val) = ($_[0]->{foo}); die "Not <3" unless $val < 3; } See Sub::Quote for more information, including how to pass lexical captures that will also be compiled into the subroutine. CLEANING UP IMPORTS Moo will not clean up imported subroutines for you; you will have to do that manually. The recommended way to do this is to declare your imports first, then "use Moo", then "use namespace::clean". Anything imported before namespace::clean will be scrubbed. Anything imported or declared after will be still be available. package Record; use Digest::MD5 qw(md5_hex); use Moo; use namespace::clean; has name => (is => 'ro', required => 1); has id => (is => 'lazy'); sub _build_id { my ($self) = @_; return md5_hex($self->name); } 1; For example if you were to import these subroutines after namespace::clean like this use namespace::clean; use Digest::MD5 qw(md5_hex); use Moo; then any "Record" $r would have methods such as "$r->md5_hex()", "$r->has()" and "$r->around()" - almost certainly not what you intend! Moo::Roles behave slightly differently. Since their methods are composed into the consuming class, they can do a little more for you automatically. As long as you declare your imports before calling "use Moo::Role", those imports and the ones Moo::Role itself provides will not be composed into consuming classes so there's usually no need to use namespace::clean. On namespace::autoclean: Older versions of namespace::autoclean would inflate Moo classes to full Moose classes, losing the benefits of Moo. If you want to use namespace::autoclean with a Moo class, make sure you are using version 0.16 or newer. INCOMPATIBILITIES WITH MOOSE TYPES There is no built-in type system. "isa" is verified with a coderef; if you need complex types, Type::Tiny can provide types, type libraries, and will work seamlessly with both Moo and Moose. Type::Tiny can be considered the successor to MooseX::Types and provides a similar API, so that you can write use Types::Standard qw(Int); has days_to_live => (is => 'ro', isa => Int); API INCOMPATIBILITIES "initializer" is not supported in core since the author considers it to be a bad idea and Moose best practices recommend avoiding it. Meanwhile "trigger" or "coerce" are more likely to be able to fulfill your needs. No support for "super", "override", "inner", or "augment" - the author considers augment to be a bad idea, and override can be translated: override foo => sub { ... super(); ... }; around foo => sub { my ($orig, $self) = (shift, shift); ... $self->$orig(@_); ... }; The "dump" method is not provided by default. The author suggests loading Devel::Dwarn into "main::" (via "perl -MDevel::Dwarn ..." for example) and using "$obj->$::Dwarn()" instead. "default" only supports coderefs and plain scalars, because passing a hash or array reference as a default is almost always incorrect since the value is then shared between all objects using that default. "lazy_build" is not supported; you are instead encouraged to use the "is => 'lazy'" option supported by Moo and MooseX::AttributeShortcuts. "auto_deref" is not supported since the author considers it a bad idea and it has been considered best practice to avoid it for some time. "documentation" will show up in a Moose metaclass created from your class but is otherwise ignored. Then again, Moose ignores it as well, so this is arguably not an incompatibility. Since "coerce" does not require "isa" to be defined but Moose does require it, the metaclass inflation for coerce alone is a trifle insane and if you attempt to subtype the result will almost certainly break. Handling of warnings: when you "use Moo" we enable strict and warnings, in a similar way to Moose. The authors recommend the use of "strictures", which enables FATAL warnings, and several extra pragmas when used in development: indirect, multidimensional, and bareword::filehandles. Additionally, Moo supports a set of attribute option shortcuts intended to reduce common boilerplate. The set of shortcuts is the same as in the Moose module MooseX::AttributeShortcuts as of its version 0.009+. So if you: package MyClass; use Moo; use strictures 2; The nearest Moose invocation would be: package MyClass; use Moose; use warnings FATAL => "all"; use MooseX::AttributeShortcuts; or, if you're inheriting from a non-Moose class, package MyClass; use Moose; use MooseX::NonMoose; use warnings FATAL => "all"; use MooseX::AttributeShortcuts; META OBJECT There is no meta object. If you need this level of complexity you need Moose - Moo is small because it explicitly does not provide a metaprotocol. However, if you load Moose, then Class::MOP::class_of($moo_class_or_role) will return an appropriate metaclass pre-populated by Moo. IMMUTABILITY Finally, Moose requires you to call __PACKAGE__->meta->make_immutable; at the end of your class to get an inlined (i.e. not horribly slow) constructor. Moo does it automatically the first time ->new is called on your class. ("make_immutable" is a no-op in Moo to ease migration.) An extension MooX::late exists to ease translating Moose packages to Moo by providing a more Moose-like interface. COMPATIBILITY WITH OLDER PERL VERSIONS Moo is compatible with perl versions back to 5.6. When running on older versions, additional prerequisites will be required. If you are packaging a script with its dependencies, such as with App::FatPacker, you will need to be certain that the extra prerequisites are included. MRO::Compat Required on perl versions prior to 5.10.0. Devel::GlobalDestruction Required on perl versions prior to 5.14.0. SUPPORT IRC: #moose on irc.perl.org Bugtracker: Git repository: Git browser: AUTHOR mst - Matt S. Trout (cpan:MSTROUT) CONTRIBUTORS dg - David Leadbeater (cpan:DGL) frew - Arthur Axel "fREW" Schmidt (cpan:FREW) hobbs - Andrew Rodland (cpan:ARODLAND) jnap - John Napiorkowski (cpan:JJNAPIORK) ribasushi - Peter Rabbitson (cpan:RIBASUSHI) chip - Chip Salzenberg (cpan:CHIPS) ajgb - Alex J. G. Burzyński (cpan:AJGB) doy - Jesse Luehrs (cpan:DOY) perigrin - Chris Prather (cpan:PERIGRIN) Mithaldu - Christian Walde (cpan:MITHALDU) ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) tobyink - Toby Inkster (cpan:TOBYINK) haarg - Graham Knop (cpan:HAARG) mattp - Matt Phillips (cpan:MATTP) bluefeet - Aran Deltac (cpan:BLUEFEET) bubaflub - Bob Kuo (cpan:BUBAFLUB) ether = Karen Etheridge (cpan:ETHER) COPYRIGHT Copyright (c) 2010-2015 the Moo "AUTHOR" and "CONTRIBUTORS" as listed above. LICENSE This library is free software and may be distributed under the same terms as perl itself. See . Moo-2.005005/Changes000644 000000 000000 00000073065 14355634531 014115 0ustar00rootwheel000000 000000 Revision history for Moo 2.005005 - 2023-01-05 - drop dependency on Test::Fatal 2.005004 - 2021-03-29 - fix file set in %INC in create_class_with_roles (RT#134845) 2.005003 - 2021-03-21 - silence 'once' warnings from Moo::_Utils 2.005_002 - 2021-01-22 - fix C3 test skipping properly when MRO::Compat not available on perl < 5.10 2.005_001 - 2021-01-20 - fix perl version check in global destruction code 2.005_000 - 2021-01-20 - remove MooseX::Types from developer prereqs - recommend Sub::Util rather than Sub::Name, since Sub::Util is in core - fix line numbers when using oo module (perl -Moo) - adjust some author tests to rely less on external modules - lower Exporter prereq to any version - bump Role::Tiny prereq to 2.003004 - refactor and simplify role application code, as allowed by new Role::Tiny version - switch to using normal strict+warnings rather than strictures for authors - remove strictures from recommends, as Moo does not use it anywhere - remove Task::Weaken prereq, as it served no purpose - remove MRO::Compat prereq, using it only when user code does - remove use of Devel::GlobalDestruction in code, only using Devel::GlobalDestruction::XS when it is available. Devel::GlobalDestruction is still a dependency on perl < 5.14 to facilitate the installation of the ::XS module. - Moo now has no mandatory perl version specific dependencies. The version specific modules are now optional or not used. This means code using Moo can be fatpacked on a new perl version without special cases, and it will work on older perl versions. 2.004004 - 2020-11-25 - fix error location test when using core Carp on perl 5.8.9 - 5.10.1 2.004003 - 2020-11-21 - fix extraneous MANIFEST entry 2.004002 - 2020-11-20 - no changes - releasing as stable 2.004_001 - 2020-07-30 - remove Module::Runtime prerequisite - internal code cleanups - added test for conflicts in extensions wrapping 'has' and similar subs 2.004000 - 2020-04-09 - minor documentation tweaks - minor test tweaks - refactor creation and installation of helper subs allowing extensions to customize the behavior easier. - added is_class and make_class methods to Moo - added make_role method to Moo::Role - lower Scalar::Util dependency to 1.00 - fix unlikely failure to properly inflate Type::Tiny types to Moose under threads on perl 5.8 2.003006 - 2019-10-25 - update Role::Tiny prerequisite to 2.001004 to fix issues with re-importing Moo::Role 2.003_005 - 2019-10-18 - always exclude helper subs (has, with, etc) from the list of methods, even if they are installed later or wrapped with a modifier - drop Devel::GlobalDestruction prerequisite unless using perl < 5.14 - fix preserving full accuracy of numbers in non-ref defaults - fix tracking of stubs and constants as methods to be consistent and work properly with unusual ways of storing subs (RT#130050) - fix test for modules broken by newer Moo versions when new enough CPAN::Meta version is not available - fix undeferring subs before wrapping with a method modifier when subs to wrap are given as a list or array ref - fix error reporting locations from Carp calls in DEMOLISH (RT#124845) - fix extending attributes (has +) to allow overriding a default with a builder (RT#130361) - fix re-throwing Moose inflation exceptions when examining exception objects on older Moose or Devel::StackTrace versions - reorganized documentation related to Moose to improve clarity - improved documentation of usage with namespace::clean - various documentation tweaks 2.003004 - 2017-12-01 - re-allow stubs for attribute parameters like isa or coerce (RT#123753) - fix accidentally removed space in coderef error message (GH#33) - fix test errors with old Carp versions 2.003003 - 2017-11-16 - test tweaks - fix handling of code refs stored directly in the stash (for perl 5.28) - consider inline packages with constants in them as being loaded - stubs will be treated as methods that exist when inflating to Moose - avoid loading overload.pm unless required 2.003002 - 2017-03-28 - ensure tarball does not contain SCHILY headers 2.003001 - 2017-03-06 - fix +attributes replacing builder subs if parent attribute was defined with builder => $subref - fix trigger with a default value and init_arg of undef 2.003000 - 2016-12-09 - fix create_class_with_roles being used multiple times with the same packages - fix edge case with @ISA assignment on perl 5.10.0 - minor test adjustments - fix handles on oddly named attributes - make has options linkable in documentation - Sub::Quote and Sub::Defer have been split into a separate dist 2.002005 - 2016-10-31 - fix accessor extensions that need captured variables for clearers and predicates. (RT#118453) - avoid relying on '.' being in @INC in tests - fix Sub::Quote test when run with perl -C or PERL_UNICODE on perl 5.10 (RT#117844) - improved error messages for invalid sub names in Sub::Quote (RT#116416, RT#117711) - clarify meta method documentation - bump Role::Tiny prereq version to get stub in role fix (RT#116674) 2.002004 - 2016-06-28 - fixed another case of local functions interfering with generated code. (RT#115655) - prevent infinite recursion on some Moose metaclass inflation errors. 2.002003 - 2016-06-23 - prevent local functions with same names as core functions from interfering with generated code (RT#115529) - Work around nmake bug that corrupts commands that include slashes (RT#115518) - Fix tests to work when lexical features are enabled outside of our control (such as with cperl) - Fix tests on perl 5.6 2.002002 - 2016-06-21 - fix handling of Carp < 1.12 2.002_001 - 2016-06-17 - added Sub::Quote::sanitize_identifier to generate an identifier from an arbitrary string. - Sub::Defer::defer_info is now exportable. - improved documentation for Sub::Quote. - fix quoted subs with no_defer ignoring no_install option. (RT#114605) - internals of Sub::Quote were refactored. - error message when @ISA changes now includes the location that the constructor was generated. - original invoker will be used when calling a non-Moo parent constructor. (RT#115189) - added testing for preserving context into quote_sub subs. (RT#114511) - quote_sub context options will be used even when zero. (RT#114512) - Sub::Defer::defer_sub gained attributes option to specify sub attributes. - Sub::Quote::quote_sub gained attributes option to specify sub attributes. 2.002_000 - 2016-05-18 - Use Carp::croak rather than die to improve reported error locations (RT#109844, RT#109632, RT#102622) - removed Method::Inliner module. It was never intended to ship with Moo, and was undocumented, untested, and unused on CPAN. - require Role::Tiny 2.000002 for fixes to method modifiers being applied via multiple role composition paths (RT#106668) - Delay loading Class::Method::Modifiers until we actually need it - Fix an explosion that could happen if meta inflation was attempted part way through Moo's bootstrapping process, which was possible via a CORE::GLOBAL::bless override (RT#113743) - Accessor subs will be generated immediately, rather than being partially deferred. The deferal added extra sub layers and the delayed compilation didn't provide any real benefit for them. - Numeric values used as defaults will be inlined as numbers rather than strings. - Numerous test cleanups and additional test coverage - Fixed a typo in Sub::Defer docs (RT#113416) - Deferred subs (including constructors) will always be named properly, even if neither Sub::Name nor Sub::Util are available. This improves compatibility with namespace::autoclean, among other things. Once the sub is undeferred, it may not be given a correct name if Sub::Name or Sub::Util aren't available. 2.001001 - 2016-03-04 - Fixed order of attribute value being set and trigger running when there is an isa check present. (RT#112677) - Corrected LIFECYCLE METHODS to be a head1 section rather than head2. 2.001000 - 2016-02-29 * Documentation - Added documentation for has's ability to accept an arrayref of attribute names to create with the same options. - Removed mention that we may not call BUILDARGS, since that behavior was removed in 2.000002. - Reorganized documentation of class methods to separate those provided as a public API (new/does/meta) from those used by Moo in the object lifecycle (BUILDARGS/FOREIGNBUILDARGS/BUILD/DEMOLISH). - Updated documentation of most class methods for clarity. - Updated BUILDARGS documentation to show an around rather than just overriding. - Added examples to FOREIGNBUILDARGS and BUILD. - Added explicit documentation for DOES and meta methods. * Fixes - Fixed grammar in error message when @ISA is changed unexpectedly before a constructor is fully generated. - Fixed Moo classes and Sub::Quote subs in packages that are nearly 252 characters long. - Fixed Sub::Defer::undefer_package emitting warnings. - Fixed detection of constructors that have already been inlined. * Performance - The generated code in constructors and setters has had a number of microoptimizations applied. - Deferred subs (and quoted subs like some accessors) in roles will be undefered before copying them to classes. This prevents the need for a goto on every call that would slow down the subs. - Fixed Moose inflation code resulting in constructors with deferred wrappers. * Other - Recommend Sub::Name 0.08, which fixes a memory leak. - The values given to BUILD subs will be the original values passed to new, rather than after coercions have been applied. This brings the behavior in line with Moose. 2.000002 - 2015-07-24 - BUILDARGS will now always be called on object creation, even if no attributes exist - fix required attributes with spaces or other odd characters in init_arg - fix (is => 'lazy', required => 1, init_arg => undef), which previously didn't think it provided a builder - under 'no Moo::sification', prevent automatic Moose metaclass inflation from ->meta calls - don't load Moo::Role for a ->does check if no roles could exist - make global destruction test more robust from outside interference - fix false default values satisfying required attributes - Fix Moose attribute delegation to a Moo class via a wildcard - work around case where Sub::Util is loadable but doesn't provide Sub::Util::set_subname - skip thread tests on perl 5.8.4 and below where threads are extremely unreliable - Allow stub methods (e.g. sub foo;) to be overwritten by accessors or other generated methods. (RT#103804) 2.000001 - 2015-03-16 - Fix how we pick between Sub::Name and Sub::Util if they are both loaded. This fixes how we interact with Moose in some cases. (RT#102729) (GH#15) 2.000000 - 2015-03-02 * Incompatible Changes - Fatal warnings and the other additional checks from the strictures module will no longer be applied to modules using Moo or Moo::Role. We now only apply strict and (non-fatal) warnings, matching the behavior of Moose. - Classes without attributes used to store everything passed to ->new in the object. This has been fixed to not store anything in the object, making it consistent with classes that had attributes. - Moo will now pass __no_BUILD__ to parent constructors when inheriting from a Moose or Class::Tiny class, to prevent them from calling BUILD functions. Moo calls the BUILD functions itself, which previously led to them being called multiple times. - Attempting to replace an existing constructor, or modify one that has been used, will throw an error. This includes adding attributes. Previously, this would result in some attributes being silently ignored by the constructor. - If a class's @ISA is modified without using 'extends' in a way that affects object construction, Moo will detect this and throw an error. This can happen in code that uses ->load_components from Class::C3::Componentised, which is common in DBIx::Class modules. * Bug Fixes - Fix calling class methods on Moo::HandleMoose::FakeMetaClass, such as modules scanning all classes * Miscellaneous - use Sub::Util instead of Sub::Name if available 1.007000 - 2015-01-21 - fix Moose metaclass inflation of Method::Generate::Constructor (RT#101111) - clarify behavior of clearers for non-lazy attribute defaults - add Sub::Defer::undefer_package to undefer all subs from a given package - existing attributes will no longer be overwritten when composing roles. Previously, the attribute configuration used by the constructor would be overridden, but the attribute methods would not be. This caused a mismatch in attribute behavior. - link to Type::Tiny in docs rather than MooX::Types::MooseLike - document exports of Sub::Defer - fix capture_unroll usage in inlinify example - fix needless re-assigning of variables in generated Sub::Quote subs - fix global destruction test to work when perl path has spaces 1.006001 - 2014-10-22 - Name the ->DOES method installed by Role::Tiny - don't apply threading workarounds on non-threaded perls, even if module for it is loaded by something - avoid loading base.pm and just set @ISA manually - fix some Pod links to Class::Method::Modifiers - fix applying roles with multiple attributes with defaults to objects (RT#99217) - fix Moose inheriting from a Moo class that inherits from a non-M* class when the Moose class is not made immutable - fix ->does method on Moose child classes of Moo classes 1.006000 - 2014-08-16 - support coerce => 1 in attributes, taking the coercion from the isa option if it is an object that supports the coerce or coercion method. - add attribute information to type check errors by trapping with an eval rather than overriding the global __DIE__ handler - bump Module::Runtime prerequisite to fix error messages when there is a missing module used by a role loaded using 'with' or similar (rt#97669) 1.005000 - 2014-06-10 - add qsub to Sub::Quote as a prototyped alternative to quote_sub, accepting only the sub body - avoid testing UTF-8 on perl 5.6 1.004006 - 2014-05-27 - fix quotify for characters in the \x80-\xFF range when used under the utf8 pragma. Also fixes some cases of constructor generation with the pragma. 1.004005 - 2014-05-23 - releasing 1.004_004 as stable 1.004_004 - 2014-05-12 - stop internally depending on Moo::Object::new including all inputs in constructed object - be more careful when munging code for inlining - fix maintaining source of quoted sub for lifetime of sub - redo foreign C3 compatibility, fixing constructors without changing behavior for Moo constructors - don't build Moose metaclass when checking Moo classes with ->is_role - include Sub::Name in recommendations metadata 1.004_003 - 2014-04-13 - always maintain source of quoted subs for the lifetime of the sub - fix Sub::Quote and Sub::Defer leaking memory - Class::XSAccessor is now listed as a recommended prerequisite - fix generating a subclass with roles when using a non-standard accessor - use alternate quoting routine, which is faster and saves memory by not loading B.pm - fix default of undef - fix inheriting from a class with a prototype on new - use ->is_role internally to check if a package is a role - minimise Role::Tiny coupling outside Moo::Role - fix calling parent constructor when C3 multiple inheritance is in use (such as when combining with DBIx::Class) - return true from Moo::Role->is_role for all loaded Moose roles - improved test coverage - fix strictures author test when PERL_STRICTURES_EXTRA is set - remove Dist::CheckConflicts prerequisite and replace with a test to report known broken downstream modules - fix x_breaks metadata 1.004002 - 2013-12-31 - fix type inflation in threads when types are inserted by manually stringifying the type first (like Type::Tiny) - add undefer_all to Sub::Defer 1.004001 - 2013-12-27 - fix repository links in pod - add missing changelog entry regarding strictures to 1.004000 release 1.004000 - 2013-12-26 - strictures will now be applied to modules using Moo just as if they included "use strictures" directly. This means that strictures extra checks will now apply to code in checkouts. - fix handling of type inflation when used with threads - don't include meta method when consuming Mouse roles - inhale Moose roles for has attr => ( handles => "RoleName" ) - provide useful error if attribute defined as required but with init_arg => undef - document that BUILDARGS isn't called when there are no attributes - omit sub imported before use Moo from Moose method inflation - check for FOREIGNBUILDARGS only once per class instead of on each instantiation - take advantage of XS predicates from newer versions of Class::XSAccessor - always try to load superclasses and roles, and only fall back on the heuristic of checking for subs if the file doesn't exist - fix handling of attributes with names that aren't valid identifiers - Quoted subs now preserve the package and pragmas from their calling code - the official Moo git repository has moved to the Moose organization on GitHub: https://github.com/moose/Moo 1.003001 - 2013-09-10 - abbreviate class names from created by create_class_with_roles if they are too long for perl to handle (RT#83248) - prevent destructors from failing in global destruction for certain combinations of Moo and Moose classes subclassing each other (RT#87810) - clarify in docs that Sub::Quote's captured variables are copies, not aliases - fix infinite recursion if an isa check fails due to another isa check (RT#87575) - fix Sub::Quote and Sub::Defer under threads (RT#87043) - better diagnostics when bad parameters given to has 1.003000 - 2013-07-15 - fix composing roles that require methods provided by the other (RT#82711) - document optional use of Class::XSAccessor with caveats - fix constructor generated when creating a class with create_class_with_roles when the superclass constructor hasn't been generated yet - fix extending the constructor generator using Moo classes/roles - non-lazy attribute defaults are used when applying a role to an object - updated META files to list prerequisites in proper phases - $Method::Generate::Accessor::CurrentAttribute hashref contains information about attribute currently being processed (available to exception objects thrown by "isa" and "coerce") - properly die when composing a module that isn't a Role - fix passing attribute parameters for traits when inflating to Moose - fix inflating method modifiers applied to multiple methods - fix documentation for Sub::Quote::capture_unroll - add documentation noting Sub::Quote's use of strictures - fix FOREIGNBUILDARGS not being called if no attributes created 1.002000 - 2013-05-04 - add 'moosify' attribute key to provide code for inflating to Moose - fix warnings about unknown attribute parameters on metaclass inflation - don't pass 'handles' down when doing 'has +' to avoid unDWIMmy explosions - throw a useful exception when typemap doesn't return a value - avoid localising @_ when not required for Sub::Quote - successfully inflate a metaclass for attributeless classes (RT#86415) - fix false default values used with non-lazy accessors - stop built values that fail isa checks still getting stored in the object - stop lazy+weak_ref accessors re-building their value on every call - make lazy+weak_ref accessors return undef if built value isn't already stored elsewhere (Moose compatibility) - stop isa checks being called on every access for lazy attributes - bump Devel::GlobalDestruction dependency to fix warning on cleanup when run under -c (RT#78617) - document Moose type constraint creation for roles and classes (actually fixed in 1.001000) 1.001000 - 2013-03-16 - add support for FOREIGNBUILDARGS when inheriting from non-Moo classes - non-ref default values are allowed without using a sub - has will refuse to overwrite locally defined subs with generated accessors. - added more meta resources and added more support relevant links into the POD documentation - clarify in docs that default and built values won't call triggers (RT#82310) - expand is => 'lazy' doc to make it clear that you can make rw lazy attributes if you really want to - handles => "RoleName" tries to load the module - fix delegation to false/undef attributes (RT#83361) 1.000008 - 2013-02-06 - Re-export on 'use Moo' after 'no Moo' - Export meta() into roles (but mark as non-method to avoid composing it) - Don't generate an accessor for rw attributes if reader+writer both set - Support builder => sub {} ala MooseX::AttributeShortcuts - Fix 'no Moo;' to preserve non-sub package variables - Switch to testing for Mouse::Util->can('find_meta') to avoid exploding on ancient Mouse installs - Fix loading order bug that results in _install_coderef being treated as indirect object notation 1.000007 - 2012-12-15 - Correctly handle methods dragged along by role composition - Die if Moo and Moo::Role are imported into the same package 1.000006 - 2012-11-16 - Don't use $_ as loop variable when calling arbitrary code (RT#81072) - Bump Role::Tiny prereq to fix method modifier breakage on 5.10.0 1.000005 - 2012-10-23 - fix POD typo (RT#80060) - include init_arg name in constructor errors (RT#79596) - bump Class::Method::Modifiers dependency to avoid warnings on 5.8 1.000004 - 2012-10-03 - allow 'has \@attributes' like Moose does 1.000003 - 2012-08-09 - make setter for weak_ref attributes return the value 1.000002 - 2012-08-04 - remove Devel::GlobalDestruction fallback inlining because we can now depend on 0.08 which uses Sub::Exporter::Progressive - honour BUILDARGS when calling $meta->new_object on behalf of Moose - throw an error on invalid builder (RT#78479) - fix stupid typo in new Sub::Quote section 1.000001 - 2012-07-21 - documentation tweaks and cleanup - ignore required when default or builder is present - document Moo versus Any::Moose in brief with article link - remove quote_sub from SYNOPSIS and has docs, expand Sub::Quote section - localize @_ when inlining quote_sub'ed isa checks (fixes lazy+isa+default) - ensure constructor gets regenerated if forced early by metaclass inflation 1.000000 - 2012-07-18 - clean up doc language and expand on Moo and Moose - error prefixes for isa and coerce exceptions - unmark Moo and Moose as experimental since it's relatively solid now - convert isa and coerce info from external role attributes - clear method cache after metaclass generation to fix autoclean bug 0.091014 - 2012-07-16 - load overload.pm explicitly for overload::StrVal 0.091013 - 2012-07-15 - useful and detailed errors for coerce in attrib generation 0.091012 - 2012-07-15 - useful and detailed errors for default checker in attrib generation - throw an error when trying to extend a role 0.091011 - 2012-06-27 - re-add #web-simple as development IRC - don't assume Scalar::Util is imported into the current package 0.091010 - 2012-06-26 - isa checks on builders - additional quote_sub docs - remove multi-populate code to fix exists/defined new() bug - document move to #moose and include repository metadata - no Moo and no Moo::Role - squelch used only once warnings for $Moo::HandleMoose::MOUSE - MooClass->meta - subconstructor handling for Moose classes 0.091009 - 2012-06-20 - squelch redefine warnings in the coderef installation code 0.091008 - 2012-06-19 - bump Role::Tiny dependency to get working modifiers under composition - handle "has '+foo'" for attrs from superclass or consumed role - document override -> around translation - use D::GD if installed rather than re-adding it as a requirement 0.091007 - 2012-05-17 - remove stray reference to Devel::GlobalDestruction 0.091006 - 2012-05-16 - drop a couple of dependencies by minor releases we don't strictly need 0.091005 - 2012-05-14 - temporary switch to an inlined in_global_destruction to avoid needing to fatpack Sub::Exporter for features we don't use - re-order is documentation to give readonly styles more prominence - a weakened value should still be returned on set (fixes lazy + weak_ref) - add an explicit return to all exported subs so people don't accidentally rely on the return value 0.091004 - 2012-05-07 - also inhale from Mouse - clarify how isa and coerce interact - support isa and coerce together for Moose - guard _accessor_maker_for calls in Moo::Role in case Moo isn't loaded - reset handlemoose state on mutation in case somebody reified the metaclass too early 0.091003 - 2012-05-06 - improve attribute option documentation - update the incompatibilities section since we're less incompatible now - fix coderef naming to avoid confusing autoclean 0.091002 - 2012-05-05 - exclude union roles and same-role-as-self from metaclass inflation - inhale Moose roles before checking for composition conflicts - enable Moo::sification if only Moo::Role is loaded and not Moo - preserve attribute ordering - factor out accessor generation code a bit more to enable extension 0.091001 - 2012-05-02 - bump Role::Tiny dependency to require de-strictures-ed version - fix test failure where Class::XSAccessor is not available 0.091000 - 2012-04-27 - document MX::AttributeShortcuts 009+ support - documentation for the metaclass inflation code - better error message for broken BUILDARGS - provide 'no Moo::sification' to forcibly disable metaclass inflation - switch to Devel::GlobalDestruction to correctly disarm the Moo::sification trigger under threads - make extends after has work - name subs if Sub::Name is available for better stracktraces - undefer all subs before creating a concrete Moose metaclass - fix bug in _load_module where global vars could cause mis-detection of the module already being loaded 0.009_017 - 2012-04-16 - mangle constructor meta-method on inflation so make_immutable works - fix possible infinite loop caused by subconstructor code 0.009_016 - 2012-04-12 - don't accidentally load Moo::HandleMoose during global destruction - better docs for trigger (and initializer's absence) 0.009_015 - 2012-04-11 - Complete support for MooseX::AttributeShortcuts 0.009 - Allow Moo classes to compose Moose roles - Introduce Moo::HandleMoose, which should allow Moo classes and roles to be treated as Moose classes/roles. Supported so far: - Some level of attributes and methods for both classes and roles - Required methods in roles - Method modifiers in roles (they're already applied in classes) - Type constraints 0.009014 - 2012-03-29 - Split Role::Tiny out into its own dist - Fix a bug where coercions weren't called on lazy default/builder returns - Switch Moo::Utils to using Module::Runtime, and add the 5.8 %INC leakage fix into Role::Tiny's _load_module to provide partial parity - Update incompatibilities with Moose documentation - Remove Sub::Quote's outstanding queue since it doesn't actually slow things down to do it this way and makes debugging easier. - Revert 'local $@' around require calls to avoid triggering Unknown Error - Explicitly require Role::Tiny in Role::Tiny::With (RT#70446) - Fix spurious 'once' warnings under perl -w 0.009013 - 2011-12-23 - fix up Class::XSAccessor version check to be more robust - improved documentation - fix failures on perls < 5.8.3 - fix test failures on cygwin 0.009012 - 2011-11-15 - make Method::Generate::Constructor handle $obj->new - fix bug where constants containing a reference weren't handled correctly (ref(\[]) is 'REF' not 'SCALAR', ref(\v1) is 'VSTRING') 0.009011 - 2011-10-03 - add support for DEMOLISH - add support for BUILDARGS 0.009010 - 2011-07-20 - missing new files for Role::Tiny::With 0.009009 - 2011-07-20 - remove the big scary warning because we seem to be mostly working now - perl based getter dies if @_ > 1 (XSAccessor already did) - add Role::Tiny::With for use in classes - automatically generate constructors in subclasses when required so that subclasses with a BUILD method but no attributes get it honoured - add coerce handling 0.009008 - 2011-06-03 - transfer fix to _load_module to Role::Tiny and make a note it's an inline - Bring back 5.8.1 compat 0.009007 - 2011-02-25 - I botched the copyright. re-disting. 0.009006 - 2011-02-25 - handle non-lazy default and builder when init_arg is undef - add copyright and license info for downstream packagers - weak ref checking for Sub::Quote to avoid bugs on refaddr reuse - Switch composed role names to be a valid package name 0.9.5 Tue Jan 11 2011 - Fix clobberage of runtime-installed wrappers by Sub::Defer - Fix nonMoo constructor firing through multiple layers of Moo - Fix bug where nonMoo is mistakenly detected given a Moo superclass with no attributes (and hence no own constructor) 0.9.4 Mon Dec 13 2010 - Automatic detection on non-Moo superclasses 0.9.3 Sun Dec 5 2010 - Fix _load_module to deal with pre-existing subpackages 0.9.2 Wed Nov 17 2010 - Add explanation of Moo's existence - Change @ISA setting mechanism to deal with a big in 5.10.0's get_linear_isa - Change 5.10 checks to >= to not try and load MRO::Compat on 5.10.0 - Make 'perl -Moo' DTRT 0.9.1 Tue Nov 16 2010 - Initial release Moo-2.005005/MANIFEST000644 000000 000000 00000007117 14355634557 013756 0ustar00rootwheel000000 000000 Changes lib/Method/Generate/Accessor.pm lib/Method/Generate/BuildAll.pm lib/Method/Generate/Constructor.pm lib/Method/Generate/DemolishAll.pm lib/Moo.pm lib/Moo/_Utils.pm lib/Moo/HandleMoose.pm lib/Moo/HandleMoose/_TypeMap.pm lib/Moo/HandleMoose/FakeMetaClass.pm lib/Moo/Object.pm lib/Moo/Role.pm lib/Moo/sification.pm lib/oo.pm maint/Makefile.PL.include Makefile.PL MANIFEST This list of files t/accessor-coerce.t t/accessor-default.t t/accessor-generator-extension.t t/accessor-handles.t t/accessor-isa.t t/accessor-mixed.t t/accessor-pred-clear.t t/accessor-reader-writer.t t/accessor-roles.t t/accessor-shortcuts.t t/accessor-trigger.t t/accessor-weaken-pre-5_8_3.t t/accessor-weaken.t t/buildall-subconstructor.t t/buildall.t t/buildargs-error.t t/buildargs.t t/coerce-1.t t/compose-conflicts.t t/compose-non-role.t t/compose-roles.t t/constructor-modify.t t/croak-locations.t t/demolish-basics.t t/demolish-bugs-eats_exceptions.t t/demolish-bugs-eats_mini.t t/demolish-global_destruction.t t/demolish-throw.t t/does.t t/extend-constructor.t t/extends-non-moo.t t/extends-role.t t/foreignbuildargs.t t/global-destruction-helper.pl t/global_underscore.t t/has-array.t t/has-before-extends.t t/has-plus.t t/init-arg.t t/isa-interfere.t t/lazy_isa.t t/lib/CaptureException.pm t/lib/ErrorLocation.pm t/lib/InlineModule.pm t/lib/TestEnv.pm t/load_module.t t/load_module_error.t t/load_module_role_tiny.t t/long-package-name.t t/method-generate-accessor.t t/method-generate-constructor.t t/modifiers.t t/modify_lazy_handlers.t t/moo-accessors.t t/moo-c3.t t/moo-object.t t/moo-utils-_name_coderef.t t/moo-utils-_subname-Sub-Name.t t/moo-utils-_subname.t t/moo-utils.t t/moo.t t/mutual-requires.t t/no-build.t t/no-moo.t t/non-moo-extends-c3.t t/non-moo-extends.t t/not-both.t t/not-methods.t t/overloaded-coderefs.t t/overridden-core-funcs.t t/role-conflicts-moox.t t/sub-and-handles.t t/subconstructor.t t/undef-bug.t t/use-after-no.t t/zzz-check-breaks.t xt/bless-override.t xt/class-tiny.t xt/croak-locations.t xt/fakemetaclass.t xt/global-destruct-jenga-helper.pl xt/global-destruct-jenga.t xt/handle_moose.t xt/has-after-meta.t xt/implicit-moose-types.t xt/inflate-our-classes.t xt/inflate-undefer.t xt/jenga.t xt/lib/FatalWarnings.pm xt/moo-attr-handles-moose-role.t xt/moo-consume-moose-role-coerce.t xt/moo-consume-moose-role-multiple.t xt/moo-consume-mouse-role-coerce.t xt/moo-does-moose-role.t xt/moo-does-mouse-role.t xt/moo-extend-moose.t xt/moo-inflate.t xt/moo-object-meta-can.t xt/moo-role-types.t xt/moo-roles-into-moose-class-attr-override-with-autoclean.t xt/moo-roles-into-moose-class.t xt/moo-sification-handlemoose.t xt/moo-sification-meta.t xt/moo-sification.t xt/moose-accessor-isa.t xt/moose-autoclean-lazy-attr-builders.t xt/moose-consume-moo-role-after-consumed-by-moo.t xt/moose-consume-moo-role-no-moo-loaded.t xt/moose-does-moo-role.t xt/moose-extend-moo.t xt/moose-handles-moo-class.t xt/moose-inflate-error-recurse.t xt/moose-lazy.t xt/moose-method-modifiers.t xt/moose-override-attribute-from-moo-role.t xt/moose-override-attribute-with-plus-syntax.t xt/more-jenga.t xt/release/kwalitee.t xt/role-tiny-inflate.t xt/super-jenga.t xt/test-my-dependents.t xt/type-inflate-coercion.t xt/type-inflate-threads.t xt/type-inflate-type-tiny.t xt/type-inflate.t xt/type-tiny-coerce.t xt/withautoclean.t xt/zzz-prereq-versions.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) README README file (added by Distar) LICENSE LICENSE file (added by Distar) Moo-2.005005/LICENSE000644 000000 000000 00000043502 14355634557 013630 0ustar00rootwheel000000 000000 Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2023 by mst - Matt S. Trout (cpan:MSTROUT) . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2023 by mst - Matt S. Trout (cpan:MSTROUT) . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Moo-2.005005/t/000755 000000 000000 00000000000 14355634555 013060 5ustar00rootwheel000000 000000 Moo-2.005005/xt/000755 000000 000000 00000000000 14355634555 013250 5ustar00rootwheel000000 000000 Moo-2.005005/META.yml000644 000000 000000 00000002360 14355634556 014070 0ustar00rootwheel000000 000000 --- abstract: 'Minimalist Object Orientation (with Moose compatibility)' author: - 'mst - Matt S. Trout (cpan:MSTROUT) ' build_requires: Test::More: '0.94' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Moo no_index: directory: - t - xt recommends: Class::XSAccessor: '1.18' Sub::Util: '0' requires: Carp: '0' Class::Method::Modifiers: '1.10' Exporter: '0' Role::Tiny: '2.002003' Scalar::Util: '1.00' Sub::Defer: '2.006006' Sub::Quote: '2.006006' perl: '5.006' resources: IRC: irc://irc.perl.org/#moose bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Moo license: https://dev.perl.org/licenses/ repository: https://github.com/moose/Moo.git version: '2.005005' x_authority: cpan:MSTROUT x_breaks: App::Commando: '<= 0.012' File::DataClass: '<= 0.54.1' HTML::Restrict: '== 2.1.5' MooX::Emulate::Class::Accessor::Fast: '<= 0.02' MySQL::Workbench::Parser: '<= 0.05' WebService::Shutterstock: '<= 0.006' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Moo-2.005005/META.json000644 000000 000000 00000004773 14355634557 014253 0ustar00rootwheel000000 000000 { "abstract" : "Minimalist Object Orientation (with Moose compatibility)", "author" : [ "mst - Matt S. Trout (cpan:MSTROUT) " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Moo", "no_index" : { "directory" : [ "t", "xt" ] }, "prereqs" : { "build" : { "requires" : {} }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Class::Tiny" : "1.001", "Moose" : "1.15", "Mouse" : "0", "Type::Tiny" : "0.004", "namespace::autoclean" : "0", "namespace::clean" : "0" } }, "runtime" : { "recommends" : { "Class::XSAccessor" : "1.18", "Sub::Util" : "0" }, "requires" : { "Carp" : "0", "Class::Method::Modifiers" : "1.10", "Exporter" : "0", "Role::Tiny" : "2.002003", "Scalar::Util" : "1.00", "Sub::Defer" : "2.006006", "Sub::Quote" : "2.006006", "perl" : "5.006" } }, "test" : { "recommends" : { "CPAN::Meta::Requirements" : "0", "Parse::CPAN::Meta" : "1.4200" }, "requires" : { "Test::More" : "0.94" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Moo@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Moo" }, "license" : [ "https://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "https://github.com/moose/Moo.git", "web" : "https://github.com/moose/Moo" }, "x_IRC" : "irc://irc.perl.org/#moose" }, "version" : "2.005005", "x_authority" : "cpan:MSTROUT", "x_breaks" : { "App::Commando" : "<= 0.012", "File::DataClass" : "<= 0.54.1", "HTML::Restrict" : "== 2.1.5", "MooX::Emulate::Class::Accessor::Fast" : "<= 0.02", "MySQL::Workbench::Parser" : "<= 0.05", "WebService::Shutterstock" : "<= 0.006" }, "x_serialization_backend" : "JSON::PP version 4.07" } Moo-2.005005/lib/000755 000000 000000 00000000000 14355634555 013363 5ustar00rootwheel000000 000000 Moo-2.005005/maint/000755 000000 000000 00000000000 14355634555 013725 5ustar00rootwheel000000 000000 Moo-2.005005/Makefile.PL000644 000000 000000 00000011536 14355631427 014570 0ustar00rootwheel000000 000000 use strict; use warnings; use 5.006; my %META = ( name => 'Moo', license => 'perl_5', prereqs => { configure => { requires => { 'ExtUtils::MakeMaker' => 0, } }, build => { requires => { } }, test => { requires => { 'Test::More' => '0.94', }, recommends => { 'Parse::CPAN::Meta' => '1.4200', 'CPAN::Meta::Requirements' => 0, }, }, runtime => { requires => { 'perl' => '5.006', 'Scalar::Util' => '1.00', 'Exporter' => 0, 'Carp' => 0, 'Class::Method::Modifiers' => '1.10', # for RT#80194 'Role::Tiny' => '2.002003', 'Sub::Quote' => '2.006006', 'Sub::Defer' => '2.006006', }, recommends => { 'Class::XSAccessor' => '1.18', 'Sub::Util' => '0', }, }, develop => { requires => { 'Class::Tiny' => '1.001', 'Moose' => '1.15', 'Mouse' => 0, 'namespace::autoclean' => 0, 'namespace::clean' => 0, 'Type::Tiny' => '0.004', }, }, }, resources => { repository => { url => 'https://github.com/moose/Moo.git', web => 'https://github.com/moose/Moo', type => 'git', }, x_IRC => 'irc://irc.perl.org/#moose', bugtracker => { web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Moo', mailto => 'bug-Moo@rt.cpan.org', }, license => [ 'https://dev.perl.org/licenses/' ], }, no_index => { directory => [ 't', 'xt' ] }, x_breaks => { 'HTML::Restrict' => '== 2.1.5', 'MySQL::Workbench::Parser' => '<= 0.05', 'MooX::Emulate::Class::Accessor::Fast' => '<= 0.02', 'WebService::Shutterstock' => '<= 0.006', 'File::DataClass' => '<= 0.54.1', 'App::Commando' => '<= 0.012', }, x_authority => 'cpan:MSTROUT', ); my $xt = $ENV{EXTENDED_TESTING}; my %MM_ARGS = ( PREREQ_PM => { ("$]" < 5.014_000 ? ('Devel::GlobalDestruction' => '0.11') : ()), }, ($xt ? ( TEST_REQUIRES => { %{ $META{prereqs}{runtime}{recommends} }, %{ $META{prereqs}{test}{recommends} }, %{ $META{prereqs}{develop}{requires} }, }, test => { TESTS => 't/*.t xt/*.t' }, ):()), ); { package MY; sub test_via_harness { my($self, $perl, $tests) = @_; $perl .= ' -I'.$self->catdir('t','lib').' "-MTestEnv=$(MOO_TEST_ENV)"'; return $self->SUPER::test_via_harness($perl, $tests); } sub postamble { my $MOO_TEST_ENV = (!-f 'META.yml' || $xt) ? "MOO_FATAL_WARNINGS" : ''; ($xt ? <<"XT" : '') test :: test_no_xs XT .<<"POSTAMBLE" MOO_TEST_ENV=$MOO_TEST_ENV fulltest: test test_no_xs \t\$(NOECHO) \$(NOOP) test_no_xs: \$(TEST_TYPE)_no_xs \t\$(NOECHO) \$(NOOP) POSTAMBLE .join('', map <<"TEST_TYPE", 'dynamic', 'static', '') test_${_}_no_xs: pure_all \t\$(NOECHO)\$(MAKE) test_$_ MOO_TEST_ENV="\$(MOO_TEST_ENV),MOO_XS_DISABLE" TEST_TYPE } } ## BOILERPLATE ############################################################### require ExtUtils::MakeMaker; (do './maint/Makefile.PL.include' or die $@) unless -f 'META.yml'; # have to do this since old EUMM dev releases miss the eval $VERSION line my $eumm_version = eval $ExtUtils::MakeMaker::VERSION; my $mymeta = $eumm_version >= 6.57_02; my $mymeta_broken = $mymeta && $eumm_version < 6.57_07; ($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g; ($MM_ARGS{VERSION_FROM} = "lib/$MM_ARGS{NAME}.pm") =~ s{::}{/}g; $META{license} = [ $META{license} ] if $META{license} && !ref $META{license}; $MM_ARGS{LICENSE} = $META{license}[0] if $META{license} && $eumm_version >= 6.30; $MM_ARGS{NO_MYMETA} = 1 if $mymeta_broken; $MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META } unless -f 'META.yml'; $MM_ARGS{PL_FILES} ||= {}; $MM_ARGS{NORECURS} = 1 if not exists $MM_ARGS{NORECURS}; for (qw(configure build test runtime)) { my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; my $r = $MM_ARGS{$key} = { %{$META{prereqs}{$_}{requires} || {}}, %{delete $MM_ARGS{$key} || {}}, }; defined $r->{$_} or delete $r->{$_} for keys %$r; } $MM_ARGS{MIN_PERL_VERSION} = delete $MM_ARGS{PREREQ_PM}{perl} || 0; delete $MM_ARGS{MIN_PERL_VERSION} if $eumm_version < 6.47_01; $MM_ARGS{BUILD_REQUIRES} = {%{$MM_ARGS{BUILD_REQUIRES}}, %{delete $MM_ARGS{TEST_REQUIRES}}} if $eumm_version < 6.63_03; $MM_ARGS{PREREQ_PM} = {%{$MM_ARGS{PREREQ_PM}}, %{delete $MM_ARGS{BUILD_REQUIRES}}} if $eumm_version < 6.55_01; delete $MM_ARGS{CONFIGURE_REQUIRES} if $eumm_version < 6.51_03; ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS); ## END BOILERPLATE ########################################################### Moo-2.005005/maint/Makefile.PL.include000644 000000 000000 00000000532 14107734701 017306 0ustar00rootwheel000000 000000 BEGIN { -e 'Distar' or system qw(git clone https://github.com/p5sagit/Distar.git) } use lib 'Distar/lib'; use Distar 0.001; use ExtUtils::MakeMaker 6.57_10 (); author 'mst - Matt S. Trout (cpan:MSTROUT) '; manifest_include t => 'global-destruction-helper.pl'; manifest_include xt => 'global-destruct-jenga-helper.pl'; 1; Moo-2.005005/lib/Method/000755 000000 000000 00000000000 14355634555 014603 5ustar00rootwheel000000 000000 Moo-2.005005/lib/Moo/000755 000000 000000 00000000000 14355634555 014115 5ustar00rootwheel000000 000000 Moo-2.005005/lib/oo.pm000644 000000 000000 00000002464 13777354515 014346 0ustar00rootwheel000000 000000 package oo; use strict; use warnings; use Moo::_Utils qw(_load_module); sub moo { print <<'EOMOO'; ______ < Moo! > ------ \ ^__^ \ (oo)\_______ (__)\ )\/\ ||----w | || || EOMOO exit 0; } my $package; sub import { moo() if $0 eq '-'; $package = $_[1] || 'Class'; if ($package =~ s/^\+//) { _load_module($package); } my $line = (caller)[2] || 1; require Filter::Util::Call; my $done; Filter::Util::Call::filter_add(sub { if (!$done) { s{\A}{package $package;\nuse Moo;\n#line $line\n}; $done = 1; } return Filter::Util::Call::filter_read(); }); } 1; __END__ =head1 NAME oo - syntactic sugar for Moo oneliners =head1 SYNOPSIS perl -Moo=Foo -e 'has bar => ( is => q[ro], default => q[baz] ); print Foo->new->bar' # loads an existing class and re-"opens" the package definition perl -Moo=+My::Class -e 'print __PACKAGE__->new->bar' =head1 DESCRIPTION oo.pm is a simple source filter that adds C to the beginning of your script, intended for use on the command line via the -M option. =head1 SUPPORT See L for support and contact information. =head1 AUTHORS See L for authors. =head1 COPYRIGHT AND LICENSE See L for the copyright and license. =cut Moo-2.005005/lib/Moo.pm000644 000000 000000 00000103072 14355634440 014447 0ustar00rootwheel000000 000000 package Moo; use strict; use warnings; no warnings 'once'; use Moo::_Utils qw( _check_tracked _getglob _getstash _install_coderef _install_modifier _install_tracked _linear_isa _load_module _set_loaded _unimport_coderefs ); use Carp qw(croak); BEGIN { our @CARP_NOT = qw( Method::Generate::Constructor Method::Generate::Accessor Moo::sification Moo::_Utils Moo::Role ); } our $VERSION = '2.005005'; $VERSION =~ tr/_//d; require Moo::sification; Moo::sification->import; our %MAKERS; sub import { my $target = caller; my $class = shift; if ($INC{'Role/Tiny.pm'} and Role::Tiny->is_role($target)) { croak "Cannot import Moo into a role"; } _set_loaded(caller); strict->import; warnings->import; $class->_install_subs($target, @_); $class->make_class($target); return; } sub make_class { my ($me, $target) = @_; my $makers = $MAKERS{$target} ||= {}; return $target if $makers->{is_class}; my $stash = _getstash($target); $makers->{non_methods} = { map +($_ => \&{"${target}::${_}"}), grep exists &{"${target}::${_}"}, grep !/::\z/ && !/\A\(/, keys %$stash }; $makers->{is_class} = 1; { no strict 'refs'; @{"${target}::ISA"} = do { require Moo::Object; ('Moo::Object'); } unless @{"${target}::ISA"}; } if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) { Moo::HandleMoose::inject_fake_metaclass_for($target); } return $target; } sub is_class { my ($me, $class) = @_; return $MAKERS{$class} && $MAKERS{$class}{is_class}; } sub _install_subs { my ($me, $target) = @_; my %install = $me->_gen_subs($target); _install_tracked $target => $_ => $install{$_} for sort keys %install; return; } sub _gen_subs { my ($me, $target) = @_; return ( extends => sub { $me->_set_superclasses($target, @_); $me->_maybe_reset_handlemoose($target); return; }, with => sub { require Moo::Role; Moo::Role->apply_roles_to_package($target, @_); $me->_maybe_reset_handlemoose($target); }, has => sub { my $name_proto = shift; my @name_proto = ref $name_proto eq 'ARRAY' ? @$name_proto : $name_proto; if (@_ % 2 != 0) { croak "Invalid options for " . join(', ', map "'$_'", @name_proto) . " attribute(s): even number of arguments expected, got " . scalar @_; } my %spec = @_; foreach my $name (@name_proto) { # Note that when multiple attributes specified, each attribute # needs a separate \%specs hashref my $spec_ref = @name_proto > 1 ? +{%spec} : \%spec; $me->_constructor_maker_for($target) ->register_attribute_specs($name, $spec_ref); $me->_accessor_maker_for($target) ->generate_method($target, $name, $spec_ref); $me->_maybe_reset_handlemoose($target); } return; }, (map { my $type = $_; ( $type => sub { _install_modifier($target, $type, @_); return; }, ) } qw(before after around)), ); } sub unimport { my $target = caller; _unimport_coderefs($target); } sub _set_superclasses { my $class = shift; my $target = shift; foreach my $superclass (@_) { _load_module($superclass); if ($INC{'Role/Tiny.pm'} && Role::Tiny->is_role($superclass)) { croak "Can't extend role '$superclass'"; } } @{*{_getglob("${target}::ISA")}} = @_; if (my $old = delete $Moo::MAKERS{$target}{constructor}) { $old->assert_constructor; delete _getstash($target)->{new}; Moo->_constructor_maker_for($target) ->register_attribute_specs(%{$old->all_attribute_specs}); } elsif (!$target->isa('Moo::Object')) { Moo->_constructor_maker_for($target); } $Moo::HandleMoose::MOUSE{$target} = [ grep defined, map Mouse::Util::find_meta($_), @_ ] if Mouse::Util->can('find_meta'); } sub _maybe_reset_handlemoose { my ($class, $target) = @_; if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) { Moo::HandleMoose::maybe_reinject_fake_metaclass_for($target); } } sub _accessor_maker_for { my ($class, $target) = @_; return unless $MAKERS{$target}; $MAKERS{$target}{accessor} ||= do { my $maker_class = do { no strict 'refs'; if (my $m = do { my @isa = @{_linear_isa($target)}; shift @isa; if (my ($parent_new) = grep +(defined &{$_.'::new'}), @isa) { $MAKERS{$parent_new} && $MAKERS{$parent_new}{accessor}; } else { undef; } }) { ref($m); } else { require Method::Generate::Accessor; 'Method::Generate::Accessor' } }; $maker_class->new; } } sub _constructor_maker_for { my ($class, $target) = @_; return unless $MAKERS{$target}; $MAKERS{$target}{constructor} ||= do { require Method::Generate::Constructor; my %construct_opts = ( package => $target, accessor_generator => $class->_accessor_maker_for($target), subconstructor_handler => ( ' if ($Moo::MAKERS{$class}) {'."\n" .' if ($Moo::MAKERS{$class}{constructor}) {'."\n" .' package '.$target.';'."\n" .' return $invoker->SUPER::new(@_);'."\n" .' }'."\n" .' '.$class.'->_constructor_maker_for($class);'."\n" .' return $invoker->new(@_)'.";\n" .' } elsif ($INC{"Moose.pm"} and my $meta = Class::MOP::get_metaclass_by_name($class)) {'."\n" .' return $meta->new_object('."\n" .' $class->can("BUILDARGS") ? $class->BUILDARGS(@_)'."\n" .' : $class->Moo::Object::BUILDARGS(@_)'."\n" .' );'."\n" .' }'."\n" ), ); my $con; my @isa = @{_linear_isa($target)}; shift @isa; no strict 'refs'; if (my ($parent_new) = grep +(defined &{$_.'::new'}), @isa) { if ($parent_new eq 'Moo::Object') { # no special constructor needed } elsif (my $makers = $MAKERS{$parent_new}) { $con = $makers->{constructor}; $construct_opts{construction_string} = $con->construction_string if $con; } elsif ($parent_new->can('BUILDALL')) { $construct_opts{construction_builder} = sub { my $inv = $target->can('BUILDARGS') ? '' : 'Moo::Object::'; 'do {' .' my $args = $class->'.$inv.'BUILDARGS(@_);' .' $args->{__no_BUILD__} = 1;' .' $invoker->'.$target.'::SUPER::new($args);' .'}' }; } else { $construct_opts{construction_builder} = sub { '$invoker->'.$target.'::SUPER::new(' .($target->can('FOREIGNBUILDARGS') ? '$class->FOREIGNBUILDARGS(@_)' : '@_') .')' }; } } ($con ? ref($con) : 'Method::Generate::Constructor') ->new(%construct_opts) ->install_delayed ->register_attribute_specs(%{$con?$con->all_attribute_specs:{}}) } } sub _concrete_methods_of { my ($me, $class) = @_; my $makers = $MAKERS{$class}; my $non_methods = $makers->{non_methods} || {}; my $stash = _getstash($class); my $subs = { map {; no strict 'refs'; ${"${class}::${_}"} = ${"${class}::${_}"}; ($_ => \&{"${class}::${_}"}); } grep exists &{"${class}::${_}"}, grep !/::\z/, keys %$stash }; my %tracked = map +($_ => 1), _check_tracked($class, [ keys %$subs ]); return { map +($_ => \&{"${class}::${_}"}), grep !($non_methods->{$_} && $non_methods->{$_} == $subs->{$_}), grep !exists $tracked{$_}, keys %$subs }; } 1; __END__ =pod =encoding utf-8 =head1 NAME Moo - Minimalist Object Orientation (with Moose compatibility) =head1 SYNOPSIS package Cat::Food; use Moo; use strictures 2; use namespace::clean; sub feed_lion { my $self = shift; my $amount = shift || 1; $self->pounds( $self->pounds - $amount ); } has taste => ( is => 'ro', ); has brand => ( is => 'ro', isa => sub { die "Only SWEET-TREATZ supported!" unless $_[0] eq 'SWEET-TREATZ' }, ); has pounds => ( is => 'rw', isa => sub { die "$_[0] is too much cat food!" unless $_[0] < 15 }, ); 1; And elsewhere: my $full = Cat::Food->new( taste => 'DELICIOUS.', brand => 'SWEET-TREATZ', pounds => 10, ); $full->feed_lion; say $full->pounds; =head1 DESCRIPTION C is an extremely light-weight Object Orientation system. It allows one to concisely define objects and roles with a convenient syntax that avoids the details of Perl's object system. C contains a subset of L and is optimised for rapid startup. C avoids depending on any XS modules to allow for simple deployments. The name C is based on the idea that it provides almost -- but not quite -- two thirds of L. As such, the L can serve as an effective guide to C aside from the MOP and Types sections. Unlike L this module does not aim at full compatibility with L's surface syntax, preferring instead to provide full interoperability via the metaclass inflation capabilities described in L. For a full list of the minor differences between L and L's surface syntax, see L. =head1 WHY MOO EXISTS If you want a full object system with a rich Metaprotocol, L is already wonderful. But if you don't want to use L, you may not want "less metaprotocol" like L offers, but you probably want "no metaprotocol", which is what Moo provides. C is ideal for some situations where deployment or startup time precludes using L and L: =over 2 =item * A command line or CGI script where fast startup is essential =item * code designed to be deployed as a single file via L =item * A CPAN module that may be used by others in the above situations =back C maintains transparent compatibility with L so if you install and load L you can use Moo classes and roles in L code without modification. Moo -- Minimal Object Orientation -- aims to make it smooth to upgrade to L when you need more than the minimal features offered by Moo. =head1 MOO AND MOOSE If L detects L being loaded, it will automatically register metaclasses for your L and L packages, so you should be able to use them in L code without modification. L will also create L for L classes and roles, so that in Moose classes C<< isa => 'MyMooClass' >> and C<< isa => 'MyMooRole' >> work the same as for L classes and roles. Extending a L class or consuming a L will also work. Extending a L class or consuming a L will also work. But note that we don't provide L metaclasses or metaroles so the other way around doesn't work. This feature exists for L users porting to L; enabling L users to use L classes is not a priority for us. This means that there is no need for anything like L for Moo code - Moo and Moose code should simply interoperate without problem. To handle L code, you'll likely need an empty Moo role or class consuming or extending the L stuff since it doesn't register true L metaclasses like L does. If you need to disable the metaclass creation, add: no Moo::sification; to your code before Moose is loaded, but bear in mind that this switch is global and turns the mechanism off entirely so don't put this in library code. =head1 MOO AND CLASS::XSACCESSOR If a new enough version of L is available, it will be used to generate simple accessors, readers, and writers for better performance. Simple accessors are those without lazy defaults, type checks/coercions, or triggers. Simple readers are those without lazy defaults. Readers and writers generated by L will behave slightly differently: they will reject attempts to call them with the incorrect number of parameters. =head1 MOO VERSUS ANY::MOOSE L will load L normally, and L in a program using L - which theoretically allows you to get the startup time of L without disadvantaging L users. Sadly, this doesn't entirely work, since the selection is load order dependent - L's metaclass inflation system explained above in L is significantly more reliable. So if you want to write a CPAN module that loads fast or has only pure perl dependencies but is also fully usable by L users, you should be using L. For a full explanation, see the article L which explains the differing strategies in more detail and provides a direct example of where L succeeds and L fails. =head1 PUBLIC METHODS Moo provides several methods to any class using it. =head2 new Foo::Bar->new( attr1 => 3 ); or Foo::Bar->new({ attr1 => 3 }); The constructor for the class. By default it will accept attributes either as a hashref, or a list of key value pairs. This can be customized with the L method. =head2 does if ($foo->does('Some::Role1')) { ... } Returns true if the object composes in the passed role. =head2 DOES if ($foo->DOES('Some::Role1') || $foo->DOES('Some::Class1')) { ... } Similar to L, but will also return true for both composed roles and superclasses. =head2 meta my $meta = Foo::Bar->meta; my @methods = $meta->get_method_list; Returns an object that will behave as if it is a L object for the class. If you call anything other than C on it, the object will be transparently upgraded to a genuine L instance, loading Moose in the process if required. C itself is a no-op, since we generate metaclasses that are already immutable, and users converting from Moose had an unfortunate tendency to accidentally load Moose by calling it. =head1 LIFECYCLE METHODS There are several methods that you can define in your class to control construction and destruction of objects. They should be used rather than trying to modify C or C yourself. =head2 BUILDARGS around BUILDARGS => sub { my ( $orig, $class, @args ) = @_; return { attr1 => $args[0] } if @args == 1 && !ref $args[0]; return $class->$orig(@args); }; Foo::Bar->new( 3 ); This class method is used to transform the arguments to C into a hash reference of attribute values. The default implementation accepts a hash or hash reference of named parameters. If it receives a single argument that isn't a hash reference it will throw an error. You can override this method in your class to handle other types of options passed to the constructor. This method should always return a hash reference of named options. =head2 FOREIGNBUILDARGS sub FOREIGNBUILDARGS { my ( $class, $options ) = @_; return $options->{foo}; } If you are inheriting from a non-Moo class, the arguments passed to the parent class constructor can be manipulated by defining a C method. It will receive the same arguments as L, and should return a list of arguments to pass to the parent class constructor. =head2 BUILD sub BUILD { my ($self, $args) = @_; die "foo and bar cannot be used at the same time" if exists $args->{foo} && exists $args->{bar}; } On object creation, any C methods in the class's inheritance hierarchy will be called on the object and given the results of L. They each will be called in order from the parent classes down to the child, and thus should not themselves call the parent's method. Typically this is used for object validation or possibly logging. =head2 DEMOLISH sub DEMOLISH { my ($self, $in_global_destruction) = @_; ... } When an object is destroyed, any C methods in the inheritance hierarchy will be called on the object. They are given boolean to inform them if global destruction is in progress, and are called from the child class upwards to the parent. This is similar to L methods but in the opposite order. Note that this is implemented by a C method, which is only created on on the first construction of an object of your class. This saves on overhead for classes that are never instantiated or those without C methods. If you try to define your own C, this will cause undefined results. =head1 IMPORTED SUBROUTINES =head2 extends extends 'Parent::Class'; Declares a base class. Multiple superclasses can be passed for multiple inheritance but please consider using L instead. The class will be loaded but no errors will be triggered if the class can't be found and there are already subs in the class. Calling extends more than once will REPLACE your superclasses, not add to them like 'use base' would. =head2 with with 'Some::Role1'; or with 'Some::Role1', 'Some::Role2'; Composes one or more L (or L) roles into the current class. An error will be raised if these roles cannot be composed because they have conflicting method definitions. The roles will be loaded using the same mechanism as C uses. =head2 has has attr => ( is => 'ro', ); Declares an attribute for the class. package Foo; use Moo; has 'attr' => ( is => 'ro' ); package Bar; use Moo; extends 'Foo'; has '+attr' => ( default => sub { "blah" }, ); Using the C<+> notation, it's possible to override an attribute. has [qw(attr1 attr2 attr3)] => ( is => 'ro', ); Using an arrayref with multiple attribute names, it's possible to declare multiple attributes with the same options. The options for C are as follows: =over 2 =item C B, may be C, C, C or C. C stands for "read-only" and generates an accessor that dies if you attempt to write to it - i.e. a getter only - by defaulting C to the name of the attribute. C generates a reader like C, but also sets C to 1 and C to C<_build_${attribute_name}> to allow on-demand generated attributes. This feature was my attempt to fix my incompetence when originally designing C, and is also implemented by L. There is, however, nothing to stop you using C and C yourself with C or C - it's just that this isn't generally a good idea so we don't provide a shortcut for it. C stands for "read-write protected" and generates a reader like C, but also sets C to C<_set_${attribute_name}> for attributes that are designed to be written from inside of the class, but read-only from outside. This feature comes from L. C stands for "read-write" and generates a normal getter/setter by defaulting the C to the name of the attribute specified. =item C Takes a coderef which is used to validate the attribute. Unlike L, Moo does not include a basic type system, so instead of doing C<< isa => 'Num' >>, one should do use Scalar::Util qw(looks_like_number); ... isa => sub { die "$_[0] is not a number!" unless looks_like_number $_[0] }, Note that the return value for C is discarded. Only if the sub dies does type validation fail. L Since L does B run the C check before C if a coercion subroutine has been supplied, C checks are not structural to your code and can, if desired, be omitted on non-debug builds (although if this results in an uncaught bug causing your program to break, the L authors guarantee nothing except that you get to keep both halves). If you want L compatible or L style named types, look at L. To cause your C entries to be automatically mapped to named L objects (rather than the default behaviour of creating an anonymous type), set: $Moo::HandleMoose::TYPE_MAP{$isa_coderef} = sub { require MooseX::Types::Something; return MooseX::Types::Something::TypeName(); }; Note that this example is purely illustrative; anything that returns a L object or something similar enough to it to make L happy is fine. =item C Takes a coderef which is meant to coerce the attribute. The basic idea is to do something like the following: coerce => sub { $_[0] % 2 ? $_[0] : $_[0] + 1 }, Note that L will always execute your coercion: this is to permit C entries to be used purely for bug trapping, whereas coercions are always structural to your code. We do, however, apply any supplied C check after the coercion has run to ensure that it returned a valid value. L If the C option is a blessed object providing a C or C method, then the C option may be set to just C<1>. =item C Takes a string handles => 'RobotRole' Where C is a L that defines an interface which becomes the list of methods to handle. Takes a list of methods handles => [ qw( one two ) ] Takes a hashref handles => { un => 'one', } =item C Takes a coderef which will get called any time the attribute is set. This includes the constructor, but not default or built values. The coderef will be invoked against the object with the new value as an argument. If you set this to just C<1>, it generates a trigger which calls the C<_trigger_${attr_name}> method on C<$self>. This feature comes from L. Note that Moose also passes the old value, if any; this feature is not yet supported. L =item C Takes a coderef which will get called with $self as its only argument to populate an attribute if no value for that attribute was supplied to the constructor. Alternatively, if the attribute is lazy, C executes when the attribute is first retrieved if no value has yet been provided. If a simple scalar is provided, it will be inlined as a string. Any non-code reference (hash, array) will result in an error - for that case instead use a code reference that returns the desired value. Note that if your default is fired during new() there is no guarantee that other attributes have been populated yet so you should not rely on their existence. L =item C Takes a method name which will return true if an attribute has a value. If you set this to just C<1>, the predicate is automatically named C if your attribute's name does not start with an underscore, or C<_has_${attr_name_without_the_underscore}> if it does. This feature comes from L. =item C Takes a method name which will be called to create the attribute - functions exactly like default except that instead of calling $default->($self); Moo will call $self->$builder; The following features come from L: If you set this to just C<1>, the builder is automatically named C<_build_${attr_name}>. If you set this to a coderef or code-convertible object, that variable will be installed under C<$class::_build_${attr_name}> and the builder set to the same name. =item C Takes a method name which will clear the attribute. If you set this to just C<1>, the clearer is automatically named C if your attribute's name does not start with an underscore, or C<_clear_${attr_name_without_the_underscore}> if it does. This feature comes from L. B If the attribute is C, it will be regenerated from C or C the next time it is accessed. If it is not lazy, it will be C. =item C B. Set this if you want values for the attribute to be grabbed lazily. This is usually a good idea if you have a L which requires another attribute to be set. =item C B. Set this if the attribute must be passed on object instantiation. =item C The name of the method that returns the value of the attribute. If you like Java style methods, you might set this to C =item C The value of this attribute will be the name of the method to set the value of the attribute. If you like Java style methods, you might set this to C. =item C B. Set this if you want the reference that the attribute contains to be weakened. Use this when circular references, which cause memory leaks, are possible. =item C Takes the name of the key to look for at instantiation time of the object. A common use of this is to make an underscored attribute have a non-underscored initialization name. C means that passing the value in on instantiation is ignored. =item C Takes either a coderef or array of coderefs which is meant to transform the given attributes specifications if necessary when upgrading to a Moose role or class. You shouldn't need this by default, but is provided as a means of possible extensibility. =back =head2 before before foo => sub { ... }; See L<< Class::Method::Modifiers/before method(s) => sub { ... }; >> for full documentation. =head2 around around foo => sub { ... }; See L<< Class::Method::Modifiers/around method(s) => sub { ... }; >> for full documentation. =head2 after after foo => sub { ... }; See L<< Class::Method::Modifiers/after method(s) => sub { ... }; >> for full documentation. =head1 SUB QUOTE AWARE L allows us to create coderefs that are "inlineable," giving us a handy, XS-free speed boost. Any option that is L aware can take advantage of this. To do this, you can write use Sub::Quote; use Moo; use namespace::clean; has foo => ( is => 'ro', isa => quote_sub(q{ die "Not <3" unless $_[0] < 3 }) ); which will be inlined as do { local @_ = ($_[0]->{foo}); die "Not <3" unless $_[0] < 3; } or to avoid localizing @_, has foo => ( is => 'ro', isa => quote_sub(q{ my ($val) = @_; die "Not <3" unless $val < 3 }) ); which will be inlined as do { my ($val) = ($_[0]->{foo}); die "Not <3" unless $val < 3; } See L for more information, including how to pass lexical captures that will also be compiled into the subroutine. =head1 CLEANING UP IMPORTS L will not clean up imported subroutines for you; you will have to do that manually. The recommended way to do this is to declare your imports first, then C, then C. Anything imported before L will be scrubbed. Anything imported or declared after will be still be available. package Record; use Digest::MD5 qw(md5_hex); use Moo; use namespace::clean; has name => (is => 'ro', required => 1); has id => (is => 'lazy'); sub _build_id { my ($self) = @_; return md5_hex($self->name); } 1; For example if you were to import these subroutines after L like this use namespace::clean; use Digest::MD5 qw(md5_hex); use Moo; then any C C<$r> would have methods such as C<< $r->md5_hex() >>, C<< $r->has() >> and C<< $r->around() >> - almost certainly not what you intend! Ls behave slightly differently. Since their methods are composed into the consuming class, they can do a little more for you automatically. As long as you declare your imports before calling C, those imports and the ones L itself provides will not be composed into consuming classes so there's usually no need to use L. B:> Older versions of L would inflate Moo classes to full L classes, losing the benefits of Moo. If you want to use L with a Moo class, make sure you are using version 0.16 or newer. =head1 INCOMPATIBILITIES WITH MOOSE =head2 TYPES There is no built-in type system. C is verified with a coderef; if you need complex types, L can provide types, type libraries, and will work seamlessly with both L and L. L can be considered the successor to L and provides a similar API, so that you can write use Types::Standard qw(Int); has days_to_live => (is => 'ro', isa => Int); =head2 API INCOMPATIBILITIES C is not supported in core since the author considers it to be a bad idea and Moose best practices recommend avoiding it. Meanwhile C or C are more likely to be able to fulfill your needs. No support for C, C, C, or C - the author considers augment to be a bad idea, and override can be translated: override foo => sub { ... super(); ... }; around foo => sub { my ($orig, $self) = (shift, shift); ... $self->$orig(@_); ... }; The C method is not provided by default. The author suggests loading L into C (via C for example) and using C<< $obj->$::Dwarn() >> instead. L only supports coderefs and plain scalars, because passing a hash or array reference as a default is almost always incorrect since the value is then shared between all objects using that default. C is not supported; you are instead encouraged to use the C<< is => 'lazy' >> option supported by L and L. C is not supported since the author considers it a bad idea and it has been considered best practice to avoid it for some time. C will show up in a L metaclass created from your class but is otherwise ignored. Then again, L ignores it as well, so this is arguably not an incompatibility. Since C does not require C to be defined but L does require it, the metaclass inflation for coerce alone is a trifle insane and if you attempt to subtype the result will almost certainly break. Handling of warnings: when you C we enable strict and warnings, in a similar way to Moose. The authors recommend the use of C, which enables FATAL warnings, and several extra pragmas when used in development: L, L, and L. Additionally, L supports a set of attribute option shortcuts intended to reduce common boilerplate. The set of shortcuts is the same as in the L module L as of its version 0.009+. So if you: package MyClass; use Moo; use strictures 2; The nearest L invocation would be: package MyClass; use Moose; use warnings FATAL => "all"; use MooseX::AttributeShortcuts; or, if you're inheriting from a non-Moose class, package MyClass; use Moose; use MooseX::NonMoose; use warnings FATAL => "all"; use MooseX::AttributeShortcuts; =head2 META OBJECT There is no meta object. If you need this level of complexity you need L - Moo is small because it explicitly does not provide a metaprotocol. However, if you load L, then Class::MOP::class_of($moo_class_or_role) will return an appropriate metaclass pre-populated by L. =head2 IMMUTABILITY Finally, Moose requires you to call __PACKAGE__->meta->make_immutable; at the end of your class to get an inlined (i.e. not horribly slow) constructor. Moo does it automatically the first time ->new is called on your class. (C is a no-op in Moo to ease migration.) An extension L exists to ease translating Moose packages to Moo by providing a more Moose-like interface. =head1 COMPATIBILITY WITH OLDER PERL VERSIONS Moo is compatible with perl versions back to 5.6. When running on older versions, additional prerequisites will be required. If you are packaging a script with its dependencies, such as with L, you will need to be certain that the extra prerequisites are included. =over 4 =item L Required on perl versions prior to 5.10.0. =item L Required on perl versions prior to 5.14.0. =back =head1 SUPPORT IRC: #moose on irc.perl.org =for :html L<(click for instant chatroom login)|https://chat.mibbit.com/#moose@irc.perl.org> Bugtracker: L Git repository: L Git browser: L =head1 AUTHOR mst - Matt S. Trout (cpan:MSTROUT) =head1 CONTRIBUTORS dg - David Leadbeater (cpan:DGL) frew - Arthur Axel "fREW" Schmidt (cpan:FREW) hobbs - Andrew Rodland (cpan:ARODLAND) jnap - John Napiorkowski (cpan:JJNAPIORK) ribasushi - Peter Rabbitson (cpan:RIBASUSHI) chip - Chip Salzenberg (cpan:CHIPS) ajgb - Alex J. G. Burzyński (cpan:AJGB) doy - Jesse Luehrs (cpan:DOY) perigrin - Chris Prather (cpan:PERIGRIN) Mithaldu - Christian Walde (cpan:MITHALDU) ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) tobyink - Toby Inkster (cpan:TOBYINK) haarg - Graham Knop (cpan:HAARG) mattp - Matt Phillips (cpan:MATTP) bluefeet - Aran Deltac (cpan:BLUEFEET) bubaflub - Bob Kuo (cpan:BUBAFLUB) ether = Karen Etheridge (cpan:ETHER) =head1 COPYRIGHT Copyright (c) 2010-2015 the Moo L and L as listed above. =head1 LICENSE This library is free software and may be distributed under the same terms as perl itself. See L. =cut Moo-2.005005/lib/Moo/sification.pm000644 000000 000000 00000001344 13777354515 016607 0ustar00rootwheel000000 000000 package Moo::sification; use strict; use warnings; no warnings 'once'; use Carp qw(croak); BEGIN { our @CARP_NOT = qw(Moo::HandleMoose) } use Moo::_Utils qw(_in_global_destruction); sub unimport { croak "Can't disable Moo::sification after inflation has been done" if $Moo::HandleMoose::SETUP_DONE; our $disabled = 1; } sub Moo::HandleMoose::AuthorityHack::DESTROY { unless (our $disabled or _in_global_destruction) { require Moo::HandleMoose; Moo::HandleMoose->import; } } sub import { return if our $setup_done; if ($INC{"Moose.pm"}) { require Moo::HandleMoose; Moo::HandleMoose->import; } else { $Moose::AUTHORITY = bless({}, 'Moo::HandleMoose::AuthorityHack'); } $setup_done = 1; } 1; Moo-2.005005/lib/Moo/HandleMoose.pm000644 000000 000000 00000017307 13777150313 016651 0ustar00rootwheel000000 000000 package Moo::HandleMoose; use strict; use warnings; no warnings 'once'; use Moo::_Utils qw(_getstash); use Sub::Quote qw(quotify); use Carp qw(croak); our %TYPE_MAP; our $SETUP_DONE; sub import { return if $SETUP_DONE; inject_all(); $SETUP_DONE = 1; } sub inject_all { croak "Can't inflate Moose metaclass with Moo::sification disabled" if $Moo::sification::disabled; require Class::MOP; inject_fake_metaclass_for($_) for grep $_ ne 'Moo::Object', keys %Moo::MAKERS; inject_fake_metaclass_for($_) for keys %Moo::Role::INFO; require Moose::Meta::Method::Constructor; @Moo::HandleMoose::FakeConstructor::ISA = 'Moose::Meta::Method::Constructor'; @Moo::HandleMoose::FakeMeta::ISA = 'Moose::Meta::Method::Meta'; } sub maybe_reinject_fake_metaclass_for { my ($name) = @_; our %DID_INJECT; if (delete $DID_INJECT{$name}) { unless ($Moo::Role::INFO{$name}) { Moo->_constructor_maker_for($name)->install_delayed; } inject_fake_metaclass_for($name); } } sub inject_fake_metaclass_for { my ($name) = @_; require Class::MOP; require Moo::HandleMoose::FakeMetaClass; Class::MOP::store_metaclass_by_name( $name, bless({ name => $name }, 'Moo::HandleMoose::FakeMetaClass') ); require Moose::Util::TypeConstraints; if ($Moo::Role::INFO{$name}) { Moose::Util::TypeConstraints::find_or_create_does_type_constraint($name); } else { Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($name); } } { package Moo::HandleMoose::FakeConstructor; sub _uninlined_body { \&Moose::Object::new } } sub inject_real_metaclass_for { my ($name) = @_; our %DID_INJECT; return Class::MOP::get_metaclass_by_name($name) if $DID_INJECT{$name}; require Moose; require Moo; require Moo::Role; require Scalar::Util; require Sub::Defer; Class::MOP::remove_metaclass_by_name($name); my ($am_role, $am_class, $meta, $attr_specs, $attr_order) = do { if (my $info = $Moo::Role::INFO{$name}) { my @attr_info = @{$info->{attributes}||[]}; (1, 0, Moose::Meta::Role->initialize($name), { @attr_info }, [ @attr_info[grep !($_ % 2), 0..$#attr_info] ] ) } elsif ( my $cmaker = Moo->_constructor_maker_for($name) ) { my $specs = $cmaker->all_attribute_specs; (0, 1, Moose::Meta::Class->initialize($name), $specs, [ sort { $specs->{$a}{index} <=> $specs->{$b}{index} } keys %$specs ] ); } else { # This codepath is used if $name does not exist in $Moo::MAKERS (0, 0, Moose::Meta::Class->initialize($name), {}, [] ) } }; { local $DID_INJECT{$name} = 1; foreach my $spec (values %$attr_specs) { if (my $inflators = delete $spec->{moosify}) { $_->($spec) for @$inflators; } } my %methods = %{($am_role ? 'Moo::Role' : 'Moo')->_concrete_methods_of($name)}; # if stuff gets added afterwards, _maybe_reset_handlemoose should # trigger the recreation of the metaclass but we need to ensure the # Moo::Role cache is cleared so we don't confuse Moo itself. if (my $info = $Moo::Role::INFO{$name}) { delete $info->{methods}; } # needed to ensure the method body is stable and get things named $methods{$_} = Sub::Defer::undefer_sub($methods{$_}) for grep $_ ne 'new', keys %methods; my @attrs; { # This local is completely not required for roles but harmless local @{_getstash($name)}{keys %methods}; my %seen_name; foreach my $attr_name (@$attr_order) { $seen_name{$attr_name} = 1; my %spec = %{$attr_specs->{$attr_name}}; my %spec_map = ( map { $_->name => $_->init_arg||$_->name } ( (grep { $_->has_init_arg } $meta->attribute_metaclass->meta->get_all_attributes), grep { exists($_->{init_arg}) ? defined($_->init_arg) : 1 } map { my $meta = Moose::Util::resolve_metatrait_alias('Attribute', $_) ->meta; map $meta->get_attribute($_), $meta->get_attribute_list } @{$spec{traits}||[]} ) ); # have to hard code this because Moose's role meta-model is lacking $spec_map{traits} ||= 'traits'; $spec{is} = 'ro' if $spec{is} eq 'lazy' or $spec{is} eq 'rwp'; my $coerce = $spec{coerce}; if (my $isa = $spec{isa}) { my $tc = $spec{isa} = do { if (my $mapped = $TYPE_MAP{$isa}) { my $type = $mapped->(); unless ( Scalar::Util::blessed($type) && $type->isa("Moose::Meta::TypeConstraint") ) { croak "error inflating attribute '$attr_name' for package '$name': " ."\$TYPE_MAP{$isa} did not return a valid type constraint'"; } $coerce ? $type->create_child_type(name => $type->name) : $type; } else { Moose::Meta::TypeConstraint->new( constraint => sub { eval { &$isa; 1 } } ); } }; if ($coerce) { $tc->coercion(Moose::Meta::TypeCoercion->new) ->_compiled_type_coercion($coerce); $spec{coerce} = 1; } } elsif ($coerce) { my $attr = quotify($attr_name); my $tc = Moose::Meta::TypeConstraint->new( constraint => sub { die "This is not going to work" }, inlined => sub { 'my $r = $_[42]{'.$attr.'}; $_[42]{'.$attr.'} = 1; $r' }, ); $tc->coercion(Moose::Meta::TypeCoercion->new) ->_compiled_type_coercion($coerce); $spec{isa} = $tc; $spec{coerce} = 1; } %spec = map { $spec_map{$_} => $spec{$_} } grep { exists $spec_map{$_} } keys %spec; push @attrs, $meta->add_attribute($attr_name => %spec); } foreach my $mouse (do { our %MOUSE; @{$MOUSE{$name}||[]} }) { foreach my $attr ($mouse->get_all_attributes) { my %spec = %{$attr}; delete @spec{qw( associated_class associated_methods __METACLASS__ provides curries )}; my $attr_name = delete $spec{name}; next if $seen_name{$attr_name}++; push @attrs, $meta->add_attribute($attr_name => %spec); } } } foreach my $meth_name (keys %methods) { my $meth_code = $methods{$meth_name}; $meta->add_method($meth_name, $meth_code); } if ($am_role) { my $info = $Moo::Role::INFO{$name}; $meta->add_required_methods(@{$info->{requires}}); foreach my $modifier (@{$info->{modifiers}}) { my ($type, @args) = @$modifier; my $code = pop @args; $meta->${\"add_${type}_method_modifier"}($_, $code) for @args; } } elsif ($am_class) { foreach my $attr (@attrs) { foreach my $method (@{$attr->associated_methods}) { $method->{body} = $name->can($method->name); } } bless( $meta->find_method_by_name('new'), 'Moo::HandleMoose::FakeConstructor', ); my $meta_meth; if ( $meta_meth = $meta->find_method_by_name('meta') and $meta_meth->body == \&Moo::Object::meta ) { bless($meta_meth, 'Moo::HandleMoose::FakeMeta'); } # a combination of Moo and Moose may bypass a Moo constructor but still # use a Moo DEMOLISHALL. We need to make sure this is loaded before # global destruction. require Method::Generate::DemolishAll; } $meta->add_role(Class::MOP::class_of($_)) for grep !/\|/ && $_ ne $name, # reject Foo|Bar and same-role-as-self keys %{$Moo::Role::APPLIED_TO{$name}} } $DID_INJECT{$name} = 1; $meta; } 1; Moo-2.005005/lib/Moo/Role.pm000644 000000 000000 00000032141 14355634440 015346 0ustar00rootwheel000000 000000 package Moo::Role; use strict; use warnings; use Moo::_Utils qw( _check_tracked _getglob _getstash _install_coderef _install_modifier _install_tracked _load_module _name_coderef _set_loaded _unimport_coderefs ); use Carp qw(croak); use Role::Tiny (); BEGIN { our @ISA = qw(Role::Tiny) } BEGIN { our @CARP_NOT = qw( Method::Generate::Accessor Method::Generate::Constructor Moo::sification Moo::_Utils Role::Tiny ); } our $VERSION = '2.005005'; $VERSION =~ tr/_//d; require Moo::sification; Moo::sification->import; BEGIN { *INFO = \%Role::Tiny::INFO; *APPLIED_TO = \%Role::Tiny::APPLIED_TO; *COMPOSED = \%Role::Tiny::COMPOSED; *ON_ROLE_CREATE = \@Role::Tiny::ON_ROLE_CREATE; } our %INFO; our %APPLIED_TO; our %APPLY_DEFAULTS; our %COMPOSED; our @ON_ROLE_CREATE; sub import { my $target = caller; if ($Moo::MAKERS{$target} and $Moo::MAKERS{$target}{is_class}) { croak "Cannot import Moo::Role into a Moo class"; } _set_loaded(caller); goto &Role::Tiny::import; } sub _accessor_maker_for { my ($class, $target) = @_; ($INFO{$target}{accessor_maker} ||= do { require Method::Generate::Accessor; Method::Generate::Accessor->new }); } sub _install_subs { my ($me, $target) = @_; my %install = $me->_gen_subs($target); _install_tracked $target => $_ => $install{$_} for sort keys %install; *{_getglob("${target}::meta")} = $me->can('meta'); return; } sub _require_module { _load_module($_[1]); } sub _gen_subs { my ($me, $target) = @_; return ( has => sub { my $name_proto = shift; my @name_proto = ref $name_proto eq 'ARRAY' ? @$name_proto : $name_proto; if (@_ % 2 != 0) { croak("Invalid options for " . join(', ', map "'$_'", @name_proto) . " attribute(s): even number of arguments expected, got " . scalar @_) } my %spec = @_; foreach my $name (@name_proto) { my $spec_ref = @name_proto > 1 ? +{%spec} : \%spec; $me->_accessor_maker_for($target) ->generate_method($target, $name, $spec_ref); push @{$INFO{$target}{attributes}||=[]}, $name, $spec_ref; $me->_maybe_reset_handlemoose($target); } }, (map { my $type = $_; ( $type => sub { push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ]; $me->_maybe_reset_handlemoose($target); }, ) } qw(before after around)), requires => sub { push @{$INFO{$target}{requires}||=[]}, @_; $me->_maybe_reset_handlemoose($target); }, with => sub { $me->apply_roles_to_package($target, @_); $me->_maybe_reset_handlemoose($target); }, ); } push @ON_ROLE_CREATE, sub { my $target = shift; if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) { Moo::HandleMoose::inject_fake_metaclass_for($target); } }; # duplicate from Moo::Object sub meta { require Moo::HandleMoose::FakeMetaClass; my $class = ref($_[0])||$_[0]; bless({ name => $class }, 'Moo::HandleMoose::FakeMetaClass'); } sub unimport { my $target = caller; _unimport_coderefs($target); } sub _maybe_reset_handlemoose { my ($class, $target) = @_; if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) { Moo::HandleMoose::maybe_reinject_fake_metaclass_for($target); } } sub _non_methods { my $self = shift; my ($role) = @_; my $non_methods = $self->SUPER::_non_methods(@_); my $all_subs = $self->_all_subs($role); $non_methods->{$_} = $all_subs->{$_} for _check_tracked($role, [ keys %$all_subs ]); return $non_methods; } sub is_role { my ($self, $role) = @_; $self->_inhale_if_moose($role); $self->SUPER::is_role($role); } sub _inhale_if_moose { my ($self, $role) = @_; my $meta; if (!$self->SUPER::is_role($role) and ( $INC{"Moose.pm"} and $meta = Class::MOP::class_of($role) and ref $meta ne 'Moo::HandleMoose::FakeMetaClass' and $meta->isa('Moose::Meta::Role') ) or ( Mouse::Util->can('find_meta') and $meta = Mouse::Util::find_meta($role) and $meta->isa('Mouse::Meta::Role') ) ) { my $is_mouse = $meta->isa('Mouse::Meta::Role'); $INFO{$role}{methods} = { map +($_ => $role->can($_)), grep $role->can($_), grep !($is_mouse && $_ eq 'meta'), grep !$meta->get_method($_)->isa('Class::MOP::Method::Meta'), $meta->get_method_list }; $APPLIED_TO{$role} = { map +($_->name => 1), $meta->calculate_all_roles }; $INFO{$role}{requires} = [ $meta->get_required_method_list ]; $INFO{$role}{attributes} = [ map +($_ => do { my $attr = $meta->get_attribute($_); my $spec = { %{ $is_mouse ? $attr : $attr->original_options } }; if ($spec->{isa}) { require Sub::Quote; my $get_constraint = do { my $pkg = $is_mouse ? 'Mouse::Util::TypeConstraints' : 'Moose::Util::TypeConstraints'; _load_module($pkg); $pkg->can('find_or_create_isa_type_constraint'); }; my $tc = $get_constraint->($spec->{isa}); my $check = $tc->_compiled_type_constraint; my $tc_var = '$_check_for_'.Sub::Quote::sanitize_identifier($tc->name); $spec->{isa} = Sub::Quote::quote_sub( qq{ &${tc_var} or Carp::croak "Type constraint failed for \$_[0]" }, { $tc_var => \$check }, { package => $role, }, ); if ($spec->{coerce}) { # Mouse has _compiled_type_coercion straight on the TC object $spec->{coerce} = $tc->${\( $tc->can('coercion')||sub { $_[0] } )}->_compiled_type_coercion; } } $spec; }), $meta->get_attribute_list ]; my $mods = $INFO{$role}{modifiers} = []; foreach my $type (qw(before after around)) { # Mouse pokes its own internals so we have to fall back to doing # the same thing in the absence of the Moose API method my $map = $meta->${\( $meta->can("get_${type}_method_modifiers_map") or sub { shift->{"${type}_method_modifiers"} } )}; foreach my $method (keys %$map) { foreach my $mod (@{$map->{$method}}) { push @$mods, [ $type => $method => $mod ]; } } } $INFO{$role}{inhaled_from_moose} = 1; $INFO{$role}{is_role} = 1; } } sub _maybe_make_accessors { my ($self, $target, $role) = @_; my $m; if ($INFO{$role} && $INFO{$role}{inhaled_from_moose} or $INC{"Moo.pm"} and $m = Moo->_accessor_maker_for($target) and ref($m) ne 'Method::Generate::Accessor') { $self->_make_accessors($target, $role); } } sub _make_accessors_if_moose { my ($self, $target, $role) = @_; if ($INFO{$role} && $INFO{$role}{inhaled_from_moose}) { $self->_make_accessors($target, $role); } } sub _make_accessors { my ($self, $target, $role) = @_; my $acc_gen = ($Moo::MAKERS{$target}{accessor} ||= do { require Method::Generate::Accessor; Method::Generate::Accessor->new }); my $con_gen = $Moo::MAKERS{$target}{constructor}; my @attrs = @{$INFO{$role}{attributes}||[]}; while (my ($name, $spec) = splice @attrs, 0, 2) { # needed to ensure we got an index for an arrayref based generator if ($con_gen) { $spec = $con_gen->all_attribute_specs->{$name}; } $acc_gen->generate_method($target, $name, $spec); } } sub _undefer_subs { my ($self, $target, $role) = @_; if ($INC{'Sub/Defer.pm'}) { Sub::Defer::undefer_package($role); } } sub role_application_steps { qw(_handle_constructor _undefer_subs _maybe_make_accessors), $_[0]->SUPER::role_application_steps; } sub _build_class_with_roles { my ($me, $new_name, $superclass, @roles) = @_; $Moo::MAKERS{$new_name} = {is_class => 1}; $me->SUPER::_build_class_with_roles($new_name, $superclass, @roles); if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) { Moo::HandleMoose::inject_fake_metaclass_for($new_name); } my $lvl = 0; my $file; while ((my $pack, $file) = caller($lvl++)) { if ($pack ne __PACKAGE__ && $pack ne 'Role::Tiny' && !$pack->isa($me)) { last; } } _set_loaded($new_name, $file || (caller)[1]); return $new_name; } sub _gen_apply_defaults_for { my ($me, $class, @roles) = @_; my @attrs = map @{$INFO{$_}{attributes}||[]}, @roles; my $con_gen; my $m; return undef unless $INC{'Moo.pm'} and @attrs and $con_gen = Moo->_constructor_maker_for($class) and $m = Moo->_accessor_maker_for($class); my $specs = $con_gen->all_attribute_specs; my %seen; my %captures; my @set; while (my ($name, $spec) = splice @attrs, 0, 2) { next if $seen{$name}++; next unless $m->has_eager_default($name, $spec); my ($has, $has_cap) = $m->generate_simple_has('$_[0]', $name, $spec); my ($set, $pop_cap) = $m->generate_use_default('$_[0]', $name, $spec, $has); @captures{keys %$has_cap, keys %$pop_cap} = (values %$has_cap, values %$pop_cap); push @set, $set; } return undef if !@set; my $code = join '', map "($_),", @set; no warnings 'void'; require Sub::Quote; return Sub::Quote::quote_sub( "${class}::_apply_defaults", $code, \%captures, { package => $class, no_install => 1, no_defer => 1, } ); } sub apply_roles_to_object { my ($me, $object, @roles) = @_; my $new = $me->SUPER::apply_roles_to_object($object, @roles); my $class = ref $new; _set_loaded($class, (caller)[1]); if (!exists $APPLY_DEFAULTS{$class}) { $APPLY_DEFAULTS{$class} = $me->_gen_apply_defaults_for($class, @roles); } if (my $apply_defaults = $APPLY_DEFAULTS{$class}) { local $Carp::Internal{+__PACKAGE__} = 1; local $Carp::Internal{$class} = 1; $new->$apply_defaults; } return $new; } sub _install_single_modifier { my ($me, @args) = @_; _install_modifier(@args); } sub _install_does { my ($me, $to) = @_; # If Role::Tiny actually installed the DOES, give it a name my $new = $me->SUPER::_install_does($to) or return; return _name_coderef("${to}::DOES", $new); } sub does_role { my ($proto, $role) = @_; return 1 if Role::Tiny::does_role($proto, $role); my $meta; if ($INC{'Moose.pm'} and $meta = Class::MOP::class_of($proto) and ref $meta ne 'Moo::HandleMoose::FakeMetaClass' and $meta->can('does_role') ) { return $meta->does_role($role); } return 0; } sub _handle_constructor { my ($me, $to, $role) = @_; my $attr_info = $INFO{$role} && $INFO{$role}{attributes}; return unless $attr_info && @$attr_info; my $info = $INFO{$to}; my $con = $INC{"Moo.pm"} && Moo->_constructor_maker_for($to); my %existing = $info ? @{$info->{attributes} || []} : $con ? %{$con->all_attribute_specs || {}} : (); my @attr_info = map { @{$attr_info}[$_, $_+1] } grep { ! $existing{$attr_info->[$_]} } map { 2 * $_ } 0..@$attr_info/2-1; if ($info) { push @{$info->{attributes}||=[]}, @attr_info; } elsif ($con) { # shallow copy of the specs since the constructor will assign an index $con->register_attribute_specs(map ref() ? { %$_ } : $_, @attr_info); } } 1; __END__ =head1 NAME Moo::Role - Minimal Object Orientation support for Roles =head1 SYNOPSIS package My::Role; use Moo::Role; use strictures 2; sub foo { ... } sub bar { ... } has baz => ( is => 'ro', ); 1; And elsewhere: package Some::Class; use Moo; use strictures 2; # bar gets imported, but not foo with 'My::Role'; sub foo { ... } 1; =head1 DESCRIPTION C builds upon L, so look there for most of the documentation on how this works (in particular, using C also enables L and L). The main addition here is extra bits to make the roles more "Moosey;" which is to say, it adds L. =head1 IMPORTED SUBROUTINES See L for all the other subroutines that are imported by this module. =head2 has has attr => ( is => 'ro', ); Declares an attribute for the class to be composed into. See L for all options. =head1 CLEANING UP IMPORTS L cleans up its own imported methods and any imports declared before the C statement automatically. Anything imported after C will be composed into consuming packages. A package that consumes this role: package My::Role::ID; use Digest::MD5 qw(md5_hex); use Moo::Role; use Digest::SHA qw(sha1_hex); requires 'name'; sub as_md5 { my ($self) = @_; return md5_hex($self->name); } sub as_sha1 { my ($self) = @_; return sha1_hex($self->name); } 1; ..will now have a C<< $self->sha1_hex() >> method available to it that probably does not do what you expect. On the other hand, a call to C<< $self->md5_hex() >> will die with the helpful error message: C. See L for more details. =head1 SUPPORT See L for support and contact information. =head1 AUTHORS See L for authors. =head1 COPYRIGHT AND LICENSE See L for the copyright and license. =cut Moo-2.005005/lib/Moo/HandleMoose/000755 000000 000000 00000000000 14355634555 016313 5ustar00rootwheel000000 000000 Moo-2.005005/lib/Moo/_Utils.pm000644 000000 000000 00000014600 14030272552 015674 0ustar00rootwheel000000 000000 package Moo::_Utils; use strict; use warnings; { no strict 'refs'; no warnings 'once'; sub _getglob { \*{$_[0]} } sub _getstash { \%{"$_[0]::"} } } BEGIN { my ($su, $sn); $su = $INC{'Sub/Util.pm'} && defined &Sub::Util::set_subname or $sn = $INC{'Sub/Name.pm'} or $su = eval { require Sub::Util; } && defined &Sub::Util::set_subname or $sn = eval { require Sub::Name; }; *_subname = $su ? \&Sub::Util::set_subname : $sn ? \&Sub::Name::subname : sub { $_[1] }; *_CAN_SUBNAME = ($su || $sn) ? sub(){1} : sub(){0}; *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0}; *_WORK_AROUND_HINT_LEAKAGE = "$]" < 5.011 && !("$]" >= 5.009004 && "$]" < 5.010001) ? sub(){1} : sub(){0}; my $module_name_rx = qr/\A(?!\d)\w+(?:::\w+)*\z/; *_module_name_rx = sub(){$module_name_rx}; } use Exporter (); BEGIN { *import = \&Exporter::import } use Config (); use Scalar::Util qw(weaken); use Carp qw(croak); # this should be empty, but some CPAN modules expect these our @EXPORT = qw( _install_coderef _load_module ); our @EXPORT_OK = qw( _check_tracked _getglob _getstash _install_coderef _install_modifier _install_tracked _load_module _maybe_load_module _module_name_rx _name_coderef _set_loaded _unimport_coderefs _linear_isa _in_global_destruction _in_global_destruction_code ); my %EXPORTS; sub _install_modifier { my $target = $_[0]; my $type = $_[1]; my $code = $_[-1]; my @names = @_[2 .. $#_ - 1]; @names = @{ $names[0] } if ref($names[0]) eq 'ARRAY'; my @tracked = _check_tracked($target, \@names); if ($INC{'Sub/Defer.pm'}) { for my $name (@names) { # CMM will throw for us if it doesn't exist if (my $to_modify = $target->can($name)) { Sub::Defer::undefer_sub($to_modify); } } } require Class::Method::Modifiers; Class::Method::Modifiers::install_modifier(@_); if (@tracked) { my $exports = $EXPORTS{$target}; weaken($exports->{$_} = $target->can($_)) for @tracked; } return; } sub _install_tracked { my ($target, $name, $code) = @_; my $from = caller; weaken($EXPORTS{$target}{$name} = $code); _install_coderef("${target}::${name}", "${from}::${name}", $code); } sub Moo::_Util::__GUARD__::DESTROY { delete $INC{$_[0]->[0]} if @{$_[0]}; } sub _require { my ($file) = @_; my $guard = _WORK_AROUND_BROKEN_MODULE_STATE && bless([ $file ], 'Moo::_Util::__GUARD__'); local %^H if _WORK_AROUND_HINT_LEAKAGE; if (!eval { require $file; 1 }) { my $e = $@ || "Can't locate $file"; my $me = __FILE__; $e =~ s{ at \Q$me\E line \d+\.\n\z}{}; return $e; } pop @$guard if _WORK_AROUND_BROKEN_MODULE_STATE; return undef; } sub _load_module { my ($module) = @_; croak qq{"$module" is not a module name!} unless $module =~ _module_name_rx; (my $file = "$module.pm") =~ s{::}{/}g; return 1 if $INC{$file}; my $e = _require $file; return 1 if !defined $e; croak $e if $e !~ /\ACan't locate \Q$file\E /; # can't just ->can('can') because a sub-package Foo::Bar::Baz # creates a 'Baz::' key in Foo::Bar's symbol table my $stash = _getstash($module)||{}; no strict 'refs'; return 1 if grep +exists &{"${module}::$_"}, grep !/::\z/, keys %$stash; return 1 if $INC{"Moose.pm"} && Class::MOP::class_of($module) or Mouse::Util->can('find_meta') && Mouse::Util::find_meta($module); croak $e; } our %MAYBE_LOADED; sub _maybe_load_module { my $module = $_[0]; return $MAYBE_LOADED{$module} if exists $MAYBE_LOADED{$module}; (my $file = "$module.pm") =~ s{::}{/}g; my $e = _require $file; if (!defined $e) { return $MAYBE_LOADED{$module} = 1; } elsif ($e !~ /\ACan't locate \Q$file\E /) { warn "$module exists but failed to load with error: $e"; } return $MAYBE_LOADED{$module} = 0; } BEGIN { # optimize for newer perls require mro if "$]" >= 5.009_005; if (defined &mro::get_linear_isa) { *_linear_isa = \&mro::get_linear_isa; } else { my $e; { local $@; eval <<'END_CODE' or $e = $@; sub _linear_isa($;$) { my $class = shift; my $type = shift || exists $Class::C3::MRO{$class} ? 'c3' : 'dfs'; if ($type eq 'c3') { require Class::C3; return [Class::C3::calculateMRO($class)]; } my @check = ($class); my @lin; my %found; while (defined(my $check = shift @check)) { push @lin, $check; no strict 'refs'; unshift @check, grep !$found{$_}++, @{"$check\::ISA"}; } return \@lin; } 1; END_CODE } die $e if defined $e; } } BEGIN { my $gd_code = "$]" >= 5.014 ? q[${^GLOBAL_PHASE} eq 'DESTRUCT'] : _maybe_load_module('Devel::GlobalDestruction::XS') ? 'Devel::GlobalDestruction::XS::in_global_destruction()' : 'do { use B (); ${B::main_cv()} == 0 }'; *_in_global_destruction_code = sub () { $gd_code }; eval "sub _in_global_destruction () { $gd_code }; 1" or die $@; } sub _set_loaded { (my $file = "$_[0].pm") =~ s{::}{/}g; $INC{$file} ||= $_[1]; } sub _install_coderef { my ($glob, $code) = (_getglob($_[0]), _name_coderef(@_)); no warnings 'redefine'; if (*{$glob}{CODE}) { *{$glob} = $code; } # perl will sometimes warn about mismatched prototypes coming from the # inheritance cache, so disable them if we aren't redefining a sub else { no warnings 'prototype'; *{$glob} = $code; } } sub _name_coderef { shift if @_ > 2; # three args is (target, name, sub) _CAN_SUBNAME ? _subname(@_) : $_[1]; } sub _check_tracked { my ($target, $names) = @_; my $stash = _getstash($target); my $exports = $EXPORTS{$target} or return; $names = [keys %$exports] if !$names; my %rev = map +($exports->{$_} => $_), grep defined $exports->{$_}, keys %$exports; return grep { my $g = $stash->{$_}; $g && defined &$g && exists $rev{\&$g}; } @$names; } sub _unimport_coderefs { my ($target) = @_; my $stash = _getstash($target); my @exports = _check_tracked($target); foreach my $name (@exports) { my $old = delete $stash->{$name}; my $full_name = join('::',$target,$name); # Copy everything except the code slot back into place (e.g. $has) foreach my $type (qw(SCALAR HASH ARRAY IO)) { next unless defined(*{$old}{$type}); no strict 'refs'; *$full_name = *{$old}{$type}; } } } if ($Config::Config{useithreads}) { require Moo::HandleMoose::_TypeMap; } 1; Moo-2.005005/lib/Moo/Object.pm000644 000000 000000 00000003631 14002012044 015630 0ustar00rootwheel000000 000000 package Moo::Object; use strict; use warnings; use Carp (); our %NO_BUILD; our %NO_DEMOLISH; our $BUILD_MAKER; our $DEMOLISH_MAKER; sub new { my $class = shift; unless (exists $NO_DEMOLISH{$class}) { unless ($NO_DEMOLISH{$class} = !$class->can('DEMOLISH')) { ($DEMOLISH_MAKER ||= do { require Method::Generate::DemolishAll; Method::Generate::DemolishAll->new })->generate_method($class); } } my $proto = $class->BUILDARGS(@_); $NO_BUILD{$class} and return bless({}, $class); $NO_BUILD{$class} = !$class->can('BUILD') unless exists $NO_BUILD{$class}; $NO_BUILD{$class} ? bless({}, $class) : bless({}, $class)->BUILDALL($proto); } # Inlined into Method::Generate::Constructor::_generate_args() - keep in sync sub BUILDARGS { my $class = shift; scalar @_ == 1 ? ref $_[0] eq 'HASH' ? { %{ $_[0] } } : Carp::croak("Single parameters to new() must be a HASH ref" . " data => ". $_[0]) : @_ % 2 ? Carp::croak("The new() method for $class expects a hash reference or a" . " key/value list. You passed an odd number of arguments") : {@_} ; } sub BUILDALL { my $self = shift; $self->${\(($BUILD_MAKER ||= do { require Method::Generate::BuildAll; Method::Generate::BuildAll->new })->generate_method(ref($self)))}(@_); } sub DEMOLISHALL { my $self = shift; $self->${\(($DEMOLISH_MAKER ||= do { require Method::Generate::DemolishAll; Method::Generate::DemolishAll->new })->generate_method(ref($self)))}(@_); } sub does { return !!0 unless ($INC{'Moose/Role.pm'} || $INC{'Role/Tiny.pm'}); require Moo::Role; my $does = Moo::Role->can("does_role"); { no warnings 'redefine'; *does = $does } goto &$does; } # duplicated in Moo::Role sub meta { require Moo::HandleMoose::FakeMetaClass; my $class = ref($_[0])||$_[0]; bless({ name => $class }, 'Moo::HandleMoose::FakeMetaClass'); } 1; Moo-2.005005/lib/Moo/HandleMoose/_TypeMap.pm000644 000000 000000 00000003700 13777150313 020357 0ustar00rootwheel000000 000000 package Moo::HandleMoose::_TypeMap; use strict; use warnings; package Moo::HandleMoose; our %TYPE_MAP; package Moo::HandleMoose::_TypeMap; use Scalar::Util (); use Config (); BEGIN { *_OVERLOAD_ON_REF = "$]" < 5.010000 ? sub(){1} : sub(){0}; } our %WEAK_TYPES; sub _str_to_ref { my $in = shift; return $in if ref $in; if ($in =~ /(?:^|=)([A-Z]+)\(0x([0-9a-zA-Z]+)\)$/) { my $type = $1; my $id = do { no warnings 'portable'; hex "$2" }; require B; my $sv = bless \$id, 'B::SV'; my $ref = eval { $sv->object_2svref }; if (!defined $ref or Scalar::Util::reftype($ref) ne $type) { die <<'END_ERROR'; Moo initialization encountered types defined in a parent thread - ensure that Moo is require()d before any further thread spawns following a type definition. END_ERROR } # on older perls where overloading magic is attached to the ref rather # than the ref target, reblessing will pick up the magic if (_OVERLOAD_ON_REF and my $class = Scalar::Util::blessed($ref)) { bless $ref, $class; } return $ref; } return $in; } sub TIEHASH { bless {}, $_[0] } sub STORE { my ($self, $key, $value) = @_; my $type = _str_to_ref($key); $key = "$type"; $WEAK_TYPES{$key} = $type; Scalar::Util::weaken($WEAK_TYPES{$key}) if ref $type; $self->{$key} = $value; } sub FETCH { $_[0]->{$_[1]} } sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} } sub NEXTKEY { each %{$_[0]} } sub EXISTS { exists $_[0]->{$_[1]} } sub DELETE { delete $_[0]->{$_[1]} } sub CLEAR { %{$_[0]} = () } sub SCALAR { scalar %{$_[0]} } sub CLONE { my @types = map { defined $WEAK_TYPES{$_} ? ($WEAK_TYPES{$_} => $TYPE_MAP{$_}) : () } keys %TYPE_MAP; %WEAK_TYPES = (); %TYPE_MAP = @types; } sub DESTROY { my %types = %{$_[0]}; untie %TYPE_MAP; %TYPE_MAP = %types; } if ($Config::Config{useithreads}) { my @types = %TYPE_MAP; tie %TYPE_MAP, __PACKAGE__; %TYPE_MAP = @types; } 1; Moo-2.005005/lib/Moo/HandleMoose/FakeMetaClass.pm000644 000000 000000 00000002312 13777150313 021302 0ustar00rootwheel000000 000000 package Moo::HandleMoose::FakeMetaClass; use strict; use warnings; use Carp (); BEGIN { our @CARP_NOT = qw(Moo::HandleMoose) } sub DESTROY { } sub AUTOLOAD { my ($meth) = (our $AUTOLOAD =~ /([^:]+)$/); my $self = shift; Carp::croak "Can't call $meth without object instance" if !ref $self; Carp::croak "Can't inflate Moose metaclass with Moo::sification disabled" if $Moo::sification::disabled; require Moo::HandleMoose; Moo::HandleMoose::inject_real_metaclass_for($self->{name})->$meth(@_) } sub can { my $self = shift; return $self->SUPER::can(@_) if !ref $self or $Moo::sification::disabled; require Moo::HandleMoose; Moo::HandleMoose::inject_real_metaclass_for($self->{name})->can(@_) } sub isa { my $self = shift; return $self->SUPER::isa(@_) if !ref $self or $Moo::sification::disabled; # prevent inflation by Devel::StackTrace, which does this check. examining # the stack trace in an exception from inflation could re-trigger inflation # and cause another exception. return !!0 if @_ == 1 && $_[0] eq 'Exception::Class::Base'; require Moo::HandleMoose; Moo::HandleMoose::inject_real_metaclass_for($self->{name})->isa(@_) } sub make_immutable { $_[0] } 1; Moo-2.005005/lib/Method/Generate/000755 000000 000000 00000000000 14355634555 016335 5ustar00rootwheel000000 000000 Moo-2.005005/lib/Method/Generate/Constructor.pm000644 000000 000000 00000017116 14172112675 021215 0ustar00rootwheel000000 000000 package Method::Generate::Constructor; use strict; use warnings; use Sub::Quote qw(quote_sub quotify); use Sub::Defer; use Moo::_Utils qw(_getstash _getglob _linear_isa); use Scalar::Util qw(weaken); use Carp qw(croak); use Carp::Heavy (); BEGIN { our @CARP_NOT = qw(Sub::Defer) } BEGIN { local $Moo::sification::disabled = 1; require Moo; Moo->import; } sub register_attribute_specs { my ($self, @new_specs) = @_; $self->assert_constructor; my $specs = $self->{attribute_specs}||={}; my $ag = $self->accessor_generator; while (my ($name, $new_spec) = splice @new_specs, 0, 2) { if ($name =~ s/^\+//) { my $old_spec = $specs->{$name} or croak "has '+${name}' given but no ${name} attribute already exists"; $ag->merge_specs($new_spec, $old_spec); } if ($new_spec->{required} && !( $ag->has_default($name, $new_spec) || !exists $new_spec->{init_arg} || defined $new_spec->{init_arg} ) ) { croak "You cannot have a required attribute (${name})" . " without a default, builder, or an init_arg"; } $new_spec->{index} = scalar keys %$specs unless defined $new_spec->{index}; $specs->{$name} = $new_spec; } $self; } sub all_attribute_specs { $_[0]->{attribute_specs} } sub accessor_generator { $_[0]->{accessor_generator} } sub construction_string { my ($self) = @_; $self->{construction_string} ||= $self->_build_construction_string; } sub buildall_generator { require Method::Generate::BuildAll; Method::Generate::BuildAll->new; } sub _build_construction_string { my ($self) = @_; my $builder = $self->{construction_builder}; $builder ? $self->$builder : 'bless(' .$self->accessor_generator->default_construction_string .', $class);' } sub install_delayed { my ($self) = @_; $self->assert_constructor; my $package = $self->{package}; my (undef, @isa) = @{_linear_isa($package)}; my $isa = join ',', @isa; my (undef, $from_file, $from_line) = caller(Carp::short_error_loc()); my $constructor = defer_sub "${package}::new" => sub { my (undef, @new_isa) = @{_linear_isa($package)}; if (join(',', @new_isa) ne $isa) { my ($expected_new) = grep { *{_getglob($_.'::new')}{CODE} } @isa; my ($found_new) = grep { *{_getglob($_.'::new')}{CODE} } @new_isa; if (($found_new||'') ne ($expected_new||'')) { $found_new ||= 'none'; $expected_new ||= 'none'; croak "Expected parent constructor of $package to be" . " $expected_new, but found $found_new: changing the inheritance" . " chain (\@ISA) at runtime (after $from_file line $from_line) is unsupported"; } } my $constructor = $self->generate_method( $package, 'new', $self->{attribute_specs}, { no_install => 1, no_defer => 1 } ); $self->{inlined} = 1; weaken($self->{constructor} = $constructor); $constructor; }; $self->{inlined} = 0; weaken($self->{constructor} = $constructor); $self; } sub current_constructor { my ($self, $package) = @_; return *{_getglob("${package}::new")}{CODE}; } sub assert_constructor { my ($self) = @_; my $package = $self->{package} or return 1; my $current = $self->current_constructor($package) or return 1; my $constructor = $self->{constructor} or croak "Unknown constructor for $package already exists"; croak "Constructor for $package has been replaced with an unknown sub" if $constructor != $current; croak "Constructor for $package has been inlined and cannot be updated" if $self->{inlined}; } sub generate_method { my ($self, $into, $name, $spec, $quote_opts) = @_; $quote_opts = { %{$quote_opts||{}}, package => $into, }; foreach my $no_init (grep !exists($spec->{$_}{init_arg}), keys %$spec) { $spec->{$no_init}{init_arg} = $no_init; } local $self->{captures} = {}; my $into_buildargs = $into->can('BUILDARGS'); my $body = ' my $invoker = CORE::shift();'."\n" . ' my $class = CORE::ref($invoker) ? CORE::ref($invoker) : $invoker;'."\n" . $self->_handle_subconstructor($into, $name) . ( $into_buildargs && $into_buildargs != \&Moo::Object::BUILDARGS ? $self->_generate_args_via_buildargs : $self->_generate_args ) . $self->_check_required($spec) . ' my $new = '.$self->construction_string.";\n" . $self->_assign_new($spec) . ( $into->can('BUILD') ? $self->buildall_generator->buildall_body_for( $into, '$new', '$args' ) : '' ) . ' return $new;'."\n"; if ($into->can('DEMOLISH')) { require Method::Generate::DemolishAll; Method::Generate::DemolishAll->new->generate_method($into); } quote_sub "${into}::${name}" => $body, $self->{captures}, $quote_opts||{} ; } sub _handle_subconstructor { my ($self, $into, $name) = @_; if (my $gen = $self->{subconstructor_handler}) { ' if ($class ne '.quotify($into).') {'."\n". $gen. ' }'."\n"; } else { '' } } sub _cap_call { my ($self, $code, $captures) = @_; @{$self->{captures}}{keys %$captures} = values %$captures if $captures; $code; } sub _generate_args_via_buildargs { my ($self) = @_; q{ my $args = $class->BUILDARGS(@_);}."\n" .q{ Carp::croak("BUILDARGS did not return a hashref") unless CORE::ref($args) eq 'HASH';} ."\n"; } # inlined from Moo::Object - update that first. sub _generate_args { my ($self) = @_; return <<'_EOA'; my $args = scalar @_ == 1 ? CORE::ref $_[0] eq 'HASH' ? { %{ $_[0] } } : Carp::croak("Single parameters to new() must be a HASH ref" . " data => ". $_[0]) : @_ % 2 ? Carp::croak("The new() method for $class expects a hash reference or a" . " key/value list. You passed an odd number of arguments") : {@_} ; _EOA } sub _assign_new { my ($self, $spec) = @_; my $ag = $self->accessor_generator; my %test; NAME: foreach my $name (sort keys %$spec) { my $attr_spec = $spec->{$name}; next NAME unless defined($attr_spec->{init_arg}) or $ag->has_eager_default($name, $attr_spec); $test{$name} = $attr_spec->{init_arg}; } join '', map { my $arg = $test{$_}; my $arg_key = quotify($arg); my $test = defined $arg ? "exists \$args->{$arg_key}" : undef; my $source = defined $arg ? "\$args->{$arg_key}" : undef; my $attr_spec = $spec->{$_}; $self->_cap_call($ag->generate_populate_set( '$new', $_, $attr_spec, $source, $test, $arg, )); } sort keys %test; } sub _check_required { my ($self, $spec) = @_; my @required_init = map $spec->{$_}{init_arg}, grep { my $s = $spec->{$_}; # ignore required if default or builder set $s->{required} and not($s->{builder} or exists $s->{default}) } sort keys %$spec; return '' unless @required_init; ' if (my @missing = grep !exists $args->{$_}, ' .join(', ', map quotify($_), @required_init).') {'."\n" .q{ Carp::croak("Missing required arguments: ".CORE::join(', ', sort @missing));}."\n" ." }\n"; } # bootstrap our own constructor sub new { my $class = shift; delete _getstash(__PACKAGE__)->{new}; bless $class->BUILDARGS(@_), $class; } Moo->_constructor_maker_for(__PACKAGE__) ->register_attribute_specs( attribute_specs => { is => 'ro', reader => 'all_attribute_specs', }, accessor_generator => { is => 'ro' }, construction_string => { is => 'lazy' }, construction_builder => { is => 'bare' }, subconstructor_handler => { is => 'ro' }, package => { is => 'bare' }, ); if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) { Moo::HandleMoose::inject_fake_metaclass_for(__PACKAGE__); } 1; Moo-2.005005/lib/Method/Generate/DemolishAll.pm000644 000000 000000 00000002572 13777354515 021100 0ustar00rootwheel000000 000000 package Method::Generate::DemolishAll; use strict; use warnings; use Moo::Object (); BEGIN { our @ISA = qw(Moo::Object) } use Sub::Quote qw(quote_sub quotify); use Moo::_Utils qw(_getglob _linear_isa _in_global_destruction_code); sub generate_method { my ($self, $into) = @_; quote_sub "${into}::DEMOLISHALL", join '', $self->_handle_subdemolish($into), qq{ my \$self = shift;\n}, $self->demolishall_body_for($into, '$self', '@_'), qq{ return \$self\n}; quote_sub "${into}::DESTROY", sprintf <<'END_CODE', $into, _in_global_destruction_code; my $self = shift; my $e; { local $?; local $@; package %s; eval { $self->DEMOLISHALL(%s); 1; } or $e = $@; } # fatal warnings+die in DESTROY = bad times (perl rt#123398) no warnings FATAL => 'all'; use warnings 'all'; die $e if defined $e; # rethrow END_CODE } sub demolishall_body_for { my ($self, $into, $me, $args) = @_; my @demolishers = grep *{_getglob($_)}{CODE}, map "${_}::DEMOLISH", @{_linear_isa($into)}; join '', qq{ package $into;\n}, map qq{ ${me}->${_}(${args});\n}, @demolishers; } sub _handle_subdemolish { my ($self, $into) = @_; ' if (ref($_[0]) ne '.quotify($into).') {'."\n". " package $into;\n". ' return shift->Moo::Object::DEMOLISHALL(@_)'.";\n". ' }'."\n"; } 1; Moo-2.005005/lib/Method/Generate/BuildAll.pm000644 000000 000000 00000001726 13777354515 020373 0ustar00rootwheel000000 000000 package Method::Generate::BuildAll; use strict; use warnings; use Moo::Object (); BEGIN { our @ISA = qw(Moo::Object) } use Sub::Quote qw(quote_sub quotify); use Moo::_Utils qw(_getglob _linear_isa); sub generate_method { my ($self, $into) = @_; quote_sub "${into}::BUILDALL" => join('', $self->_handle_subbuild($into), qq{ my \$self = shift;\n}, $self->buildall_body_for($into, '$self', '@_'), qq{ return \$self\n}, ) => {} => { no_defer => 1 } ; } sub _handle_subbuild { my ($self, $into) = @_; ' if (ref($_[0]) ne '.quotify($into).') {'."\n". ' return shift->Moo::Object::BUILDALL(@_)'.";\n". ' }'."\n"; } sub buildall_body_for { my ($self, $into, $me, $args) = @_; my @builds = grep *{_getglob($_)}{CODE}, map "${_}::BUILD", reverse @{_linear_isa($into)}; ' (('.$args.')[0]->{__no_BUILD__} or ('."\n" .join('', map qq{ ${me}->${_}(${args}),\n}, @builds) ." )),\n"; } 1; Moo-2.005005/lib/Method/Generate/Accessor.pm000644 000000 000000 00000047750 14223257225 020437 0ustar00rootwheel000000 000000 package Method::Generate::Accessor; use strict; use warnings; use Moo::_Utils qw(_maybe_load_module _install_coderef _module_name_rx); use Moo::Object (); BEGIN { our @ISA = qw(Moo::Object) } use Sub::Quote qw(quote_sub quoted_from_sub quotify sanitize_identifier); use Scalar::Util 'blessed'; use Carp qw(croak); BEGIN { our @CARP_NOT = qw( Moo::_Utils Moo::Object Moo::Role ); } BEGIN { *_CAN_WEAKEN_READONLY = ( "$]" < 5.008_003 or $ENV{MOO_TEST_PRE_583} ) ? sub(){0} : sub(){1}; our $CAN_HAZ_XS = !$ENV{MOO_XS_DISABLE} && _maybe_load_module('Class::XSAccessor') && (eval { Class::XSAccessor->VERSION('1.07') }) ; our $CAN_HAZ_XS_PRED = $CAN_HAZ_XS && (eval { Class::XSAccessor->VERSION('1.17') }) ; } BEGIN { package Method::Generate::Accessor::_Generated; $Carp::Internal{+__PACKAGE__} = 1; } sub _die_overwrite { my ($pkg, $method, $type) = @_; croak "You cannot overwrite a locally defined method ($method) with " . ( $type || 'an accessor' ); } sub generate_method { my ($self, $into, $name, $spec, $quote_opts) = @_; $quote_opts = { no_defer => 1, package => 'Method::Generate::Accessor::_Generated', %{ $quote_opts||{} }, }; $spec->{allow_overwrite}++ if $name =~ s/^\+//; my $is = $spec->{is}; if (!$is) { croak "Must have an is"; } elsif ($is eq 'ro') { $spec->{reader} = $name unless exists $spec->{reader}; } elsif ($is eq 'rw') { $spec->{accessor} = $name unless exists $spec->{accessor} or ( $spec->{reader} and $spec->{writer} ); } elsif ($is eq 'lazy') { $spec->{reader} = $name unless exists $spec->{reader}; $spec->{lazy} = 1; $spec->{builder} ||= '_build_'.$name unless exists $spec->{default}; } elsif ($is eq 'rwp') { $spec->{reader} = $name unless exists $spec->{reader}; $spec->{writer} = "_set_${name}" unless exists $spec->{writer}; } elsif ($is ne 'bare') { croak "Unknown is ${is}"; } if (exists $spec->{builder}) { if(ref $spec->{builder}) { $self->_validate_codulatable('builder', $spec->{builder}, "$into->$name", 'or a method name'); $spec->{builder_sub} = $spec->{builder}; $spec->{builder} = 1; } $spec->{builder} = '_build_'.$name if ($spec->{builder}||0) eq 1; croak "Invalid builder for $into->$name - not a valid method name" if $spec->{builder} !~ _module_name_rx; } if (($spec->{predicate}||0) eq 1) { $spec->{predicate} = $name =~ /^_/ ? "_has${name}" : "has_${name}"; } if (($spec->{clearer}||0) eq 1) { $spec->{clearer} = $name =~ /^_/ ? "_clear${name}" : "clear_${name}"; } if (($spec->{trigger}||0) eq 1) { $spec->{trigger} = quote_sub('shift->_trigger_'.$name.'(@_)'); } if (($spec->{coerce}||0) eq 1) { my $isa = $spec->{isa}; if (blessed $isa and $isa->can('coercion')) { $spec->{coerce} = $isa->coercion; } elsif (blessed $isa and $isa->can('coerce')) { $spec->{coerce} = sub { $isa->coerce(@_) }; } else { croak "Invalid coercion for $into->$name - no appropriate type constraint"; } } foreach my $setting (qw( isa coerce )) { next if !exists $spec->{$setting}; $self->_validate_codulatable($setting, $spec->{$setting}, "$into->$name"); } if (exists $spec->{default}) { if (ref $spec->{default}) { $self->_validate_codulatable('default', $spec->{default}, "$into->$name", 'or a non-ref'); } } if (exists $spec->{moosify}) { if (ref $spec->{moosify} ne 'ARRAY') { $spec->{moosify} = [$spec->{moosify}]; } foreach my $spec (@{$spec->{moosify}}) { $self->_validate_codulatable('moosify', $spec, "$into->$name"); } } my %methods; if (my $reader = $spec->{reader}) { _die_overwrite($into, $reader, 'a reader') if !$spec->{allow_overwrite} && defined &{"${into}::${reader}"}; if (our $CAN_HAZ_XS && $self->is_simple_get($name, $spec)) { $methods{$reader} = $self->_generate_xs( getters => $into, $reader, $name, $spec ); } else { $self->{captures} = {}; $methods{$reader} = quote_sub "${into}::${reader}" => ' Carp::croak("'.$reader.' is a read-only accessor") if @_ > 1;'."\n" .$self->_generate_get($name, $spec) => delete $self->{captures} => $quote_opts ; } } if (my $accessor = $spec->{accessor}) { _die_overwrite($into, $accessor, 'an accessor') if !$spec->{allow_overwrite} && defined &{"${into}::${accessor}"}; if ( our $CAN_HAZ_XS && $self->is_simple_get($name, $spec) && $self->is_simple_set($name, $spec) ) { $methods{$accessor} = $self->_generate_xs( accessors => $into, $accessor, $name, $spec ); } else { $self->{captures} = {}; $methods{$accessor} = quote_sub "${into}::${accessor}" => $self->_generate_getset($name, $spec) => delete $self->{captures} => $quote_opts ; } } if (my $writer = $spec->{writer}) { _die_overwrite($into, $writer, 'a writer') if !$spec->{allow_overwrite} && defined &{"${into}::${writer}"}; if ( our $CAN_HAZ_XS && $self->is_simple_set($name, $spec) ) { $methods{$writer} = $self->_generate_xs( setters => $into, $writer, $name, $spec ); } else { $self->{captures} = {}; $methods{$writer} = quote_sub "${into}::${writer}" => $self->_generate_set($name, $spec) => delete $self->{captures} => $quote_opts ; } } if (my $pred = $spec->{predicate}) { _die_overwrite($into, $pred, 'a predicate') if !$spec->{allow_overwrite} && defined &{"${into}::${pred}"}; if (our $CAN_HAZ_XS && our $CAN_HAZ_XS_PRED) { $methods{$pred} = $self->_generate_xs( exists_predicates => $into, $pred, $name, $spec ); } else { $self->{captures} = {}; $methods{$pred} = quote_sub "${into}::${pred}" => $self->_generate_simple_has('$_[0]', $name, $spec)."\n" => delete $self->{captures} => $quote_opts ; } } if (my $builder = delete $spec->{builder_sub}) { _install_coderef( "${into}::$spec->{builder}" => $builder ); } if (my $cl = $spec->{clearer}) { _die_overwrite($into, $cl, 'a clearer') if !$spec->{allow_overwrite} && defined &{"${into}::${cl}"}; $self->{captures} = {}; $methods{$cl} = quote_sub "${into}::${cl}" => $self->_generate_simple_clear('$_[0]', $name, $spec)."\n" => delete $self->{captures} => $quote_opts ; } if (my $hspec = $spec->{handles}) { my $asserter = $spec->{asserter} ||= '_assert_'.$name; my @specs = ref $hspec eq 'ARRAY' ? ( map [ $_ => $_ ], @$hspec ) : ref $hspec eq 'HASH' ? ( map [ $_ => ref($hspec->{$_}) ? @{$hspec->{$_}} : $hspec->{$_} ], keys %$hspec ) : !ref $hspec ? do { require Moo::Role; map [ $_ => $_ ], Moo::Role->methods_provided_by($hspec) } : croak "You gave me a handles of ${hspec} and I have no idea why"; foreach my $delegation_spec (@specs) { my ($proxy, $target, @args) = @$delegation_spec; _die_overwrite($into, $proxy, 'a delegation') if !$spec->{allow_overwrite} && defined &{"${into}::${proxy}"}; $self->{captures} = {}; $methods{$proxy} = quote_sub "${into}::${proxy}" => $self->_generate_delegation($asserter, $target, \@args) => delete $self->{captures} => $quote_opts ; } } if (my $asserter = $spec->{asserter}) { _die_overwrite($into, $asserter, 'an asserter') if !$spec->{allow_overwrite} && defined &{"${into}::${asserter}"}; local $self->{captures} = {}; $methods{$asserter} = quote_sub "${into}::${asserter}" => $self->_generate_asserter($name, $spec) => delete $self->{captures} => $quote_opts ; } \%methods; } sub merge_specs { my ($self, @specs) = @_; my $spec = shift @specs; for my $old_spec (@specs) { foreach my $key (keys %$old_spec) { if ($key eq 'handles') { } elsif ($key eq 'moosify') { $spec->{$key} = [ map { ref $_ eq 'ARRAY' ? @$_ : $_ } grep defined, ($old_spec->{$key}, $spec->{$key}) ]; } elsif ($key eq 'builder' || $key eq 'default') { $spec->{$key} = $old_spec->{$key} if !(exists $spec->{builder} || exists $spec->{default}); } elsif (!exists $spec->{$key}) { $spec->{$key} = $old_spec->{$key}; } } } $spec; } sub is_simple_attribute { my ($self, $name, $spec) = @_; # clearer doesn't have to be listed because it doesn't # affect whether defined/exists makes a difference !grep $spec->{$_}, qw(lazy default builder coerce isa trigger predicate weak_ref); } sub is_simple_get { my ($self, $name, $spec) = @_; !($spec->{lazy} and (exists $spec->{default} or $spec->{builder})); } sub is_simple_set { my ($self, $name, $spec) = @_; !grep $spec->{$_}, qw(coerce isa trigger weak_ref); } sub has_default { my ($self, $name, $spec) = @_; $spec->{builder} or exists $spec->{default} or (($spec->{is}||'') eq 'lazy'); } sub has_eager_default { my ($self, $name, $spec) = @_; (!$spec->{lazy} and (exists $spec->{default} or $spec->{builder})); } sub _generate_get { my ($self, $name, $spec) = @_; my $simple = $self->_generate_simple_get('$_[0]', $name, $spec); if ($self->is_simple_get($name, $spec)) { $simple; } else { $self->_generate_use_default( '$_[0]', $name, $spec, $self->_generate_simple_has('$_[0]', $name, $spec), ); } } sub generate_simple_has { my $self = shift; $self->{captures} = {}; my $code = $self->_generate_simple_has(@_); ($code, delete $self->{captures}); } sub _generate_simple_has { my ($self, $me, $name) = @_; "exists ${me}->{${\quotify $name}}"; } sub _generate_simple_clear { my ($self, $me, $name) = @_; " delete ${me}->{${\quotify $name}}\n" } sub generate_get_default { my $self = shift; $self->{captures} = {}; my $code = $self->_generate_get_default(@_); ($code, delete $self->{captures}); } sub generate_use_default { my $self = shift; $self->{captures} = {}; my $code = $self->_generate_use_default(@_); ($code, delete $self->{captures}); } sub _generate_use_default { my ($self, $me, $name, $spec, $test) = @_; my $get_value = $self->_generate_get_default($me, $name, $spec); if ($spec->{coerce}) { $get_value = $self->_generate_coerce( $name, $get_value, $spec->{coerce} ) } $test." ? \n" .$self->_generate_simple_get($me, $name, $spec)."\n:" .($spec->{isa} ? " do {\n my \$value = ".$get_value.";\n" ." ".$self->_generate_isa_check($name, '$value', $spec->{isa}).";\n" ." ".$self->_generate_simple_set($me, $name, $spec, '$value')."\n" ." }\n" : ' ('.$self->_generate_simple_set($me, $name, $spec, $get_value).")\n" ); } sub _generate_get_default { my ($self, $me, $name, $spec) = @_; if (exists $spec->{default}) { ref $spec->{default} ? $self->_generate_call_code($name, 'default', $me, $spec->{default}) : quotify $spec->{default}; } else { "${me}->${\$spec->{builder}}" } } sub generate_simple_get { my ($self, @args) = @_; $self->{captures} = {}; my $code = $self->_generate_simple_get(@args); ($code, delete $self->{captures}); } sub _generate_simple_get { my ($self, $me, $name) = @_; my $name_str = quotify $name; "${me}->{${name_str}}"; } sub _generate_set { my ($self, $name, $spec) = @_; my ($me, $source) = ('$_[0]', '$_[1]'); if ($self->is_simple_set($name, $spec)) { return $self->_generate_simple_set($me, $name, $spec, $source); } my ($coerce, $trigger, $isa_check) = @{$spec}{qw(coerce trigger isa)}; if ($coerce) { $source = $self->_generate_coerce($name, $source, $coerce); } if ($isa_check) { 'scalar do { my $value = '.$source.";\n" .' ('.$self->_generate_isa_check($name, '$value', $isa_check)."),\n" .' ('.$self->_generate_simple_set($me, $name, $spec, '$value')."),\n" .($trigger ? '('.$self->_generate_trigger($name, $me, '$value', $trigger)."),\n" : '') .' ('.$self->_generate_simple_get($me, $name, $spec)."),\n" ."}"; } elsif ($trigger) { my $set = $self->_generate_simple_set($me, $name, $spec, $source); "scalar (\n" . ' ('.$self->_generate_trigger($name, $me, "($set)", $trigger)."),\n" . ' ('.$self->_generate_simple_get($me, $name, $spec)."),\n" . ")"; } else { '('.$self->_generate_simple_set($me, $name, $spec, $source).')'; } } sub generate_coerce { my $self = shift; $self->{captures} = {}; my $code = $self->_generate_coerce(@_); ($code, delete $self->{captures}); } sub _attr_desc { my ($name, $init_arg) = @_; return quotify($name) if !defined($init_arg) or $init_arg eq $name; return quotify($name).' (constructor argument: '.quotify($init_arg).')'; } sub _generate_coerce { my ($self, $name, $value, $coerce, $init_arg) = @_; $self->_wrap_attr_exception( $name, "coercion", $init_arg, $self->_generate_call_code($name, 'coerce', "${value}", $coerce), 1, ); } sub generate_trigger { my $self = shift; $self->{captures} = {}; my $code = $self->_generate_trigger(@_); ($code, delete $self->{captures}); } sub _generate_trigger { my ($self, $name, $obj, $value, $trigger) = @_; $self->_generate_call_code($name, 'trigger', "${obj}, ${value}", $trigger); } sub generate_isa_check { my ($self, @args) = @_; $self->{captures} = {}; my $code = $self->_generate_isa_check(@args); ($code, delete $self->{captures}); } sub _wrap_attr_exception { my ($self, $name, $step, $arg, $code, $want_return) = @_; my $prefix = quotify("${step} for "._attr_desc($name, $arg).' failed: '); "do {\n" .' local $Method::Generate::Accessor::CurrentAttribute = {'."\n" .' init_arg => '.quotify($arg).",\n" .' name => '.quotify($name).",\n" .' step => '.quotify($step).",\n" ." };\n" .($want_return ? ' (my $_return),'."\n" : '') .' (my $_error), (my $_old_error = $@);'."\n" ." (eval {\n" .' ($@ = $_old_error),'."\n" .' (' .($want_return ? '$_return ='."\n" : '') .$code."),\n" ." 1\n" ." } or\n" .' $_error = CORE::ref $@ ? $@ : '.$prefix.'.$@);'."\n" .' ($@ = $_old_error),'."\n" .' (defined $_error and CORE::die $_error);'."\n" .($want_return ? ' $_return;'."\n" : '') ."}\n" } sub _generate_isa_check { my ($self, $name, $value, $check, $init_arg) = @_; $self->_wrap_attr_exception( $name, "isa check", $init_arg, $self->_generate_call_code($name, 'isa_check', $value, $check) ); } sub _generate_call_code { my ($self, $name, $type, $values, $sub) = @_; $sub = \&{$sub} if blessed($sub); # coderef if blessed if (my $quoted = quoted_from_sub($sub)) { my $local = 1; if ($values eq '@_' || $values eq '$_[0]') { $local = 0; $values = '@_'; } my $code = $quoted->[1]; if (my $captures = $quoted->[2]) { my $cap_name = qq{\$${type}_captures_for_}.sanitize_identifier($name); $self->{captures}->{$cap_name} = \$captures; Sub::Quote::inlinify($code, $values, Sub::Quote::capture_unroll($cap_name, $captures, 6), $local); } else { Sub::Quote::inlinify($code, $values, undef, $local); } } else { my $cap_name = qq{\$${type}_for_}.sanitize_identifier($name); $self->{captures}->{$cap_name} = \$sub; "${cap_name}->(${values})"; } } sub _sanitize_name { sanitize_identifier($_[1]) } sub generate_populate_set { my $self = shift; $self->{captures} = {}; my $code = $self->_generate_populate_set(@_); ($code, delete $self->{captures}); } sub _generate_populate_set { my ($self, $me, $name, $spec, $source, $test, $init_arg) = @_; my $has_default = $self->has_eager_default($name, $spec); if (!($has_default || $test)) { return ''; } if ($has_default) { my $get_default = $self->_generate_get_default($me, $name, $spec); $source = $test ? "(\n ${test}\n" ." ? ${source}\n : " .$get_default .")" : $get_default; } if ($spec->{coerce}) { $source = $self->_generate_coerce( $name, $source, $spec->{coerce}, $init_arg ) } if ($spec->{isa}) { $source = 'scalar do { my $value = '.$source.";\n" .' ('.$self->_generate_isa_check( $name, '$value', $spec->{isa}, $init_arg )."),\n" ." \$value\n" ."}\n"; } my $set = $self->_generate_simple_set($me, $name, $spec, $source); my $trigger = $spec->{trigger} ? $self->_generate_trigger( $name, $me, $self->_generate_simple_get($me, $name, $spec), $spec->{trigger} ) : undef; if ($has_default) { "($set)," . ($trigger && $test ? "($test and $trigger)," : '') . "\n"; } else { "($test and ($set)" . ($trigger ? ", ($trigger)" : '') . "),\n"; } } sub _generate_core_set { my ($self, $me, $name, $spec, $value) = @_; my $name_str = quotify $name; "${me}->{${name_str}} = ${value}"; } sub _generate_simple_set { my ($self, $me, $name, $spec, $value) = @_; my $name_str = quotify $name; my $simple = $self->_generate_core_set($me, $name, $spec, $value); if ($spec->{weak_ref}) { require Scalar::Util; my $get = $self->_generate_simple_get($me, $name, $spec); # Perl < 5.8.3 can't weaken refs to readonly vars # (e.g. string constants). This *can* be solved by: # # &Internals::SvREADONLY($foo, 0); # Scalar::Util::weaken($foo); # &Internals::SvREADONLY($foo, 1); # # but requires Internal functions and is just too damn crazy # so simply throw a better exception my $weak_simple = _CAN_WEAKEN_READONLY ? "do { Scalar::Util::weaken(${simple}); no warnings 'void'; $get }" : <<"EOC" ( eval { Scalar::Util::weaken($simple); 1 } ? do { no warnings 'void'; $get } : do { if( \$@ =~ /Modification of a read-only value attempted/) { require Carp; Carp::croak( sprintf ( 'Reference to readonly value in "%s" can not be weakened on Perl < 5.8.3', $name_str, ) ); } else { die \$@; } } ) EOC } else { $simple; } } sub _generate_getset { my ($self, $name, $spec) = @_; q{(@_ > 1}."\n ? ".$self->_generate_set($name, $spec) ."\n : ".$self->_generate_get($name, $spec)."\n )"; } sub _generate_asserter { my ($self, $name, $spec) = @_; my $name_str = quotify($name); "do {\n" ." my \$val = ".$self->_generate_get($name, $spec).";\n" ." ".$self->_generate_simple_has('$_[0]', $name, $spec)."\n" ." or Carp::croak(q{Attempted to access '}.${name_str}.q{' but it is not set});\n" ." \$val;\n" ."}\n"; } sub _generate_delegation { my ($self, $asserter, $target, $args) = @_; my $arg_string = do { if (@$args) { # I could, I reckon, linearise out non-refs here using quotify # plus something to check for numbers but I'm unsure if it's worth it $self->{captures}{'@curries'} = $args; '@curries, @_'; } else { '@_'; } }; "shift->${asserter}->${target}(${arg_string});"; } sub _generate_xs { my ($self, $type, $into, $name, $slot) = @_; Class::XSAccessor->import( class => $into, $type => { $name => $slot }, replace => 1, ); $into->can($name); } sub default_construction_string { '{}' } sub _validate_codulatable { my ($self, $setting, $value, $into, $appended) = @_; my $error; if (blessed $value) { local $@; no warnings 'void'; eval { \&$value; 1 } and return 1; $error = "could not be converted to a coderef: $@"; } elsif (ref $value eq 'CODE') { return 1; } else { $error = 'is not a coderef or code-convertible object'; } croak "Invalid $setting '" . ($INC{'overload.pm'} ? overload::StrVal($value) : $value) . "' for $into " . $error . ($appended ? " $appended" : ''); } 1; Moo-2.005005/xt/class-tiny.t000644 000000 000000 00000000611 13777150314 015512 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; use Class::Tiny 1.001; my %build; { package MyClass; use Class::Tiny qw(name); sub BUILD { $build{+__PACKAGE__}++; } } { package MySubClass; use Moo; extends 'MyClass'; sub BUILD { $build{+__PACKAGE__}++; } has 'attr1' => (is => 'ro'); } MySubClass->new; is $build{MyClass}, 1; is $build{MySubClass}, 1; done_testing; Moo-2.005005/xt/moo-roles-into-moose-class-attr-override-with-autoclean.t000644 000000 000000 00000001267 13777354515 026262 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; use lib 't/lib'; use InlineModule ( MooRoleWithAttrWithAutoclean => q{ package MooRoleWithAttrWithAutoclean; use Moo::Role; # This causes the metaclass to be loaded and used before the 'has' fires # so Moo needs to blow it away again at that point so the attribute gets # added BEGIN { Class::MOP::class_of(__PACKAGE__)->get_method_list } has output_to => ( is => 'ro', required => 1, ); 1; }, ); { package Bax; use Moose; with qw/ MooRoleWithAttrWithAutoclean /; has '+output_to' => ( required => 1, ); } pass 'classes and roles built without error'; done_testing; Moo-2.005005/xt/moose-consume-moo-role-after-consumed-by-moo.t000644 000000 000000 00000000652 13777150314 024063 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; use lib 't/lib'; use InlineModule ( 'MooRole' => q{ package MooRole; use Moo::Role; $::MooRole_LOADED++; no Moo::Role; 1; }, ); BEGIN { $::MooRole_LOADED = 0 } BEGIN { package MooConsumer; use Moo; with "MooRole"; } BEGIN { package MooseConsumer; use Moose; with "MooRole"; } is $::MooRole_LOADED, 1, "role loaded only once"; done_testing; Moo-2.005005/xt/fakemetaclass.t000644 000000 000000 00000001600 14355631140 016220 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use Moo::HandleMoose::FakeMetaClass; sub Foo::bar { 'bar' } my $fake = bless { name => 'Foo' }, 'Moo::HandleMoose::FakeMetaClass'; my $bar = $fake->get_method('bar'); is $bar->body, \&Foo::bar, 'able to call moose meta methods'; my $fm = 'Moo::HandleMoose::FakeMetaClass'; is exception { my $can = $fm->can('can'); is $can, \&Moo::HandleMoose::FakeMetaClass::can, 'can usable as class method'; ok $fm->isa($fm), 'isa usable as class method'; local $Moo::HandleMoose::FakeMetaClass::VERSION = 5; is $fm->VERSION, 5, 'VERSION usable as class method'; }, undef, 'no errors calling isa, can, or VERSION'; like exception { $fm->missing_method; }, qr/Can't call missing_method without object instance/, 'nonexistent methods give correct error when called on class'; done_testing; Moo-2.005005/xt/moo-consume-moose-role-multiple.t000644 000000 000000 00000000717 13777150314 021604 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package RoleOne; use Moose::Role; has foo => ( is => 'rw' ); } { package RoleTwo; use Moose::Role; has bar => ( is => 'rw' ); } { package SomeClass; use Moo; with 'RoleOne', 'RoleTwo'; } my $i = SomeClass->new( foo => 'bar', bar => 'baz' ); is $i->foo, 'bar', "attribute from first role is correct"; is $i->bar, 'baz', "attribute from second role is correct"; done_testing; Moo-2.005005/xt/global-destruct-jenga.t000644 000000 000000 00000000773 13777150314 017612 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; use IPC::Open3; use File::Basename qw(dirname); delete $ENV{PERL5LIB}; delete $ENV{PERL5OPT}; my $pid = open3 my $in, my $fh, undef, $^X, (map "-I$_", @INC), dirname(__FILE__).'/global-destruct-jenga-helper.pl' or die "can run jenga helper: $!"; my $out = do { local $/; <$fh> }; close $out; close $in; waitpid $pid, 0; my $err = $?; is $out, '', 'no error output from global destruct of jenga object'; is $err, 0, 'process ended successfully'; done_testing; Moo-2.005005/xt/type-inflate.t000644 000000 000000 00000003472 13777150314 016035 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package TypeOMatic; use Sub::Quote; use Moo::HandleMoose (); use Moose::Util::TypeConstraints qw( find_type_constraint subtype as where message ); use Moo::Role; sub Str { my $type = sub { die unless defined $_[0] && !ref $_[0]; }; $Moo::HandleMoose::TYPE_MAP{$type} = sub { find_type_constraint("Str"); }; return ($type, @_); } sub PositiveInt { my $type = sub { die unless defined $_[0] && !ref $_[0] && $_[0] =~ /^-?\d+/; }; $Moo::HandleMoose::TYPE_MAP{$type} = sub { find_type_constraint(__PACKAGE__.'::PositiveInt'); }; return ($type, @_); } subtype __PACKAGE__.'::PositiveInt', as 'Int', where { $_ > 0 }, message { "$_ is not a positive integer!" }; has named_type => ( is => 'ro', isa => Str, ); has named_external_type => ( is => 'ro', isa => PositiveInt, ); package TypeOMatic::Consumer; # do this as late as possible to simulate "real" behaviour use Moo::HandleMoose; use Moose; with 'TypeOMatic'; } my $meta = Class::MOP::class_of('TypeOMatic::Consumer'); my ($str, $positive_int) = map $meta->get_attribute($_)->type_constraint->name, qw(named_type named_external_type); is($str, 'Str', 'Built-in Moose type ok'); is( $positive_int, 'TypeOMatic::PositiveInt', 'External ok' ); local $@; eval q { package Fooble; use Moo; my $isa = sub { 1 }; $Moo::HandleMoose::TYPE_MAP{$isa} = sub { $isa }; has barble => (is => "ro", isa => $isa); __PACKAGE__->meta->get_attribute("barble"); }; like( $@, qr/^error inflating attribute 'barble' for package 'Fooble': \$TYPE_MAP\{CODE\(\w+?\)\} did not return a valid type constraint/, 'error message for incorrect type constraint inflation', ); done_testing; Moo-2.005005/xt/moose-autoclean-lazy-attr-builders.t000644 000000 000000 00000001215 13777354515 022265 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; # when using an Moose object and namespace::autoclean # lazy attributes that get a value on initialize still # have their builders run { package MyMooseObject; use Moose; } { package BadObject; use Moo; # use MyMooseObject <- this is inferred here has attr => ( is => 'lazy' ); sub _build_attr {2} # forces metaclass inflation like namespace::autoclean would BEGIN { __PACKAGE__->meta->name } } # use BadObject <- this is inferred here is( BadObject->new( attr => 1 )->attr, 1, q{namespace::autoclean doesn't run builders with default}, ); done_testing; Moo-2.005005/xt/moo-does-mouse-role.t000644 000000 000000 00000002574 14355631140 017237 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More "$]" < 5.008009 ? (skip_all => 'Mouse is broken on perl <= 5.8.8') : (); use CaptureException; BEGIN { package Ker; use Moo::Role; sub has_ker {} } BEGIN { package Splat2; use Mouse::Role; requires 'monkey'; sub punch { 1 } sub jab { 0 } around monkey => sub { 'OW' }; has trap => (is => 'ro', default => sub { -1 }); sub has_splat {} } BEGIN { package KerSplat2; use Moo::Role; with qw(Ker Splat2); } BEGIN { package KerSplattered2; use Moo; sub monkey { 'WHAT' } with qw(KerSplat2); sub jab { 3 } } BEGIN { package Splattered2; use Moo; sub monkey { 'WHAT' } with qw(Splat2); sub jab { 3 } } BEGIN { package Ker::Splattered2; use Moo; sub monkey { 'WHAT' } with qw(Ker Splat2); sub jab { 3 } } foreach my $s ( Splattered2->new, Ker::Splattered2->new, KerSplattered2->new, ) { can_ok($s, 'punch') and is($s->punch, 1, 'punch'); can_ok($s, 'jab') and is($s->jab, 3, 'jab'); can_ok($s, 'monkey') and is($s->monkey, 'OW', 'monkey'); can_ok($s, 'trap') and is($s->trap, -1, 'trap'); } foreach my $c (qw/ Ker::Splattered2 KerSplattered2 /) { can_ok($c, 'has_ker'); can_ok($c, 'has_splat'); } is ref Splattered2->meta, 'Moo::HandleMoose::FakeMetaClass', 'Mouse::Role meta method not copied'; done_testing; Moo-2.005005/xt/moose-override-attribute-with-plus-syntax.t000644 000000 000000 00000002041 14355631140 023633 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package MooParent; use Moo; has foo => ( is => 'ro', default => sub { 'MooParent' }, ); } { package MooseChild; use Moose; extends 'MooParent'; has '+foo' => ( default => 'MooseChild', ); } { package MooseChild2; use Moose; extends 'MooParent'; has '+foo' => ( default => 'MooseChild2', ); __PACKAGE__->meta->make_immutable } { package MooChild; use Moo; extends 'MooParent'; has '+foo' => ( default => sub { 'MooChild' }, ); } is( MooseChild->new->foo, 'MooseChild', 'default value in Moose child' ); is( MooseChild2->new->foo, 'MooseChild2', 'default value in Moose child' ); is(exception { local $SIG{__WARN__} = sub { die $_[0] }; ok(MooChild->meta->has_attribute('foo'), 'inflated metaclass has overridden attribute'); }, undef, 'metaclass inflation of plus override works without warnings'); done_testing; Moo-2.005005/xt/role-tiny-inflate.t000644 000000 000000 00000001353 13777150314 016772 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; eval q{ package TinyRole; $INC{'TinyRole.pm'} = __FILE__; use Role::Tiny; sub role_tiny_method { 219 } 1; } or die $@; require Moo::Role; require Moose; eval q{ package TinyRoleAfterMoo; $INC{'TinyRoleAfterMoo.pm'} = __FILE__; use Role::Tiny; sub role_tiny_after_method { 42 } 1; } or die $@; eval q{ package Some::Moose::Class; use Moose; 1; } or die $@; eval q{ package Some::Moose::Class; with 'TinyRole'; }; $@ =~ s/\n.*//s; is $@, '', 'Moose can consume Role::Tiny created before Moo loaded'; eval q{ package Some::Moose::Class; with 'TinyRoleAfterMoo'; }; $@ =~ s/\n.*//s; is $@, '', 'Moose can consume Role::Tiny created after Moo loaded'; done_testing; Moo-2.005005/xt/type-inflate-type-tiny.t000644 000000 000000 00000001311 13777150314 017763 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package TypeOMatic; use Moo::Role; use Sub::Quote; use Moo::HandleMoose (); use Types::Standard qw(Str); has consumed_type => ( is => 'ro', isa => Str, ); package TypeOMatic::Consumer; # do this as late as possible to simulate "real" behaviour use Moo::HandleMoose; use Moose; use Types::Standard qw(Str); with 'TypeOMatic'; has direct_type => ( is => 'ro', isa => Str, ); } my $meta = Class::MOP::class_of('TypeOMatic::Consumer'); for my $attr (qw(consumed_type direct_type)) { my $type = $meta->get_attribute($attr)->type_constraint; isa_ok($type, 'Type::Tiny'); is($type->name, 'Str'); } done_testing; Moo-2.005005/xt/type-tiny-coerce.t000644 000000 000000 00000000536 13777150314 016632 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package Goo; use Moo; use Types::Standard qw(Int Num); has foo => ( is => 'ro', isa => Int->plus_coercions(Num, q{ int($_) }), coerce => 1, ); } my $obj = Goo->new( foo => 3.14159, ); is($obj->foo, '3', 'Type::Tiny coercion applied with coerce => 1'); done_testing; Moo-2.005005/xt/more-jenga.t000644 000000 000000 00000001020 13777150314 015443 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; use lib 't/lib'; use InlineModule ( MooseRoleOne => q{ package MooseRoleOne; use Moose::Role; 1; }, MooseRoleTwo => q{ package MooseRoleTwo; use Moose::Role; 1; }, ); { package MooRoleWithMooseRoles; use Moo::Role; requires 'foo'; with qw/ MooseRoleOne MooseRoleTwo /; } { package MooseClassWithMooRole; use Moose; with 'MooRoleWithMooseRoles'; sub foo {} } ok 1, 'classes and roles built without error'; done_testing; Moo-2.005005/xt/moo-sification.t000644 000000 000000 00000000430 13777150314 016343 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; BEGIN { package Foo; use Moo; has one => (is => 'ro'); } no Moo::sification; use Moose; use Class::MOP; is Class::MOP::get_metaclass_by_name('Foo'), undef, 'no metaclass for Moo class after no Moo::sification'; done_testing; Moo-2.005005/xt/implicit-moose-types.t000644 000000 000000 00000001173 13777150314 017524 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; use Moose::Util::TypeConstraints qw(find_type_constraint); { package TestRole; use Moo::Role; } { package TestClass; use Moo; with 'TestRole'; } my $o = TestClass->new; foreach my $name (qw(TestClass TestRole)) { ok !find_type_constraint($name), "No $name constraint created without Moose loaded"; } note "Loading Moose"; require Moose; foreach my $name (qw(TestClass TestRole)) { my $tc = find_type_constraint($name); isa_ok $tc, 'Moose::Meta::TypeConstraint', "$name constraint" and ok $tc->check($o), "TestClass object passes $name constraint"; } done_testing; Moo-2.005005/xt/moose-consume-moo-role-no-moo-loaded.t000644 000000 000000 00000000271 13777150314 022376 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package ExampleRole; use Moo::Role; } { package ExampleClass; use Moose; with 'ExampleRole'; } ok 1; done_testing; Moo-2.005005/xt/handle_moose.t000644 000000 000000 00000004275 14355631140 016065 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use Sub::Quote qw(quote_sub); { package Foo; use Moo; has one => (is => 'ro'); has two => (is => 'rw', init_arg => undef); has three => (is => 'ro', init_arg => 'THREE', required => 1); package Bar; use Moo::Role; has four => (is => 'ro'); ::quote_sub 'Bar::quoted' => '1'; package Baz; use Moo; extends 'Foo'; with 'Bar'; has five => (is => 'rw'); } require Moose; my $meta = Class::MOP::get_metaclass_by_name('Foo'); my $attr; ok($attr = $meta->get_attribute('one'), 'Meta-attribute exists'); is($attr->get_read_method, 'one', 'Method name'); is($attr->get_read_method_ref->body, Foo->can('one'), 'Right method'); is(Foo->new(one => 1, THREE => 3)->one, 1, 'Accessor still works'); is( Foo->meta->get_attribute('one')->get_read_method, 'one', 'Method name via ->meta' ); $meta = Moose::Meta::Class->initialize('Spoon'); $meta->superclasses('Moose::Object'); Moose::Util::apply_all_roles($meta, 'Bar'); my $spoon = Spoon->new(four => 4); is($spoon->four, 4, 'Role application ok'); { package MooRequiresFour; use Moo::Role; requires 'four'; package MooRequiresGunDog; use Moo::Role; requires 'gun_dog'; } is exception { Moose::Util::apply_all_roles($meta, 'MooRequiresFour'); }, undef, 'apply role with satisified requirement'; ok exception { Moose::Util::apply_all_roles($meta, 'MooRequiresGunDog'); }, 'apply role with unsatisified requirement'; { package WithNonMethods; use Scalar::Util qw(reftype); use Moo; my $meta = Class::MOP::get_metaclass_by_name(__PACKAGE__); ::ok(!$meta->has_method('reftype'), 'imported sub before use Moo not included in inflated metaclass'); } { package AnotherMooseRole; use Moose::Role; has attr1 => (is => 'ro'); } ok(Moo::Role->is_role('AnotherMooseRole'), 'Moose roles are Moo::Role->is_role'); { { package AMooClass; use Moo; } { package AMooRole; use Moo::Role; } my $c = Moo::Role->create_class_with_roles('AMooClass', 'AMooRole'); my $meta = Class::MOP::get_metaclass_by_name($c); ok $meta, 'generated class via create_class_with_roles has metaclass'; } done_testing; Moo-2.005005/xt/type-inflate-threads.t000644 000000 000000 00000004676 13777150314 017474 0ustar00rootwheel000000 000000 use strict; use warnings; use Config (); BEGIN { unless ($Config::Config{useithreads}) { print "1..0 # SKIP your perl does not support ithreads\n"; exit 0; } } use threads; use Test::More; use Type::Tiny; { package TestTTProxy; use overload q{""} => sub { # construct a "normal" looking stringified ref that represents the same # number, but is formatted differently so it won't match the same string my $ref_str = overload::AddrRef($_[0]); $ref_str =~ s/0x/0x0000/; $ref_str; }, q{bool} => sub () { 1 }, q{&{}} => sub { my $tt = $_[0]->{tt}; sub { $tt->assert_valid($_[0]) } }, fallback => 1, ; sub new { my ($class, $tt) = @_; my $self = bless { tt => $tt }, $class; $Moo::HandleMoose::TYPE_MAP{$self} = sub { $tt }; return $self; } } my $str = sub { die unless defined $_[0] && !ref $_[0]; }; $Moo::HandleMoose::TYPE_MAP{$str} = sub { require Moose::Util::TypeConstraints; Moose::Util::TypeConstraints::find_type_constraint("Str"); }; my $int = Type::Tiny->new( name => "Integer", constraint => sub { /^(?:-?[1-9][0-9]*|0)$|/ }, message => sub { "$_ isn't an integer" }, ); my $int_proxy = TestTTProxy->new($int); require Moo; is(threads->create(sub { my $type = $str; eval q{ package TypeOMatic; use Moo; has str_type => ( is => 'ro', isa => $type, ); 1; } or die $@; require Moose; my $meta = Class::MOP::class_of('TypeOMatic'); my $str_name = $meta->get_attribute("str_type")->type_constraint->name; $str_name; })->join, 'Str', 'Type created outside thread properly inflated'); is(threads->create(sub { my $type = $int; eval q{ package TypeOMatic; use Moo; has int_type => ( is => 'ro', isa => $type, ); 1; } or die $@; require Moose; my $meta = Class::MOP::class_of('TypeOMatic'); my $int_class = ref $meta->get_attribute("int_type")->type_constraint; $int_class; })->join, 'Type::Tiny', 'Type::Tiny created outside thread inflates to self'); is(threads->create(sub { my $type = $int_proxy; eval q{ package TypeOMatic; use Moo; has int_type => ( is => 'ro', isa => $type, ); 1; } or die $@; require Moose; my $meta = Class::MOP::class_of('TypeOMatic'); my $int_class = ref $meta->get_attribute("int_type")->type_constraint; $int_class; })->join, 'Type::Tiny', 'Overloaded object inflates to correct type'); done_testing; Moo-2.005005/xt/type-inflate-coercion.t000644 000000 000000 00000002705 14355631140 017624 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; sub ArrayRef { my $type = sub { die unless ref $_[0] && ref $_[0] eq 'ARRAY'; }; $Moo::HandleMoose::TYPE_MAP{$type} = sub { require Moose::Util::TypeConstraints; Moose::Util::TypeConstraints::find_type_constraint("ArrayRef"); }; return ($type, @_); } { package ClassWithTypes; $INC{'ClassWithTypes.pm'} = __FILE__; use Moo; has split_comma => (is => 'ro', isa => ::ArrayRef, coerce => sub { [ split /,/, $_[0] ] } ); has split_space => (is => 'ro', isa => ::ArrayRef, coerce => sub { [ split / /, $_[0] ] } ); has bad_coerce => (is => 'ro', isa => ::ArrayRef, coerce => sub { $_[0] } ); } my $o = ClassWithTypes->new(split_comma => 'a,b c,d', split_space => 'a,b c,d'); is_deeply $o->split_comma, ['a','b c','d'], 'coerce with prebuilt type works'; is_deeply $o->split_space, ['a,b','c,d'], ' ... and with different coercion on same type'; { package MooseSubclassWithTypes; use Moose; extends 'ClassWithTypes'; } my $o2 = MooseSubclassWithTypes->new(split_comma => 'a,b c,d', split_space => 'a,b c,d'); is_deeply $o2->split_comma, ['a','b c','d'], 'moose subclass has correct coercion'; is_deeply $o2->split_space, ['a,b','c,d'], ' ... and with different coercion on same type'; like exception { MooseSubclassWithTypes->new(bad_coerce => 1) }, qr/Validation failed for 'ArrayRef' with value/, 'inflated type has correct name'; done_testing; Moo-2.005005/xt/release/000755 000000 000000 00000000000 14355634555 014670 5ustar00rootwheel000000 000000 Moo-2.005005/xt/moose-inflate-error-recurse.t000644 000000 000000 00000002502 14355631140 020756 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use Moose (); BEGIN { my $sigwarn = $SIG{__WARN__}; $SIG{__WARN__} = sub { die $_[0] if $_[0] =~ /Deep recursion/; if ($sigwarn) { no strict 'refs'; goto &$sigwarn; } else { warn $_[0]; } }; } BEGIN { package Role1; use Moo::Role; has attr1 => (is => 'ro', lazy => 1); } BEGIN { package Class1; use Moo; with 'Role1'; } BEGIN { package SomeMooseClass; use Moose; ::like( ::exception { with 'Role1' }, qr/You cannot have a lazy attribute/, 'reasonable error rather than deep recursion for inflating invalid attr', ); } BEGIN { package WTF::Trait; use Moose::Role; use Moose::Util; Moose::Util::meta_attribute_alias('WTF'); has wtf => (is => 'ro', required => 1); } BEGIN { package WTF::Class; use Moo; has ftw => (is => 'ro', traits => [ 'WTF' ]); } # avoiding CaptureException, because it checks exceptions for truth and that can # cause more exceptions in this case. Prefer to trigger stringification # manually here. my $e; eval { WTF::Class->meta->get_attribute('ftw'); 1; } or $e = $@; $e = "$e"; like( $e, qr/Attribute \(wtf\) is required/, 'reasonable error rather than deep recursion for inflating invalid attr (traits)', ); done_testing; Moo-2.005005/xt/moo-attr-handles-moose-role.t000644 000000 000000 00000000766 13777150314 020674 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package MooseRole; use Moose::Role; sub warble { "warble" } $INC{"MooseRole.pm"} = __FILE__; } { package MooseClass; use Moose; with 'MooseRole'; } { package MooClass; use Moo; has attr => ( is => 'ro', handles => 'MooseRole', ); } my $o = MooClass->new(attr => MooseClass->new); isa_ok( $o, 'MooClass' ); can_ok( $o, 'warble' ); is( $o->warble, "warble", 'Delegated method called correctly' ); done_testing; Moo-2.005005/xt/moo-extend-moose.t000644 000000 000000 00000002033 14355631140 016615 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; BEGIN { package MooseRole; use Moose::Role; has attr_from_role => ( is => 'ro' ); } BEGIN { package MooseParent; use Moose; with 'MooseRole'; has attr_from_parent => ( is => 'ro' ), } BEGIN { package MooRole; use Moo::Role; has attr_from_role2 => ( is => 'ro' ); } BEGIN { package MooChild; use Moo; extends 'MooseParent'; with 'MooRole'; has attr_from_child => ( is => 'ro' ); } my $o = MooChild->new( attr_from_role => 1, attr_from_parent => 2, attr_from_role2 => 3, attr_from_child => 4, ); is $o->attr_from_role, 1; is $o->attr_from_parent, 2; is $o->attr_from_role2, 3; is $o->attr_from_child, 4; ok +MooChild->meta->does_role('MooseRole'); ok +MooChild->does('MooseRole'); { my $meta = Moose::Meta::Class->initialize('MooseClassByMeta'); package WithWuff; use Moo; ::is ::exception { extends 'MooseClassByMeta'; }, undef, 'extends will allow empty Moose roles with no %INC entry'; } done_testing; Moo-2.005005/xt/moose-method-modifiers.t000644 000000 000000 00000002261 13777150314 020006 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package ModifyFoo; use Moo::Role; our $before_ran = 0; our $around_ran = 0; our $after_ran = 0; before foo => sub { $before_ran = 1 }; after foo => sub { $after_ran = 1 }; around foo => sub { my ($orig, $self, @rest) = @_; $self->$orig(@rest); $around_ran = 1; }; package Bar; use Moose; with 'ModifyFoo'; sub foo { } } my $bar = Bar->new; ok(!$ModifyFoo::before_ran, 'before has not run yet'); ok(!$ModifyFoo::after_ran, 'after has not run yet'); ok(!$ModifyFoo::around_ran, 'around has not run yet'); $bar->foo; ok($ModifyFoo::before_ran, 'before ran'); ok($ModifyFoo::after_ran, 'after ran'); ok($ModifyFoo::around_ran, 'around ran'); { package ModifyMultiple; use Moo::Role; our $before = 0; before 'foo', 'bar' => sub { $before++; }; package Baz; use Moose; with 'ModifyMultiple'; sub foo {} sub bar {} } my $baz = Baz->new; my $pre = $ModifyMultiple::before; $baz->foo; is $ModifyMultiple::before, $pre+1, "before applies to first of multiple subs"; $baz->bar; is $ModifyMultiple::before, $pre+2, "before applies to second of multiple subs"; done_testing; Moo-2.005005/xt/moo-roles-into-moose-class.t000644 000000 000000 00000002677 14355631140 020542 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package Foo; use Moo::Role; # if we autoclean here there's nothing left and then load_class tries # to require Foo during Moose application and everything breaks. } { package Bar; use Moo::Role; use namespace::autoclean; has attr => ( is => 'ro' ); sub thing {} } { package Baz; use Moose; with 'Bar'; no Moose; ::ok(!__PACKAGE__->can('has'), 'No has function after no Moose;'); } ::is(Baz->can('thing'), Bar->can('thing'), 'Role copies method correctly'); ::ok(Baz->can('attr'), 'Attr accessor correct'); ::ok(!Bar->can('has'), 'Moo::Role sugar removed by autoclean'); ::ok(!Bar->can('with'), 'Role::Tiny sugar removed by autoclean'); ::ok(!Baz->can('has'), 'Sugar not copied'); { package Bax; use Moose; with qw/ Foo Bar /; } { package Baw; use Moo::Role; has attr => ( is => 'ro', traits => ['Array'], default => sub { [] }, handles => { push_attr => 'push', }, ); } { package Buh; use Moose; with 'Baw'; } is exception { Buh->new->push_attr(1); }, undef, 'traits in role attributes are inflated properly'; { package Blorp; use Moo::Role; has attr => (is => 'ro'); } is +Blorp->meta->get_attribute('attr')->name, 'attr', 'role metaclass inflatable via ->meta'; done_testing; Moo-2.005005/xt/croak-locations.t000644 000000 000000 00000001632 13777150314 016520 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; use lib 't/lib'; use ErrorLocation; use Moo::HandleMoose; location_ok <<'END_CODE', 'Moo::sification::unimport - Moo::HandleMoose enabled'; use Moo::sification (); Moo::sification->unimport; END_CODE location_ok <<'END_CODE', 'Moo::HandleMoose::inject_real_metaclass_for - Bad %TYPE_MAP value'; use Moo; use Moo::HandleMoose (); my $isa = sub { die "bad value" }; $Moo::HandleMoose::TYPE_MAP{$isa} = sub { return 1 }; has attr => (is => 'ro', isa => $isa); $PACKAGE->meta->name; END_CODE { local $TODO = "croaks in roles don't skip consuming class"; location_ok <<'END_CODE', 'Moo::Role::_inhale_if_moose - isa from type'; BEGIN { eval qq{ package ${PACKAGE}::Role; use Moose::Role; has attr1 => (is => 'ro', isa => 'HashRef'); 1; } or die $@; } use Moo; with "${PACKAGE}::Role"; package Elsewhere; $PACKAGE->new(attr1 => []); END_CODE } done_testing; Moo-2.005005/xt/inflate-undefer.t000644 000000 000000 00000000630 13777150314 016475 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; use Moose (); { package MyClass; use Moo; use Sub::Defer qw(defer_sub); my $undeferred; my $deferred = defer_sub +__PACKAGE__.'::welp' => sub { $undeferred = sub { 1 }; }; __PACKAGE__->meta->name; ::ok +$undeferred, "meta inflation undefers subs"; ::is +__PACKAGE__->can('welp'), $undeferred, "undeferred sub installed"; } done_testing; Moo-2.005005/xt/global-destruct-jenga-helper.pl000644 000000 000000 00000000353 13777150314 021231 0ustar00rootwheel000000 000000 use strict; use warnings; { package BaseClass; use Moo; } { package Subclass; use Moose; extends 'BaseClass'; __PACKAGE__->meta->make_immutable; } { package Blorp; use Moo; extends 'Subclass'; } our $o = Blorp->new; Moo-2.005005/xt/withautoclean.t000644 000000 000000 00000001412 14355631140 016265 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package withautoclean::Role; use Moo::Role; use Moose (); # triggering metaclass inflation previously would cause Moo to cache the # method list. methods added later would not be composed properly. # this could be caused by namespace::autoclean BEGIN { Class::MOP::class_of(__PACKAGE__)->name } has _ctx => ( is => 'ro', default => sub { }, clearer => '_clear_ctx', ); } is exception { package withautoclean::Class; use Moo; with 'withautoclean::Role'; before _clear_ctx => sub {}; 1; }, undef, 'clearer properly composed'; my $o = withautoclean::Class->new(_ctx => 1); $o->_clear_ctx; is $o->_ctx, undef, 'modified method works'; done_testing; Moo-2.005005/xt/moo-object-meta-can.t000644 000000 000000 00000002630 14355631140 017142 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use Moo::Object; # See RT#84615 ok( Moo::Object->can('meta'), 'Moo::Object can meta'); is( exception { Moo::Object->meta->can('can') } , undef, "Moo::Object->meta->can doesn't explode" ); { package Example; use base 'Moo::Object'; } ok( Example->can('meta'), 'Example can meta'); is( exception { Example->meta->can('can') } , undef, "Example->meta->can doesn't explode" ); # Haarg++ noting that previously, this *also* would have died due to its absence from %Moo::Makers; { package Example_2; use Moo; has 'attr' => ( is => ro =>, ); $INC{'Example_2.pm'} = 1; } { package Example_3; use base "Example_2"; } ok( Example_2->can('meta'), 'Example_2 can meta') and do { return unless ok( Example_2->meta->can('get_all_attributes'), 'Example_2 meta can get_all_attributes' ); my (@attributes) = Example_2->meta->get_all_attributes; is( scalar @attributes, 1, 'Has one attribute' ); }; ok( Example_3->can('meta'), 'Example_3 can meta') and do { return unless is( exception { Example_3->meta->can('can') } , undef, "Example_3->meta->can doesn't explode" ); return unless ok( Example_3->meta->can('get_all_attributes'), 'Example_3 meta can get_all_attributes' ); my (@attributes) = Example_3->meta->get_all_attributes; is( scalar @attributes, 1, 'Has one attribute' ); }; done_testing; Moo-2.005005/xt/moose-accessor-isa.t000644 000000 000000 00000002742 14355631140 017121 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package FrewWithIsa; use Moo::Role; use Sub::Quote; has frooh => ( is => 'rw', isa => sub { die 'not int' unless $_[0] =~ /^\d$/ }, ); has frew => ( is => 'rw', isa => quote_sub(q{ die 'not int' unless $_[0] =~ /^\d$/ }), ); package Bar; use Moose; with 'FrewWithIsa'; package OffByOne; use Moo::Role; has off_by_one => (is => 'rw', coerce => sub { $_[0] + 1 }); package Baz; use Moo; with 'OffByOne'; package Quux; use Moose; with 'OffByOne'; __PACKAGE__->meta->make_immutable; } is(exception { Bar->new(frooh => 1, frew => 1); }, undef, 'creation of valid Bar'); ok exception { Bar->new(frooh => 'silly', frew => 1); }, 'creation of invalid Bar validated by coderef'; ok exception { Bar->new(frooh => 1, frew => 'goose'); }, 'creation of invalid Bar validated by quoted sub'; sub test_off_by_one { my ($class, $type) = @_; my $obo = $class->new(off_by_one => 1); is($obo->off_by_one, 2, "Off by one (new) ($type)"); $obo->off_by_one(41); is($obo->off_by_one, 42, "Off by one (set) ($type)"); } test_off_by_one('Baz', 'Moo'); test_off_by_one('Quux', 'Moose'); my $coerce_constraint = Quux->meta->get_attribute('off_by_one') ->type_constraint->constraint; like exception { $coerce_constraint->() }, qr/This is not going to work/, 'generated constraint is not a null constraint'; done_testing; Moo-2.005005/xt/moose-does-moo-role.t000644 000000 000000 00000003074 14355631140 017225 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package MooParentRole; use Moo::Role; sub parent_role_method { 1 }; package MooRole; use Moo::Role; with 'MooParentRole'; sub role_method { 1 }; package MooRoledMooClass; use Moo; with 'MooRole'; has 'some_attr' => (is => 'ro'); package MooRoledMooseClass; use Moose; with 'MooRole'; has 'some_attr' => (is => 'ro'); package MooseParent; use Moose; has e => ( is => 'ro', required => 1, does => 'MooRole', ); package MooParent; use Moo; has e => ( is => 'ro', required => 1, does => 'MooRole', ); } for my $parent (qw(MooseParent MooParent)) { for my $child (qw(MooRoledMooClass MooRoledMooseClass)) { is(exception { my $o = $parent->new( e => $child->new(), ); ok( $o->e->does("MooParentRole"), "$child does parent MooRole" ); can_ok( $o->e, "role_method" ); can_ok( $o->e, "parent_role_method" ); ok($o->e->meta->has_method('role_method'), 'Moose knows about role_method'); ok($o->e->meta->has_method('parent_role_method'), 'Moose knows about parent_role_method'); }, undef); } } { package MooClass2; use Moo; } { ok !MooClass2->does('MooRole'), 'Moo class does not do unrelated role'; my $meta = Class::MOP::get_metaclass_by_name('MooClass2'); is ref $meta, 'Moo::HandleMoose::FakeMetaClass', 'does call for Moo only classes did not inflate'; } done_testing; Moo-2.005005/xt/moose-lazy.t000644 000000 000000 00000003117 13777150314 015527 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package LazyFrew; our $default_ran = 0; our $quoted_default_ran = 0; our $builder_ran = 0; use Moo::Role; use Sub::Quote; has frooh => ( is => 'rw', default => sub { $default_ran = 1; 'test frooh' }, lazy => 1, ); has frew => ( is => 'rw', default => quote_sub(q{ $$quoted_default_ran = 1; 'test frew' }, { '$quoted_default_ran' => \\$quoted_default_ran }), lazy => 1, ); has frioux => ( is => 'rw', builder => 'build_frioux', lazy => 1, ); sub build_frioux { $builder_ran = 1; 'test frioux' } package Bar; use Moose; with 'LazyFrew'; } my $x = Bar->new; ok(!$LazyFrew::default_ran, 'default has not run yet'); ok(!$LazyFrew::quoted_default_ran, 'quoted default has not run yet'); ok(!$LazyFrew::builder_ran, 'builder has not run yet'); is($x->frooh, 'test frooh', 'frooh defaulted correctly'); ok($LazyFrew::default_ran, 'default ran'); ok(!$LazyFrew::quoted_default_ran, 'quoted default has not run yet'); ok(!$LazyFrew::builder_ran, 'builder has not run yet'); is($x->frew, 'test frew', 'frew defaulted correctly'); ok($LazyFrew::default_ran, 'default ran'); ok($LazyFrew::quoted_default_ran, 'quoted default ran'); ok(!$LazyFrew::builder_ran, 'builder has not run yet'); is($x->frioux, 'test frioux', 'frioux built correctly'); ok($LazyFrew::default_ran, 'default ran'); ok($LazyFrew::quoted_default_ran, 'quoted default ran'); ok($LazyFrew::builder_ran, 'builder ran'); done_testing; Moo-2.005005/xt/moo-sification-handlemoose.t000644 000000 000000 00000000574 14355631140 020642 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; BEGIN { package Foo; use Moo; has one => (is => 'ro'); } use Moo::HandleMoose; require Moo::sification; like exception { Moo::sification->unimport }, qr/Can't disable Moo::sification after inflation has been done/, 'Moo::sification can\'t be disabled after inflation'; done_testing; Moo-2.005005/xt/test-my-dependents.t000644 000000 000000 00000023622 13777150314 017164 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; BEGIN { plan skip_all => <<'END_HELP' unless $ENV{MOO_TEST_MD} || @ARGV; This test will not run unless you set MOO_TEST_MD to a true value. Valid values are: all Test every dist which depends on Moose except those that we know cannot be tested. This is a lot of distros (hundreds). Dist::1,Dist::2,... Test the individual dists listed. MooX Test all Moo extension distros. 1 Run the default tests. We pick 200 random dists and test them. END_HELP } use Test::DependentModules qw( test_module ); BEGIN { eval { require Cpanel::JSON::XS; Cpane::JSON::XS->import(qw(decode_json encode_json)); } or do { require JSON::PP; JSON::PP->import(qw(decode_json encode_json)); } } use List::Util qw(uniq); use Cwd (); use Getopt::Long (); use Config; my @extra_libs = do { my @libs = `"$^X" -le"print for \@INC"`; chomp @libs; my %libs; @libs{@libs} = (); map { Cwd::abs_path($_) } grep { !exists $libs{$_} } @INC; }; $ENV{PERL5LIB} = join($Config{path_sep}, @extra_libs, $ENV{PERL5LIB}||()); Getopt::Long::GetOptions( 'show' => \(my $show), 'all' => \(my $all), 'save-skip=s' => \(my $save_skip), 'skip-file=s' => \(my $skip_file), 'count=s' => \(my $count), 'moox' => \(my $moox), ); my @pick = @ARGV; if (my $env = $ENV{MOO_TEST_MD}) { if ($env eq 'MooX') { $moox = 1; } elsif ($env eq 'all') { $all = 1; } elsif ($env eq '1') { $count = 200; } elsif ($env =~ /^\d+$/) { $count = $env; } else { @pick = split /,/, $env; s/^\s+//, s/\s+$// for @pick; } } my %dists; my $cache_file = 'xt/.dependents.json'; if (open my $fh, '<', $cache_file) { if (-M $fh < 1) { %dists = %{ decode_json(scalar do { local $/; <$fh> }) }; } } if (! %dists) { my %bad_prereqs = map +($_ => 1), qw(Gtk2 Padre Wx); require HTTP::Tiny; my $res = HTTP::Tiny->new->get( 'https://fastapi.metacpan.org/v1/reverse_dependencies/dist/Moo?size=5000' ); if ($res->{success}) { my $deps = decode_json($res->{content}); for my $dep ( @{ $deps->{data} } ) { if (grep exists $bad_prereqs{$_->{module}}, @{ $dep->{dependency} }) { next; } $dists{ $dep->{distribution} } = $dep->{main_module}; } if (open my $fh, '>', $cache_file) { print { $fh } encode_json(\%dists); close $fh; } else { warn "Unable to write to cache file $cache_file: $!\n"; } } else { die "Unable to fetch dependents: $res->{status} $res->{reason}\n$res->{content}\n"; } } my %bad_dist; my $sec_reason; my %skip; my %todo; my $hash; my $skip_fh; if ($skip_file) { open $skip_fh, '<', $skip_file or die "can't open $skip_file: $!"; } else { $skip_fh = \*DATA; } while (my $line = <$skip_fh>) { chomp $line; next unless $line =~ /\S/; if ( $line =~ /^#\s*(\w+)(?::\s*(.*?)\s*)?$/ ) { die "Invalid action in DATA section ($1)" unless $1 eq 'SKIP' || $1 eq 'TODO'; $hash = $1 eq 'SKIP' ? \%skip : \%todo; $sec_reason = $2; } my ( $dist, $reason ) = $line =~ /^(\S*)\s*(?:#\s*(.*?)\s*)?$/; next unless defined $dist && length $dist; $hash->{$dist} = $reason ? "$sec_reason: $reason" : $reason; } my %todo_module; my %skip_module; my @modules; my %module_to_dist; for my $dist ( keys %dists ) { my $module = $dists{$dist}; $todo_module{$module} = $todo{$dist} if exists $todo{$dist}; $skip_module{$module} = $skip{$dist} if exists $skip{$dist}; if ($dist =~ /^(Task|Bundle|Acme)-/) { $skip_module{$module} = "not testing $1 dist"; } $module_to_dist{$module} = $dist; push @modules, $module; } @modules = sort @modules; if ( $moox ) { @modules = grep /^MooX(?:$|::)/, @modules; } elsif ( $count ) { diag(<<"EOF"); Picking $count random dependents to test. Set MOO_TEST_MD=all to test all dependents or MOO_TEST_MD=MooX to test extension modules only. EOF @modules = grep { !exists $skip_module{$_} } List::Util::shuffle(@modules); @modules = @modules[0 .. $count-1]; } elsif ( @pick ) { my %modules = map { $_ => 1 } @modules; if (my @unknown = grep { !$modules{$_} } @pick) { die "Unknown modules: @unknown"; } delete @skip_module{@pick}; @modules = @pick; } if ($show) { print "Dependents:\n"; print " $_\n" for @modules; exit; } my $skip_report; if ($save_skip) { open $skip_report, '>', $save_skip or die "can't open $save_skip: $!"; print { $skip_report } "# SKIP: saved failures\n" } plan tests => scalar @modules; for my $module (@modules) { SKIP: { local $TODO = $todo_module{$module} || '???' if exists $todo_module{$module}; skip "$module - " . ($skip_module{$module} || '???'), 1 if exists $skip_module{$module}; test_module($module); if ($skip_report) { my $last = (Test::More->builder->details)[-1]; if (! $last->{ok}) { my $name = $last->{name}; $name =~ s/\s.*//; $name =~ s/^\Q$module_to_dist{$module}-//; print { $skip_report } "$module_to_dist{$module} # $name\n"; } } } } __DATA__ # TODO: broken App-Presto # 0.009 Dancer2-Session-Sereal # 0.001 Mail-GcalReminder # 0.1 DBIx-Class-IndexSearch-Dezi # 0.05 Tak # 0.001003 HTML-Zoom-Parser-HH5P # 0.002 Farabi # 0.44 MooX-Types-CLike # 0.92 Net-Easypost # 0.09 OAuth2-Google-Plus # 0.02 Protocol-Star-Linemode # 1.0.0 Vim-X # 0.2.0 WWW-eNom # v1.2.8 - the internet changes WebService-Cryptsy # 1.008003 Dancer2-Plugin-REST # 0.21 Config-GitLike # 1.13 WWW-ThisIsMyJam # v0.1.0 Dancer2-Session-JSON # 0.001 App-Kit # 0.26 - db test segfaults Data-Record-Serialize # 0.05 - dbi test fails # TODO: broken prereqs Dancer-Plugin-FontSubset # 0.1.2 - Font::TTF::Scripts::Name App-Unicheck-Modules-MySQL # 0.02 - DBD::mysql Video-PlaybackMachine # 0.09 - needs X11::FullScreen Games-Snake # 0.000001 - SDL Data-SimplePassword # 0.10 - Crypt::Random, Math::Pari Dancer2-Plugin-Queue # 0.004 - Dancer2 0.08 MarpaX-Grammar-GraphViz2 # 1.00 - GraphViz2 Nitesi # 0.0094 - Crypt::Random, Math::Pari POEx-ZMQ3 # 0.060003 - ZMQ::LibZMQ3 Unicorn-Manager # 0.006009 - Net::Interface Wight-Chart # 0.003 - Wight Yakuake-Sessions # 0.11.1 - Net::DBus Jedi-Plugin-Auth # 0.01 - Jedi Minilla # v0.14.1 Perinci-CmdLine # 0.85 - via SHARYANTO Perinci-To-Text # 0.22 - via SHARYANTO Perinci-Sub-To-Text # 0.24 - via SHARYANTO Software-Release-Watch # 0.01 - via SHARYANTO Software-Release-Watch-SW-wordpress # 0.01 - via Software::Release::Watch Org-To-HTML # 0.11 - via Perinci::* # TODO: undeclared prereqs Catmandu-Inspire # v0.24 - Furl # TODO: broken by perl 5.18 App-DBCritic # 0.020 - smartmatch (GH #9) Authen-HTTP-Signature # 0.02 - smartmatch (rt#88854) DBICx-Backend-Move # 1.000010 - smartmatch (rt#88853) Ruby-VersionManager # 0.004003 - smartmatch (rt#88852) Text-Keywords # 0.900 - smartmatch (rt#84339) WebService-HabitRPG # 0.21 - smartmatch (rt#88399) Net-Icecast2 # 0.005 - hash order via PHP::HTTPBuildQuery (rt#81570) POE-Component-ProcTerminator # 0.03 - hash order via Log::Fu (rt#88851) Plugin-Tiny # 0.012 - hash order Firebase # 0.0201 - hash order # TODO: broken by Regexp::Grammars (perl 5.18) Language-Expr # 0.19 Org-To-HTML # 0.07 - via Language::Expr Perinci-Access-Simple-Server # 0.12 # TODO: invalid prereqs Catmandu-Z3950 # 0.03 - ZOOM missing Dancer2-Session-JSON # 0.001 - Dancer2 bad version requirement Business-CPI-Gateway-Moip # 0.05 - Business::CPI::Buyer Business-OnlinePayment-IPayment # 0.05 - XML::Compile::WSDL11 WebService-BambooHR # 0.04 - LWP::Online WWW-AdServeApache2-HttpEquiv # 1.00r - unlisted dep Geo::IP WWW-AdServer # 1.01 - unlisted dep Geo::IP CatalystX-Usul # 0.17.1 - issues in prereq chain Dancer2-Template-Haml # 0.04 - unlisted dep Text::Haml # SKIP: misc Apache2-HttpEquiv # 1.00 - prereq Apache2::Const GeoIP2 # 0.040000 - prereq Math::Int128 (requires gcc 4.4) Graphics-Potrace # 0.72 - external dependency GraphViz2 # 2.19 - external dependency Linux-AtaSmart # OS specific MaxMind-DB-Reader # 0.040003 - prereq Math::Int128 (requires gcc 4.4) MaxMind-DB-Common # 0.031002 - prereq Math::Int128 (requires gcc 4.4) Net-Works # 0.12 - prereq Math::Int128 (requires gcc 4.4) PortageXS # 0.3.1 - external dependency and broken prereq (Shell::EnvImporter) XML-GrammarBase # v0.2.2 - prereq XML::LibXSLT (hard to install) Forecast-IO # 0.21 - interactive tests Net-OpenVPN-Launcher # 0.1 - external dependency (and broken test) App-PerlWatcher-Level # 0.13 - depends on Linux::Inotify2 Graph-Easy-Marpa # 2.00 - GraphVis2 Net-OAuth-LP # 0.016 - relies on external service Message-Passing-ZeroMQ # 0.007 - external dependency Net-Docker # 0.002003 - external dependency App-PerlWatcher-Watcher-FileTail # 0.18 - Linux::Inotify2 switchman # 1.05 - Linux::MemInfo Juno # 0.009 - never finishes Zucchini # 0.0.21 - broken by File::Rsync ZMQ-FFI # 0.12 - libzmq MaxMind-DB-Reader-XS # 0.060003 - external lib libmaxminddb Cave-Wrapper # 0.01100100 - external program cave Tropo # 0.16 - openssl >= 1.0.0? # TODO: broken by Moo change Math-Rational-Approx # RT#84035 App-Services # RT#85255 Hg-Lib # pending release Moo-2.005005/xt/lib/000755 000000 000000 00000000000 14355634555 014016 5ustar00rootwheel000000 000000 Moo-2.005005/xt/moo-sification-meta.t000644 000000 000000 00000002317 14355631140 017267 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; BEGIN { package Foo; use Moo; has one => (is => 'ro'); } no Moo::sification; is exception { Foo->meta->make_immutable }, undef, 'make_immutable allowed under no Moo::sification'; like exception { Foo->meta->get_methods_list }, qr/^Can't inflate Moose metaclass with Moo::sification disabled/, 'meta methods blocked under no Moo::sification'; is exception { is +Foo->meta->can('can'), \&Moo::HandleMoose::FakeMetaClass::can, '->meta->can falls back to default under no Moo::sification'; }, undef, '->meta->can works under no Moo::sification'; is exception { ok +Foo->meta->isa('Moo::HandleMoose::FakeMetaClass'), '->meta->isa falls back to default under no Moo::sification'; }, undef, '->meta->isa works under no Moo::sification'; like exception { Foo->meta->get_methods_list }, qr/^Can't inflate Moose metaclass with Moo::sification disabled/, 'meta methods blocked under no Moo::sification'; require Moo::HandleMoose; like exception { Moo::HandleMoose->import }, qr/^Can't inflate Moose metaclass with Moo::sification disabled/, 'Moo::HandleMoose->import blocked under no Moo::sification'; done_testing; Moo-2.005005/xt/moo-inflate.t000644 000000 000000 00000000655 14355631140 015640 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package MooClass; use Moo; } use Moose (); use Moo::Role (); ok !$Moo::HandleMoose::DID_INJECT{'MooClass'}, "No metaclass generated for Moo class on initial Moose load"; Moo::Role->is_role('MooClass'); ok !$Moo::HandleMoose::DID_INJECT{'MooClass'}, "No metaclass generated for Moo class after testing with ->is_role"; done_testing; Moo-2.005005/xt/super-jenga.t000644 000000 000000 00000002015 13777150314 015644 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More "$]" < 5.008009 ? (skip_all => 'Mouse is broken on perl <= 5.8.8') : (); { package Tower1; use Mouse; has 'attr1' => (is => 'ro', required => 1); package Tower2; use Moo; extends 'Tower1'; has 'attr2' => (is => 'ro', required => 1); package Tower3; use Moose; extends 'Tower2'; has 'attr3' => (is => 'ro', required => 1); __PACKAGE__->meta->make_immutable; package Tower4; use Moo; extends 'Tower1'; has 'attr1' => (is => 'ro', required => 1); has 'attr2' => (is => 'ro', required => 1); has 'attr3' => (is => 'ro', required => 1); has 'attr4' => (is => 'ro', required => 1); } foreach my $num (1..4) { my $class = "Tower${num}"; my @attrs = map "attr$_", 1..$num; my %args = map +($_ => "${_}_value"), @attrs; my $obj = $class->new(%args); is($obj->{$_}, "${_}_value", "Attribute $_ ok for $class") for @attrs; is Class::MOP::get_metaclass_by_name($class)->name, $class, 'metaclass inflated correctly'; } done_testing; Moo-2.005005/xt/moo-consume-moose-role-coerce.t000644 000000 000000 00000000755 13777150314 021213 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package RoleOne; use Moose::Role; use Moose::Util::TypeConstraints; subtype 'Foo', as 'Int'; coerce 'Foo', from 'Str', via { 3 }; has foo => ( is => 'rw', isa => 'Foo', coerce => 1, clearer => '_clear_foo', ); } { package Class; use Moo; # Works if use Moose.. with 'RoleOne'; } my $i = Class->new( foo => 'bar' ); is $i->foo, 3, 'coerce from type works'; done_testing; Moo-2.005005/xt/moose-extend-moo.t000644 000000 000000 00000003317 14355631140 016623 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; BEGIN { package MooParent; use Moo; has message => ( is => 'ro', required => 1 ), } BEGIN { package Child; use Moose; extends 'MooParent'; use Moose::Util::TypeConstraints; use namespace::clean; # <-- essential has message => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { 'overridden message sub here' }, ); } # without namespace::clean, gives the (non-fatal) warning: # You are overwriting a locally defined function (message) with an accessor # ...because Moose::Util::TypeConstraints exports a 'message' sub! my $obj = Child->new(message => 'custom message'); is($obj->message, 'custom message', 'accessor works'); BEGIN { package Role1; use Moo::Role; } BEGIN { package Role2; use Moose::Role; } BEGIN { package Class1; use Moo; with 'Role1'; } BEGIN { package Class2; use Moose; extends 'Class1'; with 'Role2'; } ok +Class2->does('Role1'), "Moose child does parent's composed roles"; ok +Class2->does('Role2'), "Moose child does child's composed roles"; BEGIN { package NonMooParent; sub new { bless {}, $_[0]; } } BEGIN { package MooChild; use Moo; extends 'NonMooParent'; has attr1 => (is => 'ro'); with 'Role1'; } BEGIN { package MooseChild; use Moose; extends 'MooChild'; with 'Role2'; has attr2 => (is => 'ro'); } is exception { MooseChild->new }, undef, 'NonMoo->Moo->Moose(mutable) works'; MooseChild->meta->make_immutable(inline_constructor => 0); is exception { MooseChild->new }, undef, 'NonMoo->Moo->Moose(immutable) works'; ok +MooseChild->does('Role2'), "Moose child does parent's composed roles with non-Moo ancestor"; done_testing; Moo-2.005005/xt/bless-override.t000644 000000 000000 00000000567 14355631140 016355 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; BEGIN { *CORE::GLOBAL::bless = sub { my $obj = CORE::bless( $_[0], (@_ > 1) ? $_[1] : CORE::caller() ); $obj->isa("Foo"); $obj; }; } use Test::More; use CaptureException; use Moose (); is exception { package SomeClass; use Moo; }, undef, "isa call in bless override doesn't break Moo+Moose"; done_testing; Moo-2.005005/xt/moose-handles-moo-class.t000644 000000 000000 00000000527 14355631140 020055 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package Foo; use Moo; sub sub1 { 1 } } { package Bar; use Moose; ::is ::exception { has attr => ( is => 'ro', isa => 'Foo', handles => qr/.*/, ); }, undef, 'regex handles in Moose with Moo class isa'; } done_testing; Moo-2.005005/xt/moo-role-types.t000644 000000 000000 00000003012 14355631140 016307 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package TestClientClass; use Moo; sub consume {} } { package TestBadClientClass; use Moo; sub not_consume {} } { package TestRole; use Moo::Role; use Sub::Quote; has output_to => ( isa => quote_sub(q{ use Scalar::Util (); die $_[0] . "Does not have a ->consume method" unless Scalar::Util::blessed($_[0]) && $_[0]->can('consume'); }), is => 'ro', required => 1, coerce => quote_sub(q{ use Scalar::Util (); if (Scalar::Util::blessed($_[0]) && $_[0]->can('consume')) { $_[0]; } else { my %stuff = %{$_[0]}; my $class = delete($stuff{class}); $class->new(%stuff); } }), ); } { package TestMooClass; use Moo; with 'TestRole'; } { package TestMooseClass; use Moose; with 'TestRole'; } foreach my $name (qw/ TestMooClass TestMooseClass /) { my $i = $name->new(output_to => TestClientClass->new()); ok $i->output_to->can('consume'); $i = $name->new(output_to => { class => 'TestClientClass' }); ok $i->output_to->can('consume'); }; foreach my $name (qw/ TestMooClass TestMooseClass /) { ok !exception { TestBadClientClass->new }; ok exception { $name->new(output_to => TestBadClientClass->new()) }; ok exception { $name->new(output_to => { class => 'TestBadClientClass' }) }; } done_testing; Moo-2.005005/xt/moo-does-moose-role.t000644 000000 000000 00000007576 14355631140 017240 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; BEGIN { package Ker; use Moo::Role; sub has_ker {} } BEGIN { package Splat; use Moose::Role; requires 'monkey'; sub punch { 1 } sub jab { 0 } around monkey => sub { 'OW' }; has trap => (is => 'ro', default => sub { -1 }); sub has_splat {} } BEGIN { package KerSplat; use Moo::Role; with qw/ Ker Splat /; } BEGIN { package Splattered; use Moo; sub monkey { 'WHAT' } with 'Splat'; sub jab { 3 } } BEGIN { package Ker::Splattered; use Moo; sub monkey { 'WHAT' } with qw/ Ker Splat /; sub jab { 3 } } BEGIN { package KerSplattered; use Moo; sub monkey { 'WHAT' } with qw/ KerSplat /; sub jab { 3 } } BEGIN { package Plunk; use Moo::Role; has pp => (is => 'rw', moosify => sub { my $spec = shift; $spec->{documentation} = 'moosify'; }); } BEGIN { package Plank; use Moo; use Sub::Quote; has vv => (is => 'rw', moosify => [quote_sub(q| $_[0]->{documentation} = 'moosify'; |), sub { $_[0]->{documentation} = $_[0]->{documentation}.' foo'; }]); } BEGIN { package Plunker; use Moose; with 'Plunk'; } BEGIN { package Planker; use Moose; extends 'Plank'; } BEGIN { package Plonk; use Moo; has kk => (is => 'rw', moosify => [sub { $_[0]->{documentation} = 'parent'; }]); } BEGIN { package Plonker; use Moo; extends 'Plonk'; has '+kk' => (moosify => sub { my $spec = shift; $spec->{documentation} .= 'child'; }); } BEGIN{ local $SIG{__WARN__} = sub { fail "warning: $_[0]" }; package SplatteredMoose; use Moose; extends 'Splattered'; } foreach my $s ( Splattered->new, Ker::Splattered->new, KerSplattered->new, SplatteredMoose->new ) { can_ok($s, 'punch') and is($s->punch, 1, 'punch'); can_ok($s, 'jab') and is($s->jab, 3, 'jab'); can_ok($s, 'monkey') and is($s->monkey, 'OW', 'monkey'); can_ok($s, 'trap') and is($s->trap, -1, 'trap'); } foreach my $c (qw/ Ker::Splattered KerSplattered /) { can_ok($c, 'has_ker'); can_ok($c, 'has_splat'); } is(Plunker->meta->find_attribute_by_name('pp')->documentation, 'moosify', 'moosify modifies attr specs'); is(Planker->meta->find_attribute_by_name('vv')->documentation, 'moosify foo', 'moosify modifies attr specs as array'); is( Plonker->meta->find_attribute_by_name('kk')->documentation, 'parentchild', 'moosify applies for overridden attributes with roles'); { package MooseAttrTrait; use Moose::Role; has 'extra_attr' => (is => 'ro'); has 'extra_attr_noinit' => (is => 'ro', init_arg => undef); } { local $SIG{__WARN__} = sub { fail "warning: $_[0]" }; package UsingMooseTrait; use Moo; has one => ( is => 'ro', traits => ['MooseAttrTrait'], extra_attr => 'one', extra_attr_noinit => 'two', ); } ok( UsingMooseTrait->meta ->find_attribute_by_name('one')->can('extra_attr'), 'trait was properly applied'); is( UsingMooseTrait->meta->find_attribute_by_name('one') ->extra_attr, 'one', 'trait attributes maintain values'); { package NeedTrap; use Moo::Role; requires 'trap'; } is exception { package Splattrap; use Moo; sub monkey {} with qw(Splat NeedTrap); }, undef, 'requires satisfied by Moose attribute composed at the same time'; { package HasMonkey; use Moo; sub monkey {} } is exception { Moo::Role->create_class_with_roles('HasMonkey', 'Splat', 'NeedTrap'); }, undef, ' ... and when created by create_class_with_roles'; { package FishRole; use Moose::Role; has fish => (is => 'ro', isa => 'Plunker'); } { package FishClass; use Moo; with 'FishRole'; } is exception { FishClass->new(fish => Plunker->new); }, undef, 'inhaling attr with isa works'; like exception { FishClass->new(fish => 4); }, qr/Type constraint failed/, ' ... and isa check works'; done_testing; Moo-2.005005/xt/moo-consume-mouse-role-coerce.t000644 000000 000000 00000001071 13777150314 021211 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More "$]" < 5.008009 ? (skip_all => 'Mouse is broken on perl <= 5.8.8') : (); { package RoleOne; use Mouse::Role; use Mouse::Util::TypeConstraints; subtype 'Foo', as 'Int'; coerce 'Foo', from 'Str', via { 3 }; has foo => ( is => 'rw', isa => 'Foo', coerce => 1, clearer => '_clear_foo', ); } { package Class; use Moo; # Works if use Moose.. with 'RoleOne'; } my $i = Class->new( foo => 'bar' ); is $i->foo, 3, 'coerce from type works'; done_testing; Moo-2.005005/xt/jenga.t000644 000000 000000 00000001374 13777150314 014517 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package Tower1; use Moo; has 'attr1' => (is => 'ro', required => 1); package Tower2; use Moose; extends 'Tower1'; has 'attr2' => (is => 'ro', required => 1); __PACKAGE__->meta->make_immutable; package Tower3; use Moo; extends 'Tower2'; has 'attr3' => (is => 'ro', required => 1); package Tower4; use Moose; extends 'Tower3'; has 'attr4' => (is => 'ro', required => 1); __PACKAGE__->meta->make_immutable; } foreach my $num (1..4) { my $class = "Tower${num}"; my @attrs = map "attr$_", 1..$num; my %args = map +($_ => "${_}_value"), @attrs; my $obj = $class->new(%args); is($obj->{$_}, "${_}_value", "Attribute $_ ok for $class") for @attrs; } done_testing; Moo-2.005005/xt/inflate-our-classes.t000644 000000 000000 00000001153 14355631140 017300 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use Moo::HandleMoose; foreach my $class (qw( Method::Generate::Accessor Method::Generate::Constructor Method::Generate::BuildAll Method::Generate::DemolishAll )) { my @warnings; local $SIG{__WARN__} = sub { push @warnings, $_[0] }; is exception { (my $file = "$class.pm") =~ s{::}{/}g; require $file; Moo::HandleMoose::inject_real_metaclass_for($class); }, undef, "No exceptions inflating $class"; ok !@warnings, "No warnings inflating $class" or diag "Got warnings: @warnings"; } done_testing; Moo-2.005005/xt/zzz-prereq-versions.t000644 000000 000000 00000002040 13777150314 017421 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; my $meta_file; BEGIN { $ENV{CONTINUOUS_INTEGRATION} or plan skip_all => 'Only runs under CONTINUOUS_INTEGRATION'; eval { require Parse::CPAN::Meta; Parse::CPAN::Meta->VERSION(1.4200) } or plan skip_all => 'Parse::CPAN::Meta required for checking breakages'; ($meta_file) = grep -f, qw(MYMETA.json MYMETA.yml META.json META.yml) or plan skip_all => 'no META file exists'; } use ExtUtils::MakeMaker; my $meta = Parse::CPAN::Meta->load_file($meta_file); my %seen = (perl => 1); my @prereqs = sort grep !$seen{$_}++, 'Devel::StackTrace', 'Package::Stash', 'Package::Stash::XS', 'Eval::Closure', map keys %$_, map values %$_, values %{$meta->{prereqs}}; pass 'reporting prereqs...'; for my $module (@prereqs) { (my $file = "$module.pm") =~ s{::}{/}g; my ($pm_file) = grep -e, map "$_/$file", @INC; my $version = $pm_file ? MM->parse_version($pm_file) : 'missing'; $version = '[undef]' if !defined $version; diag sprintf "%-40s %s", $module, $version; } done_testing; Moo-2.005005/xt/has-after-meta.t000644 000000 000000 00000001151 14355631140 016214 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use Moose (); { package MyClass; use Moo; has attr1 => ( is => 'ro' ); # this will inflate a metaclass and undefer all of the methods, including the # constructor. the constructor still needs to be modifyable though. # Metaclass inflation can happen for unexpected reasons, such as using # namespace::autoclean (but only if Moose has been loaded). __PACKAGE__->meta->name; ::is ::exception { has attr2 => ( is => 'ro' ); }, undef, 'attributes can be added after metaclass inflation'; } done_testing; Moo-2.005005/xt/moose-override-attribute-from-moo-role.t000644 000000 000000 00000001071 14355631140 023047 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package MyRole; use Moo::Role; has foo => ( is => 'ro', required => 1, ); } { package MyClass; use Moose; with 'MyRole'; has '+foo' => ( isa => 'Str', ); } is( exception { MyClass->new(foo => 'bar') }, undef, 'construct' ); ok( exception { MyClass->new(foo => []) }, 'no construct, constraint works' ); ok( exception { MyClass->new() }, 'no construct - require still works' ); done_testing; Moo-2.005005/xt/lib/FatalWarnings.pm000644 000000 000000 00000000150 13777354515 017112 0ustar00rootwheel000000 000000 package FatalWarnings; use strict; use warnings; sub import { $SIG{__WARN__} = sub { die @_ }; } 1; Moo-2.005005/xt/release/kwalitee.t000644 000000 000000 00000000746 14025713454 016657 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; BEGIN { plan skip_all => 'these tests are for release candidate testing' unless $ENV{RELEASE_TESTING}; } use CPAN::Meta; use Test::Kwalitee 'kwalitee_ok'; my ($meta_file) = grep -e, qw(MYMETA.json MYMETA.yml META.json META.yml) or die "unable to find MYMETA or META file!"; my $meta = CPAN::Meta->load_file($meta_file)->as_struct; my @ignore = keys %{$meta->{x_cpants}{ignore}}; kwalitee_ok(map "-$_", @ignore); done_testing; Moo-2.005005/t/role-conflicts-moox.t000644 000000 000000 00000001333 14355631140 017133 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package MooX::ExtendHas; BEGIN { $INC{'MooX/ExtendHas.pm'} = __FILE__ } use Moo::_Utils qw(_install_modifier); sub import { my $target = caller; _install_modifier $target, 'around', 'has', sub { my $orig = shift; $orig->(@_); }; } } { package MyClass; use Moo; } { package MyRole1; use Moo::Role; use MooX::ExtendHas; has foo => (is => "ro"); } { package MyRole2; use Moo::Role; use MooX::ExtendHas; has bar => (is => "ro"); } is exception { Moo::Role->create_class_with_roles('MyClass', qw(MyRole1 MyRole2)) }, undef, "extending has in roles doesn't cause conflicts"; done_testing; Moo-2.005005/t/compose-non-role.t000644 000000 000000 00000000431 14355631140 016422 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; $INC{'MyRole.pm'} = __FILE__; { package MyClass; use Moo; ::like(::exception { with 'MyRole'; }, qr/MyRole is not a Moo::Role/, 'error when composing non-role package'); } done_testing; Moo-2.005005/t/moo-utils.t000644 000000 000000 00000005015 14355631336 015170 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use Moo::_Utils qw( _maybe_load_module ); use InlineModule ( 'Broken::Class' => q{ use strict; use warnings; my $f = flub; }, ); { my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; is exception { ok !_maybe_load_module('Broken::Class'), '_maybe_load_module returns false for broken modules'; }, undef, "_maybe_load_module doesn't die on broken modules"; like $warn[0], qr/Broken::Class exists but failed to load with error/, '_maybe_load_module errors become warnings'; _maybe_load_module('Broken::Class'); is scalar @warn, 1, '_maybe_load_module only warns once per module'; ok !_maybe_load_module('Missing::Module::A'.int rand 10**10), '_maybe_load_module returns false for missing module'; is scalar @warn, 1, " ... and doesn't warn"; } { { package MooTest::Module::WithVariable; our $VARIABLE = 219; } like exception { Moo::_Utils::_load_module('MooTest::Module::WithVariable') }, qr{^Can't locate MooTest/Module/WithVariable\.pm }, '_load_module: inline package with only variable not treated as loaded'; { package MooTest::Module::WithSub; sub glorp { $_[0] + 1 } } is exception { Moo::_Utils::_load_module('MooTest::Module::WithSub') }, undef, '_load_module: inline package with sub treated as loaded'; { package MooTest::Module::WithConstant; use constant GORP => "GLUB"; } is exception { Moo::_Utils::_load_module('MooTest::Module::WithConstant') }, undef, '_load_module: inline package with constant treated as loaded'; { package MooTest::Module::WithListConstant; use constant GORP => "GLUB", "BOGGLE"; } is exception { Moo::_Utils::_load_module('MooTest::Module::WithListConstant') }, undef, '_load_module: inline package with constant treated as loaded'; { package MooTest::Module::WithBEGIN; my $var; BEGIN { $var = 1 } } like exception { Moo::_Utils::_load_module('MooTest::Module::WithBEGIN') }, qr{^Can't locate MooTest/Module/WithBEGIN\.pm }, '_load_module: inline package with only BEGIN not treated as loaded'; { package MooTest::Module::WithSubPackage; package MooTest::Module::WithSubPackage::SubPackage; our $grop = 1; sub grop { 1 } } like exception { Moo::_Utils::_load_module('MooTest::Module::WithSubPackage') }, qr{^Can't locate MooTest/Module/WithSubPackage\.pm }, '_load_module: inline package with sub package not treated as loaded'; } done_testing; Moo-2.005005/t/overloaded-coderefs.t000644 000000 000000 00000003627 13777150314 017162 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; my $codified = 0; { package Dark::Side; use overload q[&{}] => sub { $codified++; shift->to_code }, fallback => 1; sub new { my $class = shift; my $code = shift; bless \$code, $class; } sub to_code { my $self = shift; eval "sub { $$self }"; } } { package The::Force; use Sub::Quote; use base 'Dark::Side'; sub to_code { my $self = shift; return quote_sub $$self; } } my $darkside = Dark::Side->new('my $dummy = "join the dark side"; $_[0] * 2'); is($darkside->(6), 12, 'check Dark::Side coderef'); my $theforce = The::Force->new('my $dummy = "use the force Luke"; $_[0] * 2'); is($theforce->(6), 12, 'check The::Force coderef'); my $luke = The::Force->new('my $z = "I am your father"'); { package Doubleena; use Moo; has a => (is => "rw", coerce => $darkside, isa => sub { 1 }); has b => (is => "rw", coerce => $theforce, isa => $luke); } my $o = Doubleena->new(a => 11, b => 12); is($o->a, 22, 'non-Sub::Quoted inlined coercion overload works'); is($o->b, 24, 'Sub::Quoted inlined coercion overload works'); my $codified_before = $codified; $o->a(5); is($codified_before, $codified, "repeated calls to accessor don't re-trigger overload"); use B::Deparse; my $constructor = B::Deparse->new->coderef2text(Doubleena->can('new')); like($constructor, qr{use the force Luke}, 'Sub::Quoted coercion got inlined'); unlike($constructor, qr{join the dark side}, 'non-Sub::Quoted coercion was not inlined'); like($constructor, qr{I am your father}, 'Sub::Quoted isa got inlined'); require Scalar::Util; is( 0+$luke, 0+( Moo->_constructor_maker_for("Doubleena")->all_attribute_specs->{"b"}{"isa"} ), '$spec->{isa} reference is not mutated', ); is( 0+$theforce, 0+( Moo->_constructor_maker_for("Doubleena")->all_attribute_specs->{"b"}{"coerce"} ), '$spec->{coerce} reference is not mutated', ); done_testing; Moo-2.005005/t/undef-bug.t000644 000000 000000 00000000336 13777150314 015114 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; package Foo; use Moo; has this => (is => 'ro'); package main; my $foo = Foo->new; ok not(exists($foo->{this})), "new objects don't have undef attributes"; done_testing; Moo-2.005005/t/moo.t000644 000000 000000 00000002727 14355631140 014032 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package MyClass0; BEGIN { our @ISA = 'ZeroZero' } use Moo; } BEGIN { is( $INC{'Moo/Object.pm'}, undef, 'Object.pm not loaded if not required' ); } { package MyClass1; use Moo; } is_deeply( [ @MyClass1::ISA ], [ 'Moo::Object' ], 'superclass defaulted' ); { package MyClass2; use base qw(MyClass1); use Moo; } is_deeply( [ @MyClass2::ISA ], [ 'MyClass1' ], 'prior superclass left alone' ); { package MyClass3; use Moo; extends 'MyClass2'; } is_deeply( [ @MyClass3::ISA ], [ 'MyClass2' ], 'extends sets superclass' ); { package WhatTheFlyingFornication; sub wtff {} } { package MyClass4; use Moo; extends 'WhatTheFlyingFornication'; extends qw(MyClass2 MyClass3); } is_deeply( [ @MyClass4::ISA ], [ qw(MyClass2 MyClass3) ], 'extends overwrites' ); { package MyClass5; use Moo; sub foo { 'foo' } around foo => sub { my $orig = shift; $orig->(@_).' with around' }; ::like ::exception { around bar => sub { 'bar' }; }, qr/not found/, 'error thrown when modifiying missing method'; } is(MyClass5->foo, 'foo with around', 'method modifier'); { package MyClass6; use Moo; sub new { bless {}, $_[0]; } } { package MyClass7; use Moo; ::is ::exception { extends 'MyClass6'; has foo => (is => 'ro'); __PACKAGE__->new; }, undef, 'can extend Moo class with overridden new'; } done_testing; Moo-2.005005/t/no-moo.t000644 000000 000000 00000003735 13777150314 014452 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package Spoon; use Moo; no warnings 'redefine'; sub has { "has!" } no Moo; } { package Roller; use Moo::Role; no warnings 'redefine'; sub with { "with!" } no Moo::Role; } { package NoMooClass; no warnings 'redefine'; sub has { "has!" } my %stash = %{Moo::_Utils::_getstash(__PACKAGE__)}; Moo->unimport; my %stash2 = %{Moo::_Utils::_getstash(__PACKAGE__)}; main::is_deeply(\%stash, \%stash2, "stash of non-Moo class remains untouched"); } { package GlobalConflict; use Moo; no warnings 'redefine'; sub has { "has!" } no Moo; our $around = "has!"; no Moo; } { package RollerTiny; use Role::Tiny; no warnings 'redefine'; sub with { "with!" } my %stash = %{Moo::_Utils::_getstash(__PACKAGE__)}; Moo::Role->unimport; my %stash2 = %{Moo::_Utils::_getstash(__PACKAGE__)}; main::is_deeply(\%stash, \%stash2, "stash of non-Moo role remains untouched"); } { package GlobalConflict2; use Moo; no warnings 'redefine'; our $after = "has!"; sub has { $after } no Moo; } ok(!Spoon->can('extends'), 'extends cleaned'); is(Spoon->has, "has!", 'has left alone'); ok(!Roller->can('has'), 'has cleaned'); is(Roller->with, "with!", 'with left alone'); is(NoMooClass->has, "has!", 'has left alone'); ok(!GlobalConflict->can('extends'), 'extends cleaned'); is(GlobalConflict->has, "has!", 'has left alone'); is($GlobalConflict::around, "has!", 'package global left alone'); ok(RollerTiny->can('around'), 'around left alone'); is(RollerTiny->with, "with!", 'with left alone'); ok(!GlobalConflict2->can('extends'), 'extends cleaned'); is(GlobalConflict2->has, "has!", 'has left alone'); is($GlobalConflict2::after, "has!", 'package global left alone'); { package WrappedHas; use Moo; BEGIN { after has => sub { 1; }; } has welp => (is => 'ro'); no Moo; } is +WrappedHas->can('has'), undef, 'has with modifier applied is cleaned'; done_testing; Moo-2.005005/t/demolish-global_destruction.t000644 000000 000000 00000001111 14355631140 020707 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use File::Basename qw(dirname); BEGIN { package Foo; use Moo; sub DEMOLISH { my $self = shift; my ($igd) = @_; ::ok !$igd, 'in_global_destruction state is passed to DEMOLISH properly (false)'; } } { my $foo = Foo->new; } delete $ENV{PERL5LIB}; delete $ENV{PERL5OPT}; my $out = system $^X, (map "-I$_", @INC), dirname(__FILE__).'/global-destruction-helper.pl', 219; is $out >> 8, 219, 'in_global_destruction state is passed to DEMOLISH properly (false)'; done_testing; Moo-2.005005/t/accessor-coerce.t000644 000000 000000 00000005635 14355631160 016303 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; sub run_for { my $class = shift; my $obj = $class->new(plus_three => 1); is($obj->plus_three, 4, "initial value set (${class})"); $obj->plus_three(4); is($obj->plus_three, 7, 'Value changes after set'); } sub run_with_default_for { my $class = shift; my $obj = $class->new(); is($obj->plus_three, 4, "initial value set (${class})"); $obj->plus_three(4); is($obj->plus_three, 7, 'Value changes after set'); } { package Foo; use Moo; has plus_three => ( is => 'rw', coerce => sub { $_[0] + 3 } ); } run_for 'Foo'; { package Bar; use Sub::Quote; use Moo; has plus_three => ( is => 'rw', coerce => quote_sub q{ my ($x) = @_; $x + 3 } ); } run_for 'Bar'; { package Baz; use Sub::Quote; use Moo; has plus_three => ( is => 'rw', coerce => quote_sub( q{ my ($value) = @_; $value + $plus }, { '$plus' => \3 } ) ); } run_for 'Baz'; { package Biff; use Sub::Quote; use Moo; has plus_three => ( is => 'rw', coerce => quote_sub( q{ die 'could not add three!' }, ) ); } like exception { Biff->new(plus_three => 1) }, qr/coercion for "plus_three" failed: could not add three!/, 'Exception properly thrown'; { package Foo2; use Moo; has plus_three => ( is => 'rw', default => sub { 1 }, coerce => sub { $_[0] + 3 } ); } run_with_default_for 'Foo2'; { package Bar2; use Sub::Quote; use Moo; has plus_three => ( is => 'rw', default => sub { 1 }, coerce => quote_sub q{ my ($x) = @_; $x + 3 } ); } run_with_default_for 'Bar2'; { package Baz2; use Sub::Quote; use Moo; has plus_three => ( is => 'rw', default => sub { 1 }, coerce => quote_sub( q{ my ($value) = @_; $value + $plus }, { '$plus' => \3 } ) ); } run_with_default_for 'Baz2'; { package Biff2; use Sub::Quote; use Moo; has plus_three => ( is => 'rw', default => sub { 1 }, coerce => quote_sub( q{ die 'could not add three!' }, ) ); } like exception { Biff2->new() }, qr/could not add three!/, 'Exception properly thrown'; { package Foo3; use Moo; has plus_three => ( is => 'rw', default => sub { 1 }, coerce => sub { $_[0] + 3 }, lazy => 1, ); } run_with_default_for 'Foo3'; { package Bar3; use Sub::Quote; use Moo; has plus_three => ( is => 'rw', default => sub { 1 }, coerce => quote_sub(q{ my ($x) = @_; $x + 3 }), lazy => 1, ); } run_with_default_for 'Bar3'; { package CoerceWriter; use Moo; has attr => ( is => 'rwp', coerce => sub { die 'triggered' }, ); } like exception { CoerceWriter->new->_set_attr( 4 ) }, qr/triggered/, "coerce triggered via writer"; done_testing; Moo-2.005005/t/sub-and-handles.t000644 000000 000000 00000003225 13777150314 016205 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package DelegateBar; use Moo; sub bar { 'unextended!' } package Does::DelegateToBar; use Moo::Role; has _barrer => ( is => 'ro', default => sub { DelegateBar->new }, handles => { _bar => 'bar' }, ); sub get_barrer { $_[0]->_barrer } package ConsumesDelegateToBar; use Moo; with 'Does::DelegateToBar'; has bong => ( is => 'ro' ); package Does::OverrideDelegate; use Moo::Role; sub _bar { 'extended' } package First; use Moo; extends 'ConsumesDelegateToBar'; with 'Does::OverrideDelegate'; has '+_barrer' => ( is => 'rw' ); package Second; use Moo; extends 'ConsumesDelegateToBar'; sub _bar { 'extended' } has '+_barrer' => ( is => 'rw' ); package Fourth; use Moo; extends 'ConsumesDelegateToBar'; sub _bar { 'extended' } has '+_barrer' => ( is => 'rw', handles => { _baz => 'bar' }, ); package Third; use Moo; extends 'ConsumesDelegateToBar'; with 'Does::OverrideDelegate'; has '+_barrer' => ( is => 'rw', handles => { _baz => 'bar' }, ); } is(First->new->_bar, 'extended', 'overriding delegate method with role works'); is(Fourth->new->_bar, 'extended', '... even when you specify other delegates in subclass'); is(Fourth->new->_baz, 'unextended!', '... and said other delegate still works'); is(Second->new->_bar, 'extended', 'overriding delegate method directly works'); is(Third->new->_bar, 'extended', '... even when you specify other delegates in subclass'); is(Third->new->_baz, 'unextended!', '... and said other delegate still works'); done_testing; Moo-2.005005/t/modifiers.t000644 000000 000000 00000001243 13777150314 015217 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package SomeObject; use Moo; use Sub::Defer qw(defer_sub); my $gen = 0; defer_sub 'SomeObject::deferred_sub' => sub { $gen++; sub { 1 }; }; after deferred_sub => sub { 1; }; ::is $gen, 1, 'applying modifier undefers subs'; my $gen_multi = 0; defer_sub 'SomeObject::deferred_sub_guff' => sub { $gen_multi++; sub { 1 }; }; defer_sub 'SomeObject::deferred_sub_wark' => sub { $gen_multi++; sub { 1 }; }; after [qw(deferred_sub_guff deferred_sub_wark)] => sub { 1; }; ::is $gen_multi, 2, 'applying modifier to multiple subs undefers'; } done_testing; Moo-2.005005/t/load_module_error.t000644 000000 000000 00000000777 14355631311 016740 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use InlineModule ( 'BrokenExtends' => qq{ package BrokenExtends; use Moo; extends "This::Class::Does::Not::Exist::${\int rand 50000}"; }, 'BrokenExtends::Child' => q{ package BrokenExtends::Child; use Moo; extends 'BrokenExtends'; }, ); my $e = exception { require BrokenExtends::Child }; ok $e, "got a crash"; unlike $e, qr/Unknown error/, "it came with a useful error message"; done_testing; Moo-2.005005/t/does.t000644 000000 000000 00000001342 13777150314 014170 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; BEGIN { package TestParent; use Moo; } BEGIN { package TestClass; use Moo; extends 'TestParent'; has attr1 => (is => 'ro'); } BEGIN { ok !TestClass->does('TestRole'), "->does returns false for arbitrary role"; ok !$INC{'Moo/Role.pm'}, "Moo::Role not loaded by does"; } BEGIN { package TestRole; use Moo::Role; has attr2 => (is => 'ro'); } BEGIN { package TestClass; with 'TestRole'; } BEGIN { ok +TestClass->does('TestRole'), "->does returns true for composed role"; ok +TestClass->DOES('TestRole'), "->DOES returns true for composed role"; ok +TestClass->DOES('TestParent'), "->DOES returns true for parent class"; } done_testing; Moo-2.005005/t/accessor-isa.t000644 000000 000000 00000011542 14355631230 015607 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; sub run_for { my $class = shift; my $obj = $class->new(less_than_three => 1); is($obj->less_than_three, 1, "initial value set (${class})"); like( exception { $obj->less_than_three(4) }, qr/isa check for "less_than_three" failed: 4 is not less than three/, "exception thrown on bad set (${class})" ); is($obj->less_than_three, 1, "initial value remains after bad set (${class})"); my $ret; is( exception { $ret = $obj->less_than_three(2) }, undef, "no exception on correct set (${class})" ); is($ret, 2, "correct setter return (${class})"); is($obj->less_than_three, 2, "correct getter return (${class})"); is(exception { $class->new }, undef, "no exception with no value (${class})"); like( exception { $class->new(less_than_three => 12) }, qr/isa check for "less_than_three" failed: 12 is not less than three/, "exception thrown on bad constructor arg (${class})" ); } { package Foo; use Moo; has less_than_three => ( is => 'rw', isa => sub { die "$_[0] is not less than three" unless $_[0] < 3 } ); } run_for 'Foo'; { package Bar; use Sub::Quote; use Moo; has less_than_three => ( is => 'rw', isa => quote_sub q{ my ($x) = @_; die "$x is not less than three" unless $x < 3 } ); } run_for 'Bar'; { package Baz; use Sub::Quote; use Moo; has less_than_three => ( is => 'rw', isa => quote_sub( q{ my ($value) = @_; die "$value is not less than ${word}" unless $value < $limit }, { '$limit' => \3, '$word' => \'three' } ) ); } run_for 'Baz'; my $lt3; { package LazyFoo; use Sub::Quote; use Moo; has less_than_three => ( is => 'lazy', isa => quote_sub(q{ die "$_[0] is not less than three" unless $_[0] < 3 }) ); sub _build_less_than_three { $lt3 } } $lt3 = 4; my $lazyfoo = LazyFoo->new; like( exception { $lazyfoo->less_than_three }, qr/isa check for "less_than_three" failed: 4 is not less than three/, "exception thrown on bad builder return value (LazyFoo)" ); $lt3 = 2; is( exception { $lazyfoo->less_than_three }, undef, 'Corrected builder value on existing object returned ok' ); is(LazyFoo->new->less_than_three, 2, 'Correct builder value returned ok'); { package Fizz; use Moo; has attr1 => ( is => 'ro', isa => sub { no warnings 'once'; my $attr = $Method::Generate::Accessor::CurrentAttribute; die bless [@$attr{'name', 'init_arg', 'step'}], 'MyException'; }, init_arg => 'attr_1', ); } my $e = exception { Fizz->new(attr_1 => 5) }; is( ref($e), 'MyException', 'Exception objects passed though correctly', ); is($e->[0], 'attr1', 'attribute name available in isa check'); is($e->[1], 'attr_1', 'attribute init_arg available in isa check'); is($e->[2], 'isa check', 'step available in isa check'); { my $called; local $SIG{__DIE__} = sub { $called++; die $_[0] }; my $e = exception { Fizz->new(attr_1 => 5) }; ok($called, '__DIE__ handler called if set') } { package ClassWithDeadlyIsa; use Moo; has foo => (is => 'ro', isa => sub { die "nope" }); package ClassUsingDeadlyIsa; use Moo; has bar => (is => 'ro', coerce => sub { ClassWithDeadlyIsa->new(foo => $_[0]) }); } like exception { ClassUsingDeadlyIsa->new(bar => 1) }, qr/isa check for "foo" failed: nope/, 'isa check within isa check produces correct exception'; { package IsaWriter; use Moo; has attr => ( is => 'rwp', isa => sub { die 'triggered' }, ); } like exception { IsaWriter->new->_set_attr( 4 ) }, qr/triggered/, "isa triggered via writer"; { package ClassWithEvilDestroy; sub new { bless {}, $_[0] } sub DESTROY { eval { 1; # nop }; } package ClassWithEvilException; use Moo; has foo => (is => 'rw', isa => sub { local $@; die "welp"; }); has bar => (is => 'rw', isa => sub { my $o = ClassWithEvilDestroy->new; die "welp"; }); my $error; has baz => (is => 'rw', isa => sub { ::is $@, $error, '$@ unchanged inside isa'; 1; }); my $o = ClassWithEvilException->new; ::like ::exception { $o->foo(1) }, qr/isa check for "foo" failed:/, 'got proper exception with localized $@'; ::like ::exception { $o->bar(1) }, qr/isa check for "bar" failed:/, 'got proper exception with eval in DESTROY'; eval { die "blah\n" }; $error = $@; $o->baz(1); ::is $@, $error, '$@ unchanged after successful isa'; } { package TestClassWithStub; use Moo; sub stub_isa; ::is ::exception { has attr1 => (is => 'ro', isa => \&stub_isa); }, undef, 'stubs allowed for isa checks'; eval q{ sub stub_isa { die "stub isa check"; } 1; } or die $@; ::like ::exception { __PACKAGE__->new(attr1 => 1) }, qr/stub isa check/, 'stub isa works after being defined'; } done_testing; Moo-2.005005/t/use-after-no.t000644 000000 000000 00000000773 13777150314 015552 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; ok eval q{ package Spoon; use Moo; has foo => ( is => 'ro' ); no Moo; use Moo; has foo2 => ( is => 'ro' ); no Moo; 1; }, "subs imported on 'use Moo;' after 'no Moo;'" or diag $@; ok eval q{ package Roller; use Moo::Role; has foo => ( is => 'ro' ); no Moo::Role; use Moo::Role; has foo2 => ( is => 'ro' ); no Moo::Role; 1; }, "subs imported on 'use Moo::Role;' after 'no Moo::Role;'" or diag $@; done_testing; Moo-2.005005/t/extends-role.t000644 000000 000000 00000000375 14355631140 015646 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package MyRole; use Moo::Role; } { package MyClass; use Moo; ::isnt ::exception { extends "MyRole"; }, undef, "Can't extend role"; } done_testing; Moo-2.005005/t/accessor-default.t000644 000000 000000 00000006070 14355631167 016470 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; my $c_ran; { package Foo; use Sub::Quote; use Moo; has one => (is => 'ro', lazy => 1, default => quote_sub q{ {} }); has two => (is => 'ro', lazy => 1, builder => '_build_two'); sub _build_two { {} } has three => (is => 'ro', default => quote_sub q{ {} }); has four => (is => 'ro', builder => '_build_four'); sub _build_four { {} } has five => (is => 'ro', init_arg => undef, default => sub { {} }); has six => (is => 'ro', builder => 1); sub _build_six { {} } has seven => (is => 'ro', required => 1, default => quote_sub q{ {} }); has eight => (is => 'ro', builder => '_build_eight', coerce => sub { $c_ran = 1; $_[0] }); sub _build_eight { {} } has nine => (is => 'lazy', coerce => sub { $c_ran = 1; $_[0] }); sub _build_nine { {} } has ten => (is => 'lazy', default => 5 ); has eleven => (is => 'ro', default => 5 ); has twelve => (is => 'lazy', default => 0 ); has thirteen => (is => 'ro', default => 0 ); has fourteen => (is => 'ro', required => 1, builder => '_build_fourteen'); sub _build_fourteen { {} } has fifteen => (is => 'lazy', default => undef); # DIE handler was leaking into defaults when coercion is on. has default_with_coerce => ( is => 'rw', coerce => sub { return $_[0] }, default => sub { eval { die "blah\n" }; return $@; } ); has default_no_coerce => ( is => 'rw', default => sub { eval { die "blah\n" }; return $@; } ); } sub check { my ($attr, @h) = @_; is_deeply($h[$_], {}, "${attr}: empty hashref \$h[$_]") for 0..1; isnt($h[0],$h[1], "${attr}: not the same hashref"); } check one => map Foo->new->one, 1..2; check two => map Foo->new->two, 1..2; check three => map Foo->new->{three}, 1..2; check four => map Foo->new->{four}, 1..2; check five => map Foo->new->{five}, 1..2; check six => map Foo->new->{six}, 1..2; check seven => map Foo->new->{seven}, 1..2; check fourteen => map Foo->new->{fourteen}, 1..2; check eight => map Foo->new->{eight}, 1..2; ok($c_ran, 'coerce defaults'); $c_ran = 0; check nine => map Foo->new->nine, 1..2; ok($c_ran, 'coerce lazy default'); is(Foo->new->ten, 5, 'non-ref default'); is(Foo->new->eleven, 5, 'eager non-ref default'); is(Foo->new->twelve, 0, 'false non-ref default'); is(Foo->new->thirteen, 0, 'eager false non-ref default'); my $foo = Foo->new; is($foo->fifteen, undef, 'undef default'); ok(exists $foo->{fifteen}, 'undef default is stored'); is( Foo->new->default_with_coerce, "blah\n", "exceptions in defaults not modified with coerce" ); is( Foo->new->default_no_coerce, "blah\n", "exceptions in defaults not modified without coerce" ); { package Bar; use Moo; has required_false_default => (is => 'ro', required => 1, default => 0); ::is ::exception { has required_is_lazy_no_init_arg => ( is => 'lazy', required => 1, init_arg => undef, ); }, undef, 'is => lazy satisfies requires'; } is exception { Bar->new }, undef, 'required attributes with false defaults work'; done_testing; Moo-2.005005/t/demolish-throw.t000644 000000 000000 00000002027 14355631140 016176 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package Foo; use Moo; sub DEMOLISH { die "Error in DEMOLISH"; } } my @warnings; my @looped_exceptions; my $o = Foo->new; { local $SIG{__WARN__} = sub { push @warnings, $_[0]; }; # make sure we don't loop infinitely my $last_die; local $SIG{__DIE__} = sub { my $location = join(':', caller); if ($last_die && $last_die eq $location) { push @looped_exceptions, $_[0]; die @_; } $last_die = $location; }; { no warnings FATAL => 'misc'; use warnings 'misc'; undef $o; # if undef is the last statement in a block, its effect is delayed until # after the block is cleaned up (and our warning settings won't be applied) 1; } } like $warnings[0], qr/\(in cleanup\) Error in DEMOLISH/, 'error in DEMOLISH converted to warning'; is scalar @warnings, 1, 'no other warnings generated'; is scalar @looped_exceptions, 0, 'no infinitely looping exception in DESTROY'; done_testing; Moo-2.005005/t/has-before-extends.t000644 000000 000000 00000000557 13777150314 016730 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package Fail1; use Moo; has 'attr1' => (is => 'ro'); package Fail2; use Moo; has 'attr2' => (is => 'ro'); extends 'Fail1'; } my $new = Fail2->new({ attr1 => 'value1', attr2 => 'value2' }); is($new->attr1, 'value1', 'inherited attr ok'); is($new->attr2, 'value2', 'subclass attr ok'); done_testing; Moo-2.005005/t/demolish-basics.t000644 000000 000000 00000001575 14355631140 016306 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; our @demolished; package Foo; use Moo; sub DEMOLISH { my $self = shift; push @::demolished, __PACKAGE__; } package Foo::Sub; use Moo; extends 'Foo'; sub DEMOLISH { my $self = shift; push @::demolished, __PACKAGE__; } package Foo::Sub::Sub; use Moo; extends 'Foo::Sub'; sub DEMOLISH { my $self = shift; push @::demolished, __PACKAGE__; } package main; { my $foo = Foo->new; } is_deeply(\@demolished, ['Foo'], "Foo demolished properly"); @demolished = (); { my $foo_sub = Foo::Sub->new; } is_deeply(\@demolished, ['Foo::Sub', 'Foo'], "Foo::Sub demolished properly"); @demolished = (); { my $foo_sub_sub = Foo::Sub::Sub->new; } is_deeply(\@demolished, ['Foo::Sub::Sub', 'Foo::Sub', 'Foo'], "Foo::Sub::Sub demolished properly"); @demolished = (); done_testing; Moo-2.005005/t/global_underscore.t000644 000000 000000 00000001146 14355630331 016724 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use InlineModule ( 'UnderscoreClass' => q{ package UnderscoreClass; use Moo; with qw(UnderscoreRole); sub c1 { 'c1' }; 1; }, 'UnderscoreRole' => q{ package UnderscoreRole; use Moo::Role; use ClobberUnderscore; sub r1 { 'r1' }; 1; }, 'ClobberUnderscore' => q{ package ClobberUnderscore; sub h1 { 'h1' }; undef $_; 1; }, ); use_ok('UnderscoreClass'); is( UnderscoreClass->c1, 'c1', ); is( UnderscoreClass->r1, 'r1', ); is( ClobberUnderscore::h1(), 'h1', ); done_testing; Moo-2.005005/t/buildall.t000644 000000 000000 00000003547 13777150314 015037 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; my @ran; { package Foo; use Moo; sub BUILD { push @ran, 'Foo' } package Bar; use Moo; extends 'Foo'; sub BUILD { push @ran, 'Bar' } package Baz; use Moo; extends 'Bar'; package Quux; use Moo; extends 'Baz'; sub BUILD { push @ran, 'Quux' } } { package Fleem; use Moo; extends 'Quux'; has 'foo' => (is => 'ro'); sub BUILD { push @ran, $_[0]->foo, $_[1]->{bar} } } { package Odd1; use Moo; has 'odd1' => (is => 'ro'); sub BUILD { push @ran, 'Odd1' } package Odd2; use Moo; extends 'Odd1'; package Odd3; use Moo; extends 'Odd2'; has 'odd3' => (is => 'ro'); sub BUILD { push @ran, 'Odd3' } } { package Sub1; use Moo; has 'foo' => (is => 'ro'); package Sub2; use Moo; extends 'Sub1'; sub BUILD { push @ran, "sub2" } } my $o = Quux->new; is(ref($o), 'Quux', 'object returned'); is_deeply(\@ran, [ qw(Foo Bar Quux) ], 'BUILDs ran in order'); @ran = (); $o = Fleem->new(foo => 'Fleem1', bar => 'Fleem2'); is(ref($o), 'Fleem', 'object with inline constructor returned'); is_deeply(\@ran, [ qw(Foo Bar Quux Fleem1 Fleem2) ], 'BUILDs ran in order'); @ran = (); $o = Odd3->new(odd1 => 1, odd3 => 3); is(ref($o), 'Odd3', 'Odd3 object constructed'); is_deeply(\@ran, [ qw(Odd1 Odd3) ], 'BUILDs ran in order'); @ran = (); $o = Sub2->new; is(ref($o), 'Sub2', 'Sub2 object constructed'); is_deeply(\@ran, [ qw(sub2) ], 'BUILD ran'); @ran = (); $o = Sub2->new(__no_BUILD__ => 1); is_deeply(\@ran, [], '__no_BUILD__ surpresses BUILD running'); { package WithCoerce; use Moo; has attr1 => ( is => 'ro', coerce => sub { $_[0] + 5 } ); has build_params => ( is => 'rw', init_arg => undef ); sub BUILD { my ($self, $args) = @_; $self->build_params($args); } } $o = WithCoerce->new(attr1 => 2); is +$o->build_params->{attr1}, 2, 'BUILD gets uncoerced arguments'; done_testing; Moo-2.005005/t/mutual-requires.t000644 000000 000000 00000001527 14355631351 016405 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; is exception { package RoleA; use Moo::Role; requires 'method_b'; requires 'attr_b'; sub method_a {} has attr_a => (is => 'ro'); }, undef, 'define role a'; is exception { package RoleB; use Moo::Role; requires 'method_a'; requires 'attr_a'; sub method_b {} has attr_b => (is => 'ro'); }, undef, 'define role a'; is exception { package RoleC; use Moo::Role; with 'RoleA', 'RoleB'; 1; }, undef, 'compose roles with mutual requires into role'; is exception { package PackageWithPrecomposed; use Moo; with 'RoleC'; 1; }, undef, 'compose precomposed roles into package'; is exception { package PackageWithCompose; use Moo; with 'RoleA', 'RoleB'; 1; }, undef, 'compose roles with mutual requires into package'; done_testing; Moo-2.005005/t/buildargs.t000644 000000 000000 00000006316 13777150314 015220 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package Qux; use Moo; has bar => ( is => "rw" ); has baz => ( is => "rw" ); package Quux; use Moo; extends qw(Qux); } { package NonMooClass; sub new { my ($class, $arg) = @_; bless { attr => $arg }, $class; } sub attr { shift->{attr} } package Extends::NonMooClass::WithAttr; use Moo; extends qw( NonMooClass ); has 'attr2' => ( is => 'ro' ); sub BUILDARGS { my ( $class, @args ) = @_; shift @args if @args % 2 == 1; return { @args }; } } { package Foo; use Moo; has bar => ( is => "rw" ); has baz => ( is => "rw" ); sub BUILDARGS { my ( $class, @args ) = @_; unshift @args, "bar" if @args % 2 == 1; return $class->SUPER::BUILDARGS(@args); } package Bar; use Moo; extends qw(Foo); } { package Baz; use Moo; has bar => ( is => "rw" ); has baz => ( is => "rw" ); around BUILDARGS => sub { my $orig = shift; my ( $class, @args ) = @_; unshift @args, "bar" if @args % 2 == 1; return $class->$orig(@args); }; package Biff; use Moo; extends qw(Baz); } foreach my $class (qw(Foo Bar Baz Biff)) { is( $class->new->bar, undef, "no args" ); is( $class->new( bar => 42 )->bar, 42, "normal args" ); is( $class->new( 37 )->bar, 37, "single arg" ); { my $o = $class->new(bar => 42, baz => 47); is($o->bar, 42, '... got the right bar'); is($o->baz, 47, '... got the right baz'); } { my $o = $class->new(42, baz => 47); is($o->bar, 42, '... got the right bar'); is($o->baz, 47, '... got the right baz'); } } foreach my $class (qw(Qux Quux)) { my $o = $class->new(bar => 42, baz => 47); is($o->bar, 42, '... got the right bar'); is($o->baz, 47, '... got the right baz'); eval { $class->new( 37 ); }; like( $@, qr/Single parameters to new\(\) must be a HASH ref/, "new() requires a list or a HASH ref" ); eval { $class->new( [ 37 ] ); }; like( $@, qr/Single parameters to new\(\) must be a HASH ref/, "new() requires a list or a HASH ref" ); eval { $class->new( bar => 42, baz => 47, 'quux' ); }; like( $@, qr/You passed an odd number of arguments/, "new() requires a list or a HASH ref" ); } my $non_moo = NonMooClass->new( 'bar' ); my $ext_non_moo = Extends::NonMooClass::WithAttr->new( 'bar', attr2 => 'baz' ); is $non_moo->attr, 'bar', "non-moo accepts params"; is $ext_non_moo->attr, 'bar', "extended non-moo passes params"; is $ext_non_moo->attr2, 'baz', "extended non-moo has own attributes"; { package NoAttr; use Moo; before BUILDARGS => sub { our $buildargs_called++; }; } eval { NoAttr->BUILDARGS( 37 ); }; like( $@, qr/Single parameters to new\(\) must be a HASH ref/, "default BUILDARGS requires a list or a HASH ref" ); $NoAttr::buildargs_called = 0; my $noattr = NoAttr->new({ foo => 'bar' }); is $noattr->{foo}, undef, 'without attributes, no params are stored'; is $NoAttr::buildargs_called, 1, 'BUILDARGS called even without attributes'; done_testing; Moo-2.005005/t/not-methods.t000644 000000 000000 00000003262 13777150314 015502 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; BEGIN { package FooClass; sub early { 1 } sub early_constant { 2 } use Moo; sub late { 2 } sub late_constant { 2 } } BEGIN { is_deeply [sort keys %{Moo->_concrete_methods_of('FooClass')}], [qw(late late_constant)], 'subs created before use Moo are not methods'; } BEGIN { package BarClass; sub early { 1 } use Moo; sub late { 2 } no warnings 'redefine'; sub early { 3 } } BEGIN { is_deeply [sort keys %{Moo->_concrete_methods_of('BarClass')}], [qw(early late)], 'only same subrefs created before use Moo are not methods'; } BEGIN { package FooRole; sub early { 1 } use Moo::Role; sub late { 2 } } BEGIN { is_deeply [sort keys %{Moo::Role->_concrete_methods_of('FooRole')}], [qw(late)], 'subs created before use Moo::Role are not methods'; } BEGIN { package BarRole; sub early { 1 } use Moo::Role; sub late { 2 } no warnings 'redefine'; sub early { 3 } } BEGIN { is_deeply [sort keys %{Moo::Role->_concrete_methods_of('BarRole')}], [qw(early late)], 'only same subrefs created before use Moo::Role are not methods'; } SKIP: { skip 'code refs directly in the stash not stable until perl 5.26.1', 1 unless "$]" >= 5.026001; eval '#line '.(__LINE__).' "'.__FILE__.qq["\n].q{ package Gwaf; BEGIN { $Gwaf::{foo} = sub { 'foo' }; } use constant plorp => 1; use Moo; BEGIN { $Gwaf::{frab} = sub { 'frab' }; } use constant terg => 1; 1; } or die $@; is_deeply [sort keys %{Moo->_concrete_methods_of('Gwaf')}], [qw(frab terg)], 'subrefs stored directly in stash treated the same as those with globs'; } done_testing; Moo-2.005005/t/load_module.t000644 000000 000000 00000001146 14355630416 015523 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; # this test is replicated to t/load_module_role_tiny.t for Role::Tiny use Moo::_Utils qw(_load_module); use InlineModule ( 'Foo::Bar' => q{ package Foo::Bar; sub baz { 1 } 1; }, 'BrokenModule' => q{ package BrokenModule; use strict; sub guff { 1 } ;_; }, ); { package Foo::Bar::Baz; sub quux { } } _load_module("Foo::Bar"); ok(eval { Foo::Bar->baz }, 'Loaded module ok'); ok do { my $e; eval { _load_module("BrokenModule"); 1 } or $e = $@; $e }, 'broken module that installs subs gives error'; done_testing; Moo-2.005005/t/demolish-bugs-eats_exceptions.t000644 000000 000000 00000007107 14355631140 021172 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; my $FilePath = sub { die "does not pass the type constraint" if $_[0] eq '/' }; { package Baz; use Moo; has 'path' => ( is => 'ro', isa => $FilePath, required => 1, ); sub BUILD { my ( $self, $params ) = @_; die $params->{path} . " does not exist" unless -e $params->{path}; } # Defining this causes the FIRST call to Baz->new w/o param to fail, # if no call to ANY Moo::Object->new was done before. sub DEMOLISH { my ( $self ) = @_; } } { package Qee; use Moo; has 'path' => ( is => 'ro', isa => $FilePath, required => 1, ); sub BUILD { my ( $self, $params ) = @_; die $params->{path} . " does not exist" unless -e $params->{path}; } # Defining this causes the FIRST call to Qee->new w/o param to fail... # if no call to ANY Moo::Object->new was done before. sub DEMOLISH { my ( $self ) = @_; } } { package Foo; use Moo; has 'path' => ( is => 'ro', isa => $FilePath, required => 1, ); sub BUILD { my ( $self, $params ) = @_; die $params->{path} . " does not exist" unless -e $params->{path}; } # Having no DEMOLISH, everything works as expected... } check_em ( 'Baz' ); # 'Baz plain' will fail, aka NO error check_em ( 'Qee' ); # ok check_em ( 'Foo' ); # ok check_em ( 'Qee' ); # 'Qee plain' will fail, aka NO error check_em ( 'Baz' ); # ok check_em ( 'Foo' ); # ok check_em ( 'Foo' ); # ok check_em ( 'Baz' ); # ok ! check_em ( 'Qee' ); # ok sub check_em { my ( $pkg ) = @_; my ( %param, $obj ); # Uncomment to see, that it is really any first call. # Subsequents calls will not fail, aka giving the correct error. { local $@; my $obj = eval { $pkg->new; }; ::like( $@, qr/Missing required argument/, "... $pkg plain" ); ::is( $obj, undef, "... the object is undef" ); } { local $@; my $obj = eval { $pkg->new(); }; ::like( $@, qr/Missing required argument/, "... $pkg empty" ); ::is( $obj, undef, "... the object is undef" ); } { local $@; my $obj = eval { $pkg->new ( notanattr => 1 ); }; ::like( $@, qr/Missing required argument/, "... $pkg undef" ); ::is( $obj, undef, "... the object is undef" ); } { local $@; my $obj = eval { $pkg->new ( %param ); }; ::like( $@, qr/Missing required argument/, "... $pkg undef param" ); ::is( $obj, undef, "... the object is undef" ); } { local $@; my $obj = eval { $pkg->new ( path => '/' ); }; ::like( $@, qr/does not pass the type constraint/, "... $pkg root path forbidden" ); ::is( $obj, undef, "... the object is undef" ); } { local $@; my $obj = eval { $pkg->new ( path => '/this_path/does/not_exist' ); }; ::like( $@, qr/does not exist/, "... $pkg non existing path" ); ::is( $obj, undef, "... the object is undef" ); } { local $@; my $obj = eval { $pkg->new ( path => __FILE__ ); }; ::is( $@, '', "... $pkg no error" ); ::isa_ok( $obj, $pkg ); ::isa_ok( $obj, 'Moo::Object' ); ::is( $obj->path, __FILE__, "... $pkg got the right value" ); } } done_testing; Moo-2.005005/t/buildall-subconstructor.t000644 000000 000000 00000003243 13777150314 020125 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; my @ran; { package Foo; use Moo; sub BUILD { push @ran, 'Foo' } package Bar; use Moo; extends 'Foo'; sub BUILD { push @ran, 'Bar' } package Baz; use Moo; extends 'Bar'; package Quux; use Moo; extends 'Baz'; sub BUILD { push @ran, 'Quux' } } { package Fleem; use Moo; extends 'Quux'; has 'foo' => (is => 'ro'); sub BUILD { push @ran, $_[0]->foo, $_[1]->{bar} } } { package Odd1; use Moo; has 'odd1' => (is => 'ro'); sub BUILD { push @ran, 'Odd1' } package Odd2; use Moo; extends 'Odd1'; package Odd3; use Moo; extends 'Odd2'; has 'odd3' => (is => 'ro'); sub BUILD { push @ran, 'Odd3' } } { package Sub1; use Moo; has 'foo' => (is => 'ro'); package Sub2; use Moo; extends 'Sub1'; sub BUILD { push @ran, "sub2" } } my @tests = ( 'Foo' => { ran => [qw( Foo )], }, 'Bar' => { ran => [qw( Foo Bar )], }, 'Baz' => { ran => [qw( Foo Bar )], }, 'Quux' => { ran => [qw( Foo Bar Quux )], }, 'Fleem' => { ran => [qw( Foo Bar Quux Fleem1 Fleem2 )], args => [ foo => 'Fleem1', bar => 'Fleem2' ], }, 'Odd1' => { ran => [qw( Odd1 )], }, 'Odd2' => { ran => [qw( Odd1 )], }, 'Odd3' => { ran => [qw( Odd1 Odd3 )], args => [ odd1 => 1, odd3 => 3 ], }, 'Sub1' => { ran => [], }, 'Sub2' => { ran => [qw( sub2 )], }, ); while ( my ($class, $conf) = splice(@tests,0,2) ) { my $o = $class->new( @{ $conf->{args} || [] } ); isa_ok($o, $class); is_deeply(\@ran, $conf->{ran}, 'BUILDs ran in order'); @ran = (); } done_testing; Moo-2.005005/t/method-generate-constructor.t000644 000000 000000 00000003631 14355631140 020666 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use Method::Generate::Constructor; use Method::Generate::Accessor; my $gen = Method::Generate::Constructor->new( accessor_generator => Method::Generate::Accessor->new ); $gen->generate_method('Foo', 'new', { one => { }, two => { init_arg => undef }, three => { init_arg => 'THREE' } }); my $first = Foo->new({ one => 1, two => 2, three => -75, THREE => 3, four => 4, }); is_deeply( { %$first }, { one => 1, three => 3 }, 'init_arg handling ok' ); $gen->generate_method('Bar', 'new' => { one => { required => 1 }, three => { init_arg => 'THREE', required => 1 } }); like( exception { Bar->new }, qr/Missing required arguments: THREE, one/, 'two missing args reported correctly' ); like( exception { Bar->new(THREE => 3) }, qr/Missing required arguments: one/, 'one missing arg reported correctly' ); is( exception { Bar->new(one => 1, THREE => 3) }, undef, 'pass with both required args' ); is( exception { Bar->new({ one => 1, THREE => 3 }) }, undef, 'hashrefs also supported' ); is( exception { $first->new(one => 1, THREE => 3) }, undef, 'calling ->new on an object works' ); like( exception { $gen->register_attribute_specs('seventeen' => { is => 'ro', init_arg => undef, required => 1 }) }, qr/You cannot have a required attribute/, 'required not allowed with init_arg undef' ); is( exception { $gen->register_attribute_specs('eighteen' => { is => 'ro', init_arg => undef, required => 1, default => 'foo' }) }, undef, 'required allowed with init_arg undef if given a default' ); is ref($gen->current_constructor('Bar')), 'CODE', 'can find constructor'; { package Baz; sub baz {}; } is $gen->current_constructor('Baz'), undef, 'nonexistent constructor returns undef'; { is $gen->_cap_call('welp'), 'welp', "_cap_call returns code"; } done_testing; Moo-2.005005/t/load_module_role_tiny.t000644 000000 000000 00000001146 14355630422 017604 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; # this test is replicated to t/load_module.t for Moo::_Utils use Role::Tiny (); use InlineModule ( 'Foo::Bar' => q{ package Foo::Bar; sub baz { 1 } 1; }, 'BrokenModule' => q{ package BrokenModule; use strict; sub guff { 1 } ;_; }, ); { package Foo::Bar::Baz; sub quux { } } Role::Tiny::_load_module("Foo::Bar"); ok(eval { Foo::Bar->baz }, 'Loaded module ok'); ok do { my $e; eval { Role::Tiny::_load_module("BrokenModule"); 1 } or $e = $@; $e }, 'broken module that installs subs gives error'; done_testing; Moo-2.005005/t/subconstructor.t000644 000000 000000 00000000325 13777150314 016335 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package SubCon1; use Moo; has foo => (is => 'ro'); package SubCon2; our @ISA = qw(SubCon1); } ok(SubCon2->new, 'constructor completes'); done_testing; Moo-2.005005/t/accessor-mixed.t000644 000000 000000 00000003203 14355631140 016134 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; my @result; { package Foo; use Moo; my @isa = (isa => sub { push @result, 'isa', $_[0] }); my @trigger = (trigger => sub { push @result, 'trigger', $_[1] }); sub _mkdefault { my $val = shift; (default => sub { push @result, 'default', $val; $val; }) } has a1 => ( is => 'rw', @isa ); has a2 => ( is => 'rw', @isa, @trigger ); has a3 => ( is => 'rw', @isa, @trigger ); has a4 => ( is => 'rw', @trigger, _mkdefault('a4') ); has a5 => ( is => 'rw', @trigger, _mkdefault('a5') ); has a6 => ( is => 'rw', @isa, @trigger, _mkdefault('a6') ); has a7 => ( is => 'rw', @isa, @trigger, _mkdefault('a7') ); } my $foo = Foo->new(a1 => 'a1', a2 => 'a2', a4 => 'a4', a6 => 'a6'); is_deeply( \@result, [ qw(isa a1 isa a2 trigger a2 trigger a4 default a5 isa a6 trigger a6 default a7 isa a7) ], 'Stuff fired in expected order' ); { package Guff; use Moo; sub foo { 1 } for my $type (qw(accessor reader writer predicate clearer asserter)) { my $an = $type =~ /^a/ ? 'an' : 'a'; ::like ::exception { has "attr_w_$type" => ( is => 'ro', $type => 'foo' ); }, qr/^You cannot overwrite a locally defined method \(foo\) with $an $type/, "overwriting a sub with $an $type fails"; } } { package NWFG; use Moo; ::is ::exception { has qq{odd"na;me\n} => ( is => 'bare', map +($_ => 'attr_'.$_), qw(accessor reader writer predicate clearer asserter) ); }, undef, 'all accessor methods work with oddly named attribute'; } done_testing; Moo-2.005005/t/moo-c3.t000644 000000 000000 00000001371 13777150314 014335 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package MyClassRoot; use Moo; has root => (is => 'ro'); } { package MyClassLeft; use Moo; extends 'MyClassRoot'; has left => (is => 'ro'); } { package MyClassRight; use Moo; extends 'MyClassRoot'; has right => (is => 'ro'); } { package MyClassChild; use Moo; extends 'MyClassLeft', 'MyClassRight'; has child => (is => 'ro'); } my $o = MyClassChild->new(root => 1, left => 2, right => 3, child => 4); is $o->root, 1, 'constructor populates root class attribute'; is $o->left, 2, 'constructor populates left parent attribute'; is $o->right, undef, 'constructor doesn\'t populate right parent attribute'; is $o->child, 4, 'constructor populates child class attribute'; done_testing; Moo-2.005005/t/accessor-trigger.t000644 000000 000000 00000004450 14355631140 016476 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; our @tr; sub run_for { my $class = shift; @tr = (); my $obj = $class->new; ok(!@tr, "${class}: trigger not fired with no value"); $obj = $class->new(one => 1); is_deeply(\@tr, [ 1 ], "${class}: trigger fired on new"); my $res = $obj->one(2); is_deeply(\@tr, [ 1, 2 ], "${class}: trigger fired on set"); is($res, 2, "${class}: return from set ok"); is($obj->one, 2, "${class}: return from accessor ok"); is_deeply(\@tr, [ 1, 2 ], "${class}: trigger not fired for accessor as get"); } { package Foo; use Moo; has one => (is => 'rw', trigger => sub { push @::tr, $_[1] }); } run_for 'Foo'; { package Bar; use Sub::Quote; use Moo; has one => (is => 'rw', trigger => quote_sub q{ push @::tr, $_[1] }); } run_for 'Bar'; { package Baz; use Sub::Quote; use Moo; has one => ( is => 'rw', trigger => quote_sub(q{ push @{$tr}, $_[1] }, { '$tr' => \\@::tr }) ); } run_for 'Baz'; { package Default; use Sub::Quote; use Moo; has one => ( is => 'rw', trigger => quote_sub(q{ push @{$tr}, $_[1] }, { '$tr' => \\@::tr }), default => sub { 0 } ); } run_for 'Default'; { package LazyDefault; use Sub::Quote; use Moo; has one => ( is => 'rw', trigger => quote_sub(q{ push @{$tr}, $_[1] }, { '$tr' => \\@::tr }), default => sub { 0 }, lazy => 1 ); } run_for 'LazyDefault'; { package Shaz; use Moo; has one => (is => 'rw', trigger => 1 ); sub _trigger_one { push @::tr, $_[1] } } run_for 'Shaz'; { package AccessorValue; use Moo; has one => ( is => 'rw', isa => sub { 1 }, trigger => sub { push @::tr, $_[0]->one }, ); } run_for 'AccessorValue'; { package TriggerWriter; use Moo; has attr => ( is => 'rwp', trigger => sub { die 'triggered' }, ); } like exception { TriggerWriter->new->_set_attr( 4 ) }, qr/triggered/, "trigger triggered via writer"; is exception { package TriggerNoInit; use Moo; has attr => ( is => 'rw', default => 1, init_arg => undef, trigger => sub { die 'triggered' }, ); }, undef, 'trigger+default+init_arg undef works'; is exception { TriggerNoInit->new }, undef, 'trigger not called on default without init_arg'; done_testing; Moo-2.005005/t/accessor-generator-extension.t000644 000000 000000 00000006415 14355631140 021036 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use Moo::_Utils qw(_linear_isa); BEGIN { package Method::Generate::Accessor::Role::ArrayRefInstance; use Moo::Role; sub _generate_simple_get { my ($self, $me, $name, $spec) = @_; "${me}->[${\$spec->{index}}]"; } sub _generate_core_set { my ($self, $me, $name, $spec, $value) = @_; "${me}->[${\$spec->{index}}] = $value"; } sub _generate_simple_has { my ($self, $me, $name, $spec) = @_; "defined ${me}->[${\$spec->{index}}]"; } sub _generate_simple_clear { my ($self, $me, $name, $spec) = @_; "undef(${me}->[${\$spec->{index}}])"; } sub generate_multi_set { my ($self, $me, $to_set, $from, $specs) = @_; "\@{${me}}[${\join ', ', map $specs->{$_}{index}, @$to_set}] = $from"; } sub _generate_xs { my ($self, $type, $into, $name, $slot, $spec) = @_; require Class::XSAccessor::Array; Class::XSAccessor::Array->import( class => $into, $type => { $name => $spec->{index} } ); $into->can($name); } sub default_construction_string { '[]' } sub MooX::ArrayRef::import { Moo::Role->apply_roles_to_object( Moo->_accessor_maker_for(scalar caller), 'Method::Generate::Accessor::Role::ArrayRefInstance' ); } $INC{"MooX/ArrayRef.pm"} = 1; } { package ArrayTest1; use Moo; use MooX::ArrayRef; has one => (is => 'ro'); has two => (is => 'ro'); has three => (is => 'ro'); } my $o = ArrayTest1->new(one => 1, two => 2, three => 3); is_deeply([ @$o ], [ 1, 2, 3 ], 'Basic object ok'); { package ArrayTest2; use Moo; extends 'ArrayTest1'; has four => (is => 'ro'); } $o = ArrayTest2->new(one => 1, two => 2, three => 3, four => 4); is_deeply([ @$o ], [ 1, 2, 3, 4 ], 'Subclass object ok'); { package ArrayTestRole; use Moo::Role; has four => (is => 'ro'); package ArrayTest3; use Moo; extends 'ArrayTest1'; with 'ArrayTestRole'; } $o = ArrayTest3->new(one => 1, two => 2, three => 3, four => 4); is_deeply([ @$o ], [ 1, 2, 3, 4 ], 'Subclass object w/role'); my $c = Moo::Role->create_class_with_roles('ArrayTest1', 'ArrayTestRole'); $o = $c->new(one => 1, two => 2, three => 3, four => 4); is_deeply([ @$o ], [ 1, 2, 3, 4 ], 'Generated subclass object w/role'); is exception { Moo::Role->create_class_with_roles('ArrayTest1', 'ArrayTestRole'); }, undef, 'creating class with role again'; { package ArrayNonMoo; sub new { bless [], $_[0] } } { package ArrayTest4; use Moo; use MooX::ArrayRef; extends 'ArrayNonMoo'; has one => (is => 'ro'); has two => (is => 'ro'); has three => (is => 'ro'); has four => (is => 'ro'); } $o = ArrayTest4->new(one => 1, two => 2, three => 3, four => 4); is_deeply([ @$o ], [ 1, 2, 3, 4 ], 'Subclass of non-Moo object'); { package ArrayTestRole2; use Moo::Role; has four => (is => 'ro'); } { my ($new_c) = Moo::Role->_composite_name('ArrayTest1', 'ArrayTestRole2'); { no strict 'refs'; # cause ISA to exist somehow @{"${new_c}::ISA"} = (); } my $c = Moo::Role->create_class_with_roles('ArrayTest1', 'ArrayTestRole2'); is_deeply +_linear_isa($c), [$c, 'ArrayTest1', 'Moo::Object'], 'mro::get_linear_isa is correct if create_class_with_roles target class @ISA existed'; } done_testing; Moo-2.005005/t/moo-utils-_subname-Sub-Name.t000644 000000 000000 00000000717 14355630430 020362 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use InlineModule 'Sub::Name' => <<'END_SN', package Sub::Name; use strict; use warnings; sub subname { $::sub_name_run++; return $_[1]; } 1; END_SN 'Sub::Util' => undef, ; use Test::More; use Moo::_Utils (); $::sub_name_run = 0; my $sub = Moo::_Utils::_subname 'Some::Sub', sub { 5 }; is $sub->(), 5, '_subname runs with Sub::Name'; is $::sub_name_run, 1, '_subname uses Sub::Name::subname'; done_testing; Moo-2.005005/t/moo-utils-_subname.t000644 000000 000000 00000000441 14355630412 016747 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use InlineModule 'Sub::Name' => undef, 'Sub::Util' => undef, ; use Test::More; use Moo::_Utils (); my $sub = Moo::_Utils::_subname 'Some::Sub', sub { 5 }; is $sub->(), 5, '_subname runs even without Sub::Name or Sub::Util'; done_testing; Moo-2.005005/t/croak-locations.t000644 000000 000000 00000013513 14355630437 016333 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use Carp qw(croak); no Moo::sification; use ErrorLocation; location_ok <<'END_CODE', 'Moo::_Util::_load_module'; use Moo::_Utils qw(_load_module); _load_module("This::Module::Does::Not::Exist::". int rand 50000); END_CODE location_ok <<'END_CODE', 'Moo - import into role'; use Moo::Role; use Moo (); Moo->import; END_CODE location_ok <<'END_CODE', 'Moo::has - unbalanced options'; use Moo; has arf => (is => 'ro', 'garf'); END_CODE location_ok <<'END_CODE', 'Moo::extends - extending a role'; BEGIN { eval qq{ package ${PACKAGE}::Role; use Moo::Role; 1; } or die $@; } use Moo; extends "${PACKAGE}::Role"; END_CODE location_ok <<'END_CODE', 'Method::Generate::Accessor - missing is'; use Moo; has 'attr'; END_CODE location_ok <<'END_CODE', 'Method::Generate::Accessor - reader extra params'; use Moo; has 'attr' => (is => 'rwp', lazy => 1, default => 1); my $o = $PACKAGE->new; package Elsewhere; $o->attr(5); END_CODE location_ok <<'END_CODE', 'Method::Generate::Accessor - overwrite method'; use Moo; sub attr { 1 } has 'attr' => (is => 'ro'); END_CODE location_ok <<'END_CODE', 'Method::Generate::Accessor - asserter with unset'; use Moo; has 'attr' => (is => 'ro', asserter => 'assert_attr'); my $o = $PACKAGE->new; package Elsewhere; $o->assert_attr; END_CODE location_ok <<'END_CODE', 'Method::Generate::Accessor - invalid default'; use Moo; sub attr { 1 } has 'attr' => (is => 'ro', default => []); END_CODE location_ok <<'END_CODE', 'Method::Generate::Constructor - +attr without attr'; use Moo; has 'attr' => (is => 'ro'); has 'attr' => (default => 1); END_CODE location_ok <<'END_CODE', 'Method::Generate::Constructor - modifying @ISA unexpectedly'; BEGIN { eval qq{ package ${PACKAGE}::Parent$_; use Moo; has attr$_ => (is => 'ro'); __PACKAGE__->new; 1; } or die $@ for (1, 2); } use Moo; extends "${PACKAGE}::Parent1"; has attr3 => (is => 'ro'); our @ISA = "${PACKAGE}::Parent2"; package Elsewhere; $PACKAGE->new; END_CODE location_ok <<'END_CODE', 'Method::Generate::Constructor - existing constructor'; use Moo; sub new { } has attr => (is => 'ro'); END_CODE location_ok <<'END_CODE', 'Method::Generate::Constructor - BUILDARGS output'; use Moo; sub BUILDARGS { 1 } has attr => (is => 'ro'); package Elsewhere; $PACKAGE->new; END_CODE location_ok <<'END_CODE', 'Method::Generate::Constructor - inlined BUILDARGS output'; use Moo; has attr => (is => 'ro'); package Elsewhere; $PACKAGE->new(5); END_CODE location_ok <<'END_CODE', 'Method::Generate::Constructor - inlined BUILDARGS output (wrapped)'; use Moo; has attr => (is => 'ro'); sub wrap_new { my $class = shift; $class->new(@_); } package Elsewhere; $PACKAGE->wrap_new(5); END_CODE location_ok <<'END_CODE', 'Method::Generate::Constructor - required attributes'; use Moo; has attr => (is => 'ro', required => 1); package Elsewhere; $PACKAGE->new; END_CODE location_ok <<'END_CODE', 'Moo::HandleMoose::FakeMetaClass - class method call'; require Moo::HandleMoose::FakeMetaClass; Moo::HandleMoose::FakeMetaClass->guff; END_CODE location_ok <<'END_CODE', 'Moo::Object - new args'; use Moo::Object; our @ISA = 'Moo::Object'; package Elsewhere; $PACKAGE->new(5); END_CODE location_ok <<'END_CODE', 'Moo::Role - import into class'; use Moo; use Moo::Role (); Moo::Role->import; END_CODE location_ok <<'END_CODE', 'Moo::Role::has - unbalanced options'; use Moo::Role; has arf => (is => 'ro', 'garf'); END_CODE location_ok <<'END_CODE', 'Moo::Role::methods_provided_by - not a role'; BEGIN { eval qq{ package ${PACKAGE}::Class; use Moo; 1; } or die $@; } use Moo; has arf => (is => 'ro', handles => "${PACKAGE}::Class"); END_CODE location_ok <<'END_CODE', 'Moo::Role::apply_roles_to_package - not a module'; use Moo; with {}; END_CODE location_ok <<'END_CODE', 'Moo::Role::apply_roles_to_package - not a role'; BEGIN { eval qq{ package ${PACKAGE}::Class; use Moo; 1; } or die $@; } use Moo; with "${PACKAGE}::Class"; END_CODE location_ok <<'END_CODE', 'Moo::Role::apply_single_role_to_package - not a role'; BEGIN { eval qq{ package ${PACKAGE}::Class; use Moo; 1; } or die $@; } use Moo; use Moo::Role (); Moo::Role->apply_single_role_to_package($PACKAGE, "${PACKAGE}::Class"); END_CODE location_ok <<'END_CODE', 'Moo::Role::create_class_with_roles - not a role'; BEGIN { eval qq{ package ${PACKAGE}::Class; use Moo; 1; } or die $@; } use Moo; use Moo::Role (); Moo::Role->create_class_with_roles($PACKAGE, "${PACKAGE}::Class"); END_CODE location_ok <<'END_CODE', 'Moo::HandleMoose::inject_all - Moo::sification disabled'; use Moo::HandleMoose (); Moo::HandleMoose->import; END_CODE location_ok <<'END_CODE', 'Method::Generate::Accessor::_generate_delegation - user croak'; BEGIN { eval qq{ package ${PACKAGE}::Class; use Moo; use Carp qw(croak); sub method { croak "AAA"; } 1; } or die $@; } use Moo; has b => ( is => 'ro', handles => [ 'method' ], default => sub { "${PACKAGE}::Class"->new }, ); package Elsewhere; my $o = $PACKAGE->new; $o->method; END_CODE location_ok <<'END_CODE', 'Moo::Role::create_class_with_roles - default fails isa'; BEGIN { eval qq{ package ${PACKAGE}::Role; use Moo::Role; use Carp qw(croak); has attr => ( is => 'ro', default => sub { 0 }, isa => sub { croak "must be true" unless \$_[0]; }, ); 1; } or die $@; } use Moo; my $o = $PACKAGE->new; package Elsewhere; use Moo::Role (); Moo::Role->apply_roles_to_object($o, "${PACKAGE}::Role"); END_CODE location_ok <<'END_CODE', 'Method::Generate::DemolishAll - user croak'; use Carp qw(croak); use Moo; sub DEMOLISH { croak "demolish" unless $_[0]->{demolished}++; } my $o = $PACKAGE->new; package Elsewhere; # object destruction normally can't throw, so run this manually $o->DESTROY; END_CODE done_testing; Moo-2.005005/t/no-build.t000644 000000 000000 00000002646 13777354515 014770 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; use Moo::_Utils (); BEGIN { package Class::Diminutive; sub new { my $class = shift; my $args = $class->BUILDARGS(@_); my $no_build = delete $args->{__no_BUILD__}; my $self = bless { %$args }, $class; $self->BUILDALL unless $no_build; return $self; } sub BUILDARGS { my $class = shift; my %args = @_ % 2 ? %{$_[0]} : @_; return \%args; } sub BUILDALL { my $self = shift; my $class = ref $self; my @builds = grep { defined } map {; no strict 'refs'; *{$_.'::BUILD'}{CODE} } @{Moo::_Utils::_linear_isa($class)}; for my $build (@builds) { $self->$build; } } } BEGIN { package TestClass1; our @ISA = ('Class::Diminutive'); sub BUILD { $_[0]->{build_called}++; } sub BUILDARGS { my $class = shift; my $args = $class->SUPER::BUILDARGS(@_); $args->{no_build_used} = $args->{__no_BUILD__}; return $args; } } my $o = TestClass1->new; is $o->{build_called}, 1, 'mini class builder working'; BEGIN { package TestClass2; use Moo; extends 'TestClass1'; } my $o2 = TestClass2->new; is $o2->{build_called}, 1, 'BUILD still called when extending mini class builder'; is $o2->{no_build_used}, 1, '__no_BUILD__ was passed to mini builder'; my $o3 = TestClass2->new({__no_BUILD__ => 1}); is $o3->{build_called}, undef, '__no_BUILD__ inhibits Moo calling BUILD'; done_testing; Moo-2.005005/t/compose-conflicts.t000644 000000 000000 00000007315 14355631140 016665 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; BEGIN { package MethodRole; use Moo::Role; sub method { __PACKAGE__ } } BEGIN { package MethodRole2; use Moo::Role; sub method { __PACKAGE__ } } BEGIN { package MethodClassOver; use Moo; sub method { __PACKAGE__ } with 'MethodRole'; } BEGIN { is +MethodClassOver->new->method, 'MethodClassOver', 'class methods override role methods'; } BEGIN { package MethodRole2; use Moo::Role; has attr => (is => 'rw', coerce => sub { __PACKAGE__ } ); } BEGIN { package MethodClassAndRoleAndRole; use Moo; with 'MethodRole'; with 'MethodRole2'; } BEGIN { my $o = is +MethodClassAndRoleAndRole->new->method, 'MethodRole', 'composed methods override later composed methods'; } BEGIN { package MethodClassAndRoles; use Moo; ::like ::exception { with 'MethodRole', 'MethodRole2'; }, qr/^Due to a method name conflict between roles/, 'composing roles with conflicting methods fails'; } BEGIN { package MethodRoleOver; use Moo::Role; sub method { __PACKAGE__ } with 'MethodRole'; } BEGIN { package MethodClassAndRoleOver; use Moo; with 'MethodRoleOver'; } BEGIN { is +MethodClassAndRoleOver->new->method, 'MethodRoleOver', 'composing role methods override composed role methods'; } BEGIN { package MethodClassOverAndRoleOver; use Moo; sub method { __PACKAGE__ } with 'MethodRoleOver'; } BEGIN { is +MethodClassOverAndRoleOver->new->method, 'MethodClassOverAndRoleOver', 'class methods override role and role composed methods'; } BEGIN { package AttrRole; use Moo::Role; has attr => (is => 'rw', coerce => sub { __PACKAGE__ } ); } BEGIN { package AttrClassOver; use Moo; has attr => (is => 'rw', coerce => sub { __PACKAGE__ }); with 'AttrRole'; } BEGIN { my $o = AttrClassOver->new(attr => 1); is $o->attr, 'AttrClassOver', 'class attributes override role attributes in constructor'; $o->attr(1); is $o->attr, 'AttrClassOver', 'class attributes override role attributes in accessors'; } BEGIN { package AttrRole2; use Moo::Role; has attr => (is => 'rw', coerce => sub { __PACKAGE__ } ); } BEGIN { package AttrClassAndRoleAndRole; use Moo; with 'AttrRole'; with 'AttrRole2'; } BEGIN { my $o = AttrClassAndRoleAndRole->new(attr => 1); is $o->attr, 'AttrRole', 'composed attributes override later composed attributes in constructor'; $o->attr(1); is $o->attr, 'AttrRole', 'composed attributes override later composed attributes in accessors'; } BEGIN { package AttrClassAndRoles; use Moo; ::like ::exception { with 'AttrRole', 'AttrRole2'; }, qr/^Due to a method name conflict between roles/, 'composing roles with conflicting attributes fails'; } BEGIN { package AttrRoleOver; use Moo::Role; has attr => (is => 'rw', coerce => sub { __PACKAGE__ }); with 'AttrRole'; } BEGIN { package AttrClassAndRoleOver; use Moo; with 'AttrRoleOver'; } BEGIN { my $o = AttrClassAndRoleOver->new(attr => 1); is $o->attr, 'AttrRoleOver', 'composing role attributes override composed role attributes in constructor'; $o->attr(1); is $o->attr, 'AttrRoleOver', 'composing role attributes override composed role attributes in accessors'; } BEGIN { package AttrClassOverAndRoleOver; use Moo; has attr => (is => 'rw', coerce => sub { __PACKAGE__ }); with 'AttrRoleOver'; } BEGIN { my $o = AttrClassOverAndRoleOver->new(attr => 1); is $o->attr, 'AttrClassOverAndRoleOver', 'class attributes override role and role composed attributes in constructor'; $o->attr(1); is $o->attr, 'AttrClassOverAndRoleOver', 'class attributes override role and role composed attributes in accessors'; } done_testing; Moo-2.005005/t/accessor-reader-writer.t000644 000000 000000 00000002731 14355631140 017607 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; my @result; { package Foo; use Moo; has one => ( is => 'rw', reader => 'get_one', writer => 'set_one', ); sub one {'sub'} has two => ( is => 'lazy', default => sub { 2 }, reader => 'get_two', ); has three => ( is => 'rwp', reader => 'get_three', writer => 'set_three', ); } { package Bar; use Moo; has two => ( is => 'rw', accessor => 'TWO', ); } my $foo = Foo->new(one => 'lol'); my $bar = Bar->new(two => '...'); is( $foo->get_one, 'lol', 'reader works' ); $foo->set_one('rofl'); is( $foo->get_one, 'rofl', 'writer works' ); is( $foo->one, 'sub', 'reader+writer = no accessor' ); is( $foo->get_two, 2, 'lazy doesn\'t override reader' ); is( $foo->can('two'), undef, 'reader+ro = no accessor' ); ok( $foo->can('get_three'), 'rwp doesn\'t override reader'); ok( $foo->can('set_three'), 'rwp doesn\'t override writer'); ok( exception { $foo->get_one('blah') }, 'reader dies on write' ); is( $bar->TWO, '...', 'accessor works for reading' ); $bar->TWO('!!!'); is( $bar->TWO, '!!!', 'accessor works for writing' ); { package Baz; use Moo; ::is(::exception { has '@three' => ( is => 'lazy', default => sub { 3 }, reader => 'three', ); }, undef, 'declaring non-identifier attribute with proper reader works'); } is( Baz->new->three, 3, '... and reader works'); done_testing; Moo-2.005005/t/has-array.t000644 000000 000000 00000002156 14355631140 015123 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; is(exception { package Local::Test::Role1; use Moo::Role; has [qw/ attr1 attr2 /] => (is => 'ro'); }, undef, 'has \@attrs works in roles'); is(exception { package Local::Test::Class1; use Moo; with 'Local::Test::Role1'; has [qw/ attr3 attr4 /] => (is => 'ro'); }, undef, 'has \@attrs works in classes'); my $obj = new_ok 'Local::Test::Class1' => [ attr1 => 1, attr2 => 2, attr3 => 3, attr4 => 4, ]; can_ok( $obj, qw( attr1 attr2 attr3 attr4 ), ); like(exception { package Local::Test::Role2; use Moo::Role; has [qw/ attr1 attr2 /] => (is => 'ro', 'isa'); }, qr/^Invalid options for 'attr1', 'attr2' attribute\(s\): even number of arguments expected, got 3/, 'correct exception when has given bad parameters in role'); like(exception { package Local::Test::Class2; use Moo; has [qw/ attr3 attr4 /] => (is => 'ro', 'isa'); }, qr/^Invalid options for 'attr3', 'attr4' attribute\(s\): even number of arguments expected, got 3/, 'correct exception when has given bad parameters in class'); done_testing; Moo-2.005005/t/modify_lazy_handlers.t000644 000000 000000 00000001625 13777150314 017450 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; BEGIN { package ClassicObject; sub new { my ($class, %args) = @_; bless \%args, 'ClassicObject'; } sub connect { 'a' } } BEGIN { package MooObjectWithDelegate; use Scalar::Util (); use Moo; has 'delegated' => ( is => 'ro', isa => sub { do { $_[0] && Scalar::Util::blessed($_[0]) } or die "Not an Object!"; }, lazy => 1, builder => '_build_delegated', handles => [qw/connect/], ); sub _build_delegated { my $self = shift; return ClassicObject->new; } around 'connect', sub { my ($orig, $self, @args) = @_; return $self->$orig(@args) . 'b'; }; around 'connect', sub { my ($orig, $self, @args) = @_; return $self->$orig(@args) . 'c'; }; } ok my $moo_object = MooObjectWithDelegate->new, 'got object'; is $moo_object->connect, 'abc', 'got abc'; done_testing; Moo-2.005005/t/buildargs-error.t000644 000000 000000 00000000626 14355631140 016337 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package Foo; use Moo; has bar => ( is => "rw" ); has baz => ( is => "rw" ); sub BUILDARGS { my ($self, $args) = @_; return %$args } } like( exception { Foo->new({ bar => 1, baz => 1 }) }, qr/BUILDARGS did not return a hashref/, 'Sensible error message' ); done_testing; Moo-2.005005/t/demolish-bugs-eats_mini.t000644 000000 000000 00000002446 14355631140 017746 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package Foo; use Moo; has 'bar' => ( is => 'ro', required => 1, ); # Defining this causes the FIRST call to Baz->new w/o param to fail, # if no call to ANY Moo::Object->new was done before. sub DEMOLISH { my ( $self ) = @_; # ... Moo (kinda) eats exceptions in DESTROY/DEMOLISH"; } } { my $obj = eval { Foo->new; }; like( $@, qr/Missing required arguments/, "... Foo plain" ); is( $obj, undef, "... the object is undef" ); } { package Bar; sub new { die "Bar died"; } sub DESTROY { die "Vanilla Perl eats exceptions in DESTROY too"; } } { my $obj = eval { Bar->new; }; like( $@, qr/Bar died/, "... Bar plain" ); is( $obj, undef, "... the object is undef" ); } { package Baz; use Moo; sub DEMOLISH { $? = 0; } } { local $@ = 42; local $? = 84; { Baz->new; } is( $@, 42, '$@ is still 42 after object is demolished without dying' ); is( $?, 84, '$? is still 84 after object is demolished without dying' ); local $@ = 0; { Baz->new; } is( $@, 0, '$@ is still 0 after object is demolished without dying' ); } done_testing; Moo-2.005005/t/extends-non-moo.t000644 000000 000000 00000003226 14355631140 016265 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package NonMooClass; BEGIN { $INC{'NonMooClass.pm'} = __FILE__ } sub new { my ($proto, $args) = @_; bless $args, $proto; } sub to_app { (shift)->{app}; } package NonMooClass::Child; BEGIN { $INC{'NonMooClass/Child.pm'} = __FILE__ } use base qw(NonMooClass); sub wrap { my($class, $app) = @_; $class->new({app => $app}) ->to_app; } package NonMooClass::Child::MooExtend; use Moo; extends 'NonMooClass::Child'; package NonMooClass::Child::MooExtendWithAttr; use Moo; extends 'NonMooClass::Child'; has 'attr' => (is=>'ro'); package NonMooClass::Child::MooExtendWithAttr::Extend; use Moo; extends 'NonMooClass::Child::MooExtendWithAttr'; has 'attr2' => (is=>'ro'); } ok my $app = 100, 'prepared $app'; ok $app = NonMooClass::Child->wrap($app), '$app from $app'; is $app, 100, '$app still 100'; ok $app = NonMooClass::Child::MooExtend->wrap($app), '$app from $app'; is $app, 100, '$app still 100'; ok $app = NonMooClass::Child::MooExtendWithAttr->wrap($app), '$app from $app'; is $app, 100, '$app still 100'; ok $app = NonMooClass::Child::MooExtendWithAttr::Extend->wrap($app), '$app from $app'; is $app, 100, '$app still 100'; { package BadPrototype; BEGIN { $INC{'BadPrototype.pm'} = __FILE__ } sub new () { bless {}, shift } } { package ExtendBadPrototype; use Moo; ::is(::exception { extends 'BadPrototype'; has attr1 => (is => 'ro'); }, undef, 'extending class with prototype on new'); } done_testing; Moo-2.005005/t/overridden-core-funcs.t000644 000000 000000 00000003656 14355631140 017445 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; BEGIN { package AddOverrides; $INC{"AddOverrides.pm"} = __FILE__; use Carp (); sub import { my $package = caller; for my $sub ( 'defined', 'join', 'ref', 'die', 'shift', 'sort', 'undef', ) { my $proto = prototype "CORE::$sub"; no strict 'refs'; *{"${package}::$sub"} = \&{"${package}::$sub"}; eval "sub ${package}::$sub ".($proto ? "($proto)" : '') . ' { Carp::confess("local '.$sub.'") }; 1' or die $@; } } } { package Foo; use Moo; sub welp { 1 } } { package WithOverridden; use AddOverrides; use Moo; sub BUILD { 1 } sub DEMOLISH { CORE::die "demolish\n" if $::FATAL_DEMOLISH } around BUILDARGS => sub { my $orig = CORE::shift(); my $self = CORE::shift(); $self->$orig(@_); }; has attr1 => (is => 'ro', required => 1, handles => ['welp']); has attr2 => (is => 'ro', default => CORE::undef()); has attr3 => (is => 'rw', isa => sub { CORE::die "nope" } ); } unlike exception { WithOverridden->new(1) }, qr/local/, 'bad constructor arguments error ignores local functions'; unlike exception { WithOverridden->new }, qr/local/, 'missing attributes error ignores local functions'; unlike exception { WithOverridden->new(attr1 => 1, attr3 => 1) }, qr/local/, 'constructor isa checks ignores local functions'; my $o; is exception { $o = WithOverridden->new(attr1 => Foo->new) }, undef, 'constructor without error ignores local functions'; unlike exception { $o->attr3(1) }, qr/local/, 'isa checks ignores local functions'; is exception { $o->welp }, undef, 'delegates ignores local functions'; { no warnings FATAL => 'all'; use warnings 'all'; my $w = ''; local $SIG{__WARN__} = sub { $w .= $_[0] }; local $::FATAL_DEMOLISH = 1; undef $o; unlike $w, qr/local/, 'destroy ignores local functions'; } done_testing; Moo-2.005005/t/constructor-modify.t000644 000000 000000 00000005166 14355631140 017112 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; BEGIN { package ClassBakedNew; use Moo; has attr1 => (is => 'ro'); __PACKAGE__->new; ::like ::exception { has attr2 => (is => 'ro'); }, qr/Constructor for ClassBakedNew has been inlined/, 'error when adding attributes with undeferred constructor'; } BEGIN { package ClassExistingNew; use Moo; no warnings 'once'; sub new { our $CALLED++; bless {}, $_[0]; } ::like ::exception { has attr1 => (is => 'ro'); }, qr/Unknown constructor for ClassExistingNew already exists/, 'error when adding attributes with foreign constructor'; } BEGIN { package ClassDeferredNew; use Moo; no warnings 'once'; use Sub::Quote; quote_sub __PACKAGE__ . '::new' => q{ our $CALLED++; bless {}, $_[0]; }; ::like ::exception { has attr1 => (is => 'ro'); }, qr/Unknown constructor for ClassDeferredNew already exists/, 'error when adding attributes with foreign deferred constructor'; } BEGIN { package ClassWithModifier; use Moo; no warnings 'once'; has attr1 => (is => 'ro'); around new => sub { our $CALLED++; my $orig = shift; goto $orig; }; ::like ::exception { has attr2 => (is => 'ro'); }, qr/Constructor for ClassWithModifier has been replaced with an unknown sub/, 'error when adding attributes after applying modifier to constructor'; } BEGIN { package Role1; use Moo::Role; has attr1 => (is => 'ro'); } BEGIN { package ClassWithRoleAttr; use Moo; no warnings 'once'; around new => sub { our $CALLED++; my $orig = shift; goto $orig; }; ::like ::exception { with 'Role1'; }, qr/Unknown constructor for ClassWithRoleAttr already exists/, 'error when adding role with attribute after applying modifier to constructor'; } BEGIN { package RoleModifyNew; use Moo::Role; no warnings 'once'; around new => sub { our $CALLED++; my $orig = shift; goto $orig; }; } BEGIN { package ClassWithModifyRole; use Moo; no warnings 'once'; with 'RoleModifyNew'; ::like ::exception { has attr1 => (is => 'ro'); }, qr/Unknown constructor for ClassWithModifyRole already exists/, 'error when adding attributes after applying modifier to constructor via role'; } BEGIN { package AClass; use Moo; has attr1 => (is => 'ro'); } BEGIN { package ClassWithParent; use Moo; has attr2 => (is => 'ro'); __PACKAGE__->new; ::like ::exception { extends 'AClass'; }, qr/Constructor for ClassWithParent has been inlined/, 'error when changing parent with undeferred constructor'; } done_testing; Moo-2.005005/t/moo-accessors.t000644 000000 000000 00000001725 13777150314 016020 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; use Sub::Quote qw(quote_sub); { package Foo; use Moo; has one => (is => 'ro'); has two => (is => 'rw', init_arg => undef); has three => (is => 'ro', init_arg => 'THREE', required => 1); package Bar; use Moo::Role; has four => (is => 'ro'); ::quote_sub 'Bar::quoted' => '1'; package Baz; use Moo; extends 'Foo'; with 'Bar'; has five => (is => 'rw'); } my $foo = Foo->new( one => 1, THREE => 3 ); is_deeply( { %$foo }, { one => 1, three => 3 }, 'simple class ok' ); my $baz = Baz->new( one => 1, THREE => 3, four => 4, five => 5, ); is_deeply( { %$baz }, { one => 1, three => 3, four => 4, five => 5 }, 'subclass with role ok' ); ok(eval { Foo->meta->make_immutable }, 'make_immutable returns true'); ok(!$INC{"Moose.pm"}, "Didn't load Moose"); $baz->quoted; is +$baz->can('quoted'), Bar->can('quoted'), 'accessor from role is undeferred in consuming class'; done_testing; Moo-2.005005/t/has-plus.t000644 000000 000000 00000003630 14355631140 014766 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package RollyRole; use Moo::Role; has f => (is => 'ro', default => sub { 0 }); } { package ClassyClass; use Moo; has f => (is => 'ro', default => sub { 1 }); } { package UsesTheRole; use Moo; with 'RollyRole'; } { package UsesTheRole2; use Moo; with 'RollyRole'; has '+f' => (default => sub { 2 }); } { package ExtendsTheClass; use Moo; extends 'ClassyClass'; has '+f' => (default => sub { 3 }); } { package BlowsUp; use Moo; ::like(::exception { has '+f' => () }, qr/\Qhas '+f'/, 'Kaboom'); } { package ClassyClass2; use Moo; has d => (is => 'ro', default => sub { 4 }); } { package MultiClass; use Moo; extends 'ClassyClass', 'ClassyClass2'; ::is(::exception { has '+f' => (); }, undef, 'extend attribute from first parent'); ::like(::exception { has '+d' => (); }, qr/no d attribute already exists/, 'can\'t extend attribute from second parent'); } is(UsesTheRole->new->f, 0, 'role attr'); is(ClassyClass->new->f, 1, 'class attr'); is(UsesTheRole2->new->f, 2, 'role attr with +'); is(ExtendsTheClass->new->f, 3, 'class attr with +'); { package HasBuilderSub; use Moo; has f => (is => 'ro', builder => sub { __PACKAGE__ }); } { package ExtendsBuilderSub; use Moo; extends 'HasBuilderSub'; has '+f' => (init_arg => undef); sub _build_f { __PACKAGE__ } } is +ExtendsBuilderSub->new->_build_f, 'ExtendsBuilderSub', 'build sub not replaced by +attr'; is +ExtendsBuilderSub->new->f, 'ExtendsBuilderSub', 'correct build sub used after +attr'; { package HasDefault; use Moo; has guff => (is => 'ro', default => sub { 'guff' }); } { package ExtendsWithBuilder; use Moo; extends 'HasDefault'; has '+guff' => (builder => sub { 'welp' }); } is +ExtendsWithBuilder->new->guff, 'welp', 'builder can override default'; done_testing; Moo-2.005005/t/lib/000755 000000 000000 00000000000 14355634555 013626 5ustar00rootwheel000000 000000 Moo-2.005005/t/long-package-name.t000644 000000 000000 00000001643 14355631140 016502 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package Some::Class; use Moo; has attr1 => (is => 'ro'); } my $max_length = 252; my $long_name = "Long::Package::Name::"; $long_name .= substr("0123456789" x 26, 0, $max_length - length $long_name); is exception { eval qq{ package $long_name; use Moo; has attr2 => (is => 'ro'); 1; } or die "$@"; }, undef, 'can use Moo in a long package'; is exception { $long_name->new; }, undef, 'long package name instantiation works'; { package AMooClass; use Moo; has attr1 => (is => 'ro'); } for (1..7) { eval qq{ package LongRole${_}::ABCDEFGHIGKLMNOPQRSTUVWXYZ; use Moo::Role; 1; } or die $@; } is exception { Moo::Role->create_class_with_roles('AMooClass', map "LongRole${_}::ABCDEFGHIGKLMNOPQRSTUVWXYZ", 1..7)->new->attr1; }, undef, 'generated long class names work'; done_testing; Moo-2.005005/t/not-both.t000644 000000 000000 00000001455 14355631140 014767 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use Moo (); use Moo::Role (); { like exception { package ZZZ; Role::Tiny->import; Moo->import; }, qr{Cannot import Moo into a role}, "can't import Moo into a Role::Tiny role"; } { like exception { package XXX; Moo->import; Moo::Role->import; }, qr{Cannot import Moo::Role into a Moo class}, "can't import Moo::Role into a Moo class"; } { like exception { package YYY; Moo::Role->import; Moo->import; }, qr{Cannot import Moo into a role}, "can't import Moo into a Moo role"; } { is exception { package FFF; $Moo::MAKERS{+__PACKAGE__} = {}; Moo::Role->import; }, undef, "Moo::Role can be imported into a package with fake MAKERS"; } done_testing; Moo-2.005005/t/accessor-weaken.t000644 000000 000000 00000004137 13777150314 016315 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; use Scalar::Util (); note "pretending to be pre-5.8.3" if $ENV{MOO_TEST_PRE_583}; { package Foo; use Moo; has one => (is => 'rw', weak_ref => 1); has four=> (is => 'rw', weak_ref => 1, writer => 'set_four'); package Foo2; use Moo; our $preexist = {}; has one => (is => 'rw', lazy => 1, weak_ref => 1, default => sub { $preexist }); has two => (is => 'rw', lazy => 1, weak_ref => 1, default => sub { {} }); } my $ref = {}; my $foo = Foo->new(one => $ref); is($foo->one, $ref, 'value present'); ok(Scalar::Util::isweak($foo->{one}), 'value weakened'); is($foo->one($ref), $ref, 'value returned from setter'); undef $ref; ok(!defined $foo->{one}, 'weak value gone'); my $foo2 = Foo2->new; ok(my $ref2 = $foo2->one, 'external value returned'); is($foo2->one, $ref2, 'value maintained'); ok(Scalar::Util::isweak($foo2->{one}), 'value weakened'); is($foo2->one($ref2), $ref2, 'value returned from setter'); undef $ref2; ok(!defined $foo->{one}, 'weak value gone'); is($foo2->two, undef, 'weak+lazy ref not returned'); is($foo2->{two}, undef, 'internal value not set'); my $ref3 = {}; is($foo2->two($ref3), $ref3, 'value returned from setter'); undef $ref3; ok(!defined $foo->{two}, 'weak value gone'); my $ref4 = {}; my $foo4 = Foo->new; $foo4->set_four($ref4); is($foo4->four, $ref4, 'value present'); ok(Scalar::Util::isweak($foo4->{four}), 'value weakened'); undef $ref4; ok(!defined $foo4->{four}, 'weak value gone'); # test readonly SVs sub mk_ref { \ 'yay' }; my $foo_ro = eval { Foo->new(one => mk_ref()) }; if ("$]" < 5.008_003) { like( $@, qr/\QReference to readonly value in "one" can not be weakened on Perl < 5.8.3/, 'Expected exception thrown on old perls' ); } elsif ($^O eq 'cygwin' and "$]" < 5.012_000) { SKIP: { skip 'Static coderef reaping seems nonfunctional on cygwin < 5.12', 1 } } else { is(${$foo_ro->one},'yay', 'value present'); ok(Scalar::Util::isweak($foo_ro->{one}), 'value weakened'); { no warnings 'redefine'; *mk_ref = sub {} } ok (!defined $foo_ro->{one}, 'optree reaped, ro static value gone'); } done_testing; Moo-2.005005/t/extend-constructor.t000644 000000 000000 00000001046 14355631140 017103 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; BEGIN { package Role::For::Constructor; use Moo::Role; has extra_param => (is => 'ro'); } BEGIN { package Some::Class; use Moo; BEGIN { my $con = Moo->_constructor_maker_for(__PACKAGE__); Moo::Role->apply_roles_to_object($con, 'Role::For::Constructor'); } } { package Some::SubClass; use Moo; extends 'Some::Class'; ::is(::exception { has bar => (is => 'ro'); }, undef, 'extending constructor generator works'); } done_testing; Moo-2.005005/t/accessor-handles.t000644 000000 000000 00000005227 14355631217 016461 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package Baz; use Moo; sub beep {'beep'} sub is_passed_undefined { !defined($_[0]) ? 'bar' : 'fail' } } { package Robot; use Moo::Role; requires 'smash'; $INC{"Robot.pm"} = 1; } { package Foo; use Moo; with 'Robot'; sub one {1} sub two {2} sub smash {'smash'} sub yum {$_[1]} } use InlineModule ( ExtRobot => q{ package ExtRobot; use Moo::Role; requires 'beep'; 1; }, ); { package Bar; use Moo; has foo => ( is => 'ro', handles => [ qw(one two) ] ); has foo2 => ( is => 'ro', handles => { un => 'one' } ); has foo3 => ( is => 'ro', handles => 'Robot' ); has foo4 => ( is => 'ro', handles => { eat_curry => [ yum => 'Curry!' ], }); has foo5 => ( is => 'ro', handles => 'ExtRobot' ); has foo6 => ( is => 'rw', handles => { foobot => '${\\Baz->can("beep")}'}, default => sub { 0 } ); has foo7 => ( is => 'rw', handles => { foobar => '${\\Baz->can("is_passed_undefined")}'}, default => sub { undef } ); has foo8 => ( is => 'rw', handles => [ 'foo8_gone' ], ); } my $bar = Bar->new( foo => Foo->new, foo2 => Foo->new, foo3 => Foo->new, foo4 => Foo->new, foo5 => Baz->new ); is $bar->one, 1, 'handles works'; is $bar->two, 2, 'handles works for more than one method'; is $bar->un, 1, 'handles works for aliasing a method'; is $bar->smash, 'smash', 'handles works for a role'; is $bar->beep, 'beep', 'handles loads roles'; is $bar->eat_curry, 'Curry!', 'handles works for currying'; is $bar->foobot, 'beep', 'asserter checks for existence not truth, on false value'; is $bar->foobar, 'bar', 'asserter checks for existence not truth, on undef '; like exception { $bar->foo8_gone; }, qr/^Attempted to access 'foo8' but it is not set/, 'asserter fails with correct message'; ok(my $e = exception { package Baz; use Moo; has foo => ( is => 'ro', handles => 'Robot' ); sub smash { 1 }; }, 'handles will not overwrite locally defined method'); like $e, qr{You cannot overwrite a locally defined method \(smash\) with a delegation}, '... and has correct error message'; is exception { package Buzz; use Moo; has foo => ( is => 'ro', handles => 'Robot' ); sub smash; }, undef, 'handles can overwrite predeclared subs'; ok(exception { package Fuzz; use Moo; has foo => ( is => 'ro', handles => $bar ); }, 'invalid handles (object) throws exception'); like exception { package Borf; use Moo; has foo => ( is => 'ro', handles => 'Bar' ); }, qr/is not a Moo::Role/, 'invalid handles (class) throws exception'; done_testing; Moo-2.005005/t/moo-utils-_name_coderef.t000644 000000 000000 00000001101 13777150314 017723 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; use List::Util; # List::Util provides Sub::Util::set_subname, so load it early use Scalar::Util; # to make sure it doesn't warn about our fake subs BEGIN { no warnings 'redefine'; $INC{'Sub/Name.pm'} ||= 1; defined &Sub::Name::subname or *Sub::Name::subname = sub { $_[1] }; $INC{'Sub/Util.pm'} ||= 1; defined &Sub::Util::set_subname or *Sub::Util::set_subname = sub { $_[1] }; } use Moo::_Utils (); ok( Moo::_Utils::_CAN_SUBNAME, "_CAN_SUBNAME is true when both Sub::Name and Sub::Util are loaded" ); done_testing; Moo-2.005005/t/non-moo-extends-c3.t000644 000000 000000 00000002471 14002355432 016565 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; BEGIN { if ("$]" >= 5.009_005) { require mro; } elsif (eval { require MRO::Compat; 1 }) { # do nothing } elsif ($ENV{RELEASE_TESTING}) { plan tests => 1; fail 'MRO::Compat required for testing on 5.8 under RELEASE_TESTING'; exit; } else { plan skip_all => 'MRO::Compat is required for C3 testing on perl < 5.10'; } } use Moo (); { package Foo; use mro 'c3'; sub new { my ($class, $rest) = @_; return bless {%$rest}, $class; } } { package Foo::AddCD; use base 'Foo'; sub new { my ($class, $rest) = @_; $rest->{c} = 'd'; return $class->next::method($rest); } } { package Foo::AddEF; use base 'Foo'; sub new { my ($class, $rest) = @_; $rest->{e} = 'f'; return $class->next::method($rest); } } { package Foo::Parent; use Moo; use mro 'c3'; extends 'Foo::AddCD', 'Foo'; } { package Foo::Parent::Child; use Moo; use mro 'c3'; extends 'Foo::AddEF', 'Foo::Parent'; } my $foo = Foo::Parent::Child->new({a => 'b'}); ok exists($foo->{a}) && $foo->{a} eq 'b', 'has basic attrs'; ok exists($foo->{c}) && $foo->{c} eq 'd', 'AddCD works'; ok exists($foo->{e}) && $foo->{e} eq 'f', 'AddEF works'; done_testing; Moo-2.005005/t/lazy_isa.t000644 000000 000000 00000003140 14355631140 015041 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; my $isa_called = 0; { package FooISA; use Moo; my $isa = sub { $isa_called++; die "I want to die" unless $_[0] eq 'live'; }; has a_lazy_attr => ( is => 'ro', isa => $isa, lazy => 1, builder => '_build_attr', ); has non_lazy => ( is => 'ro', isa => $isa, builder => '_build_attr', ); sub _build_attr { 'die' } } ok my $lives = FooISA->new(a_lazy_attr=>'live', non_lazy=>'live'), 'expect to live when both attrs are set to live in init'; my $called_pre = $isa_called; $lives->a_lazy_attr; is $called_pre, $isa_called, 'isa is not called on access when value already exists'; like( exception { FooISA->new(a_lazy_attr=>'live', non_lazy=>'die') }, qr/I want to die/, 'expect to die when non lazy is set to die in init', ); like( exception { FooISA->new(a_lazy_attr=>'die', non_lazy=>'die') }, qr/I want to die/, 'expect to die when non lazy and lazy is set to die in init', ); like( exception { FooISA->new(a_lazy_attr=>'die', non_lazy=>'live') }, qr/I want to die/, 'expect to die when lazy is set to die in init', ); like( exception { FooISA->new() }, qr/I want to die/, 'expect to die when both lazy and non lazy are allowed to default', ); like( exception { FooISA->new(a_lazy_attr=>'live') }, qr/I want to die/, 'expect to die when lazy is set to live but non lazy is allowed to default', ); is( exception { FooISA->new(non_lazy=>'live') }, undef, 'ok when non lazy is set to something valid but lazy is allowed to default', ); done_testing; Moo-2.005005/t/foreignbuildargs.t000644 000000 000000 00000002405 13777150314 016565 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package NonMooClass::Strict; BEGIN { $INC{'NonMooClass/Strict.pm'} = __FILE__ } sub new { my ($class, $arg) = @_; die "invalid arguments: " . join(',', @_[2..$#_]) if @_ > 2; bless { attr => $arg }, $class; } sub attr { shift->{attr} } package NonMooClass::Strict::MooExtend; use Moo; extends qw(NonMooClass::Strict); sub FOREIGNBUILDARGS { my ($class, %args) = @_; return $args{attr2}; } package NonMooClass::Strict::MooExtendWithAttr; use Moo; extends qw(NonMooClass::Strict); has 'attr2' => ( is => 'ro' ); sub FOREIGNBUILDARGS { my ($class, %args) = @_; return $args{attr}; } } my $non_moo = NonMooClass::Strict->new( 'bar' ); my $ext_non_moo = NonMooClass::Strict::MooExtend->new( attr => 'bar', attr2 => 'baz' ); my $ext_non_moo2 = NonMooClass::Strict::MooExtendWithAttr->new( attr => 'bar', attr2 => 'baz' ); is $non_moo->attr, 'bar', "non-moo accepts params"; is $ext_non_moo->attr, 'baz', "extended non-moo passes params"; is $ext_non_moo2->attr, 'bar', "extended non-moo passes params"; is $ext_non_moo2->attr2, 'baz', "extended non-moo has own attributes"; done_testing; Moo-2.005005/t/compose-roles.t000644 000000 000000 00000010515 14355631140 016021 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package One; use Moo::Role; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package Two; use Moo::Role; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package Three; use Moo::Role; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package Four; use Moo::Role; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package BaseClass; sub foo { __PACKAGE__ } } foreach my $combo ( [ qw(One Two Three Four) ], [ qw(Two Four Three) ], [ qw(One Two) ] ) { my $combined = Moo::Role->create_class_with_roles('BaseClass', @$combo); is_deeply( [ $combined->foo ], [ reverse(@$combo), 'BaseClass' ], "${combined} ok" ); my $object = bless({}, 'BaseClass'); Moo::Role->apply_roles_to_object($object, @$combo); is(ref($object), $combined, 'Object reblessed into correct class'); } { package RoleWithAttr; use Moo::Role; has attr1 => (is => 'ro', default => -1); package RoleWithAttr2; use Moo::Role; has attr2 => (is => 'ro', default => -2); package ClassWithAttr; use Moo; has attr3 => (is => 'ro', default => -3); } Moo::Role->apply_roles_to_package('ClassWithAttr', 'RoleWithAttr', 'RoleWithAttr2'); my $o = ClassWithAttr->new(attr1 => 1, attr2 => 2, attr3 => 3); is($o->attr1, 1, 'attribute from role works'); is($o->attr2, 2, 'attribute from role 2 works'); is($o->attr3, 3, 'attribute from base class works'); { package SubClassWithoutAttr; use Moo; extends 'ClassWithAttr'; } my $o2 = Moo::Role->create_class_with_roles( 'SubClassWithoutAttr', 'RoleWithAttr')->new; is($o2->attr3, -3, 'constructor includes base class'); is($o2->attr2, -2, 'constructor includes role'); { package AccessorExtension; use Moo::Role; around 'generate_method' => sub { my $orig = shift; my $me = shift; my ($into, $name) = @_; $me->$orig(@_); no strict 'refs'; *{"${into}::_${name}_marker"} = sub { }; }; } { package RoleWithReq; use Moo::Role; requires '_attr1_marker'; } is exception { package ClassWithExtension; use Moo; Moo::Role->apply_roles_to_object( Moo->_accessor_maker_for(__PACKAGE__), 'AccessorExtension'); with qw(RoleWithAttr RoleWithReq); }, undef, 'apply_roles_to_object correctly calls accessor generator'; { package EmptyClass; use Moo; } { package RoleWithReq2; use Moo::Role; requires 'attr2'; } is exception { Moo::Role->create_class_with_roles( 'EmptyClass', 'RoleWithReq2', 'RoleWithAttr2'); }, undef, 'create_class_with_roles accepts attributes for requirements'; like exception { Moo::Role->create_class_with_roles( 'EmptyClass', 'RoleWithReq2', 'RoleWithAttr'); }, qr/Can't apply .* missing attr2/, 'create_class_with_roles accepts attributes for requirements'; { package RoleWith2Attrs; use Moo::Role; has attr1 => (is => 'ro', default => -1); has attr2 => (is => 'ro', default => -2); } foreach my $combo ( [qw(RoleWithAttr RoleWithAttr2)], [qw(RoleWith2Attrs)], ) { is exception { my $o = Moo::Role->apply_roles_to_object( EmptyClass->new, @$combo); is($o->attr1, -1, 'first attribute works'); is($o->attr2, -2, 'second attribute works'); }, undef, "apply_roles_to_object with multiple attrs with defaults (@$combo)"; } { package Some::Class; use Moo; sub foo { 1 } } like exception { Moo::Role->apply_roles_to_package('EmptyClass', 'Some::Class'); }, qr/Some::Class is not a Moo::Role/, 'apply_roles_to_package throws error on non-role'; like exception { Moo::Role->apply_single_role_to_package('EmptyClass', 'Some::Class'); }, qr/Some::Class is not a Moo::Role/, 'apply_single_role_to_package throws error on non-role'; like exception { Moo::Role->create_class_with_roles('EmptyClass', 'Some::Class'); }, qr/Some::Class is not a Moo::Role/, 'can only create class with roles'; delete Moo->_constructor_maker_for('Some::Class')->{attribute_specs}; is exception { Moo::Role->apply_roles_to_package('Some::Class', 'RoleWithAttr'); }, undef, 'apply_roles_to_package copes with missing attribute specs'; { package Non::Moo::Class; sub new { bless {}, $_[0] } } Moo::Role->apply_roles_to_package('Non::Moo::Class', 'RoleWithAttr'); ok +Non::Moo::Class->can('attr1'), 'can apply role with attributes to non Moo class'; done_testing; Moo-2.005005/t/isa-interfere.t000644 000000 000000 00000002173 14355631140 015770 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use Moo (); BEGIN { package BaseClass; sub new { my $class = shift; my $self = bless {}, $class; return $self; } } BEGIN { package ExtraClass; our @ISA = qw(BaseClass); sub new { my $class = shift; $class->SUPER::new(@_); } } BEGIN { package ChildClass; use Moo; extends 'BaseClass'; our $EXTEND_FILE = __FILE__; our $EXTEND_LINE = __LINE__; unshift our @ISA, 'ExtraClass'; } my $ex = exception { ChildClass->new; }; like $ex, qr{Expected parent constructor of ChildClass to be BaseClass, but found ExtraClass}, 'Interfering with @ISA after using extends triggers error'; like $ex, qr{\Q(after $ChildClass::EXTEND_FILE line $ChildClass::EXTEND_LINE)\E}, ' ... reporting location triggering constructor generation'; BEGIN { package ExtraClass2; sub foo { 'garp' } } BEGIN { package ChildClass2; use Moo; extends 'BaseClass'; unshift our @ISA, 'ExtraClass2'; } is exception { ChildClass2->new; }, undef, 'Changing @ISA without effecting constructor does not trigger error'; done_testing; Moo-2.005005/t/zzz-check-breaks.t000644 000000 000000 00000003102 13777150314 016407 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; my $meta; BEGIN { eval { require Parse::CPAN::Meta; Parse::CPAN::Meta->VERSION(1.4200) } or plan skip_all => 'Parse::CPAN::Meta required for checking breakages'; eval { require CPAN::Meta::Requirements } or plan skip_all => 'CPAN::Meta::Requirements required for checking breakages'; my @meta_files = grep -f, qw(MYMETA.json MYMETA.yml META.json META.yml) or plan skip_all => 'no META file exists'; for my $meta_file (@meta_files) { eval { $meta = Parse::CPAN::Meta->load_file($meta_file) } and last; } if (!$meta) { plan skip_all => 'unable to load any META files'; } } use ExtUtils::MakeMaker; my $breaks = $meta->{x_breaks}; my $req = CPAN::Meta::Requirements->from_string_hash( $breaks ); pass 'checking breakages...'; my @breaks; for my $module ($req->required_modules) { (my $file = "$module.pm") =~ s{::}{/}g; my ($pm_file) = grep -e, map "$_/$file", @INC; next unless $pm_file; my $version = MM->parse_version($pm_file); next unless defined $version; (my $check_version = $version) =~ s/_//; if ($req->accepts_module($module, $version)) { my $broken_v = $breaks->{$module}; $broken_v = ">= $broken_v" unless $broken_v =~ /\A\s*(?:==|>=|>|<=|<|!=)/; push @breaks, [$module, $check_version, $broken_v]; } } if (@breaks) { diag "Installing Moo $meta->{version} will break these modules:\n\n" . (join '', map { "$_->[0] (found version $_->[1])\n" . " Broken versions: $_->[2]\n" } @breaks) . "\nYou should now update these modules!"; } done_testing; Moo-2.005005/t/accessor-weaken-pre-5_8_3.t000644 000000 000000 00000000373 13777150314 017712 0ustar00rootwheel000000 000000 use strict; use warnings; use File::Spec; BEGIN { $ENV{MOO_TEST_PRE_583} = 1; } (my $real_test = File::Spec->rel2abs(__FILE__)) =~ s/-pre-5_8_3//; unless (defined do $real_test) { die "$real_test: $@" if $@; die "$real_test: $!" if $!; } Moo-2.005005/t/accessor-pred-clear.t000644 000000 000000 00000001410 13777150313 017047 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package Foo; use Moo; my @params = (is => 'ro', lazy => 1, default => sub { 3 }); has one => (@params, predicate => 'has_one', clearer => 'clear_one'); has $_ => (@params, clearer => 1, predicate => 1) for qw( bar _bar ); } my $foo = Foo->new; for ( qw( one bar _bar ) ) { my ($lead, $middle) = ('_' x /^_/, '_' x !/^_/); my $predicate = $lead . "has$middle$_"; my $clearer = $lead . "clear$middle$_"; ok(!$foo->$predicate, 'empty'); is($foo->$_, 3, 'lazy default'); ok($foo->$predicate, 'not empty now'); is($foo->$clearer, 3, 'clearer returns value'); ok(!$foo->$predicate, 'clearer empties'); is($foo->$_, 3, 'default re-fired'); ok($foo->$predicate, 'not empty again'); } done_testing; Moo-2.005005/t/global-destruction-helper.pl000644 000000 000000 00000000373 13777150314 020467 0ustar00rootwheel000000 000000 use strict; use warnings; use POSIX (); my $exit_value = shift; BEGIN { package Bar; use Moo; sub DEMOLISH { my ($self, $gd) = @_; if ($gd) { POSIX::_exit($exit_value); } } } our $bar = Bar->new; Moo-2.005005/t/init-arg.t000644 000000 000000 00000003675 14355631140 014755 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package Foo; use Moo; has optional => ( is => 'rw', init_arg => 'might_have', isa => sub { die "isa" if $_[0] % 2 }, default => sub { 7 }, ); has lazy => ( is => 'rw', init_arg => 'workshy', isa => sub { die "aieee" if $_[0] % 2 }, default => sub { 7 }, lazy => 1, ); } like( exception { Foo->new }, qr/\Aisa check for "optional" \(constructor argument: "might_have"\) failed:/, "isa default" ); like( exception { Foo->new(might_have => 3) }, qr/\Aisa check for "optional" \(constructor argument: "might_have"\) failed:/, "isa init_arg", ); is( exception { Foo->new(might_have => 2) }, undef, "isa init_arg ok" ); my $foo = Foo->new(might_have => 2); like( exception { $foo->optional(3) }, qr/\Aisa check for "optional" failed:/, "isa accessor", ); like( exception { $foo->lazy }, qr/\Aisa check for "lazy" failed:/, "lazy accessor", ); like( exception { $foo->lazy(3) }, qr/\Aisa check for "lazy" failed:/, "lazy set isa fail", ); is( exception { $foo->lazy(4) }, undef, "lazy set isa ok", ); like( exception { Foo->new(might_have => 2, workshy => 3) }, qr/\Aisa check for "lazy" \(constructor argument: "workshy"\) failed:/, "lazy init_arg", ); { package Bar; use Moo; has sane_key_name => ( is => 'rw', init_arg => 'stupid key name', isa => sub { die "isa" if $_[0] % 2 }, required => 1 ); has sane_key_name2 => ( is => 'rw', init_arg => 'complete\nnonsense\\\'key', isa => sub { die "isa" if $_[0] % 2 }, required => 1 ); } my $bar; is( exception { $bar= Bar->new( 'stupid key name' => 4, 'complete\nnonsense\\\'key' => 6 ) }, undef, 'requiring init_arg with spaces and insanity', ); is( $bar->sane_key_name, 4, 'key renamed correctly' ); is( $bar->sane_key_name2, 6, 'key renamed correctly' ); done_testing; Moo-2.005005/t/accessor-roles.t000644 000000 000000 00000003326 14355631140 016160 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use Sub::Quote; { package One; use Moo; has one => (is => 'ro', default => sub { 'one' }); package One::P1; use Moo::Role; has two => (is => 'ro', default => sub { 'two' }); package One::P2; use Moo::Role; has three => (is => 'ro', default => sub { 'three' }); has four => (is => 'ro', lazy => 1, default => sub { 'four' }, predicate => 1); package One::P3; use Moo::Role; has '+three' => (is => 'ro', default => sub { 'three' }); } my $combined = Moo::Role->create_class_with_roles('One', qw(One::P1 One::P2)); isa_ok $combined, "One"; ok $combined->does($_), "Does $_" for qw(One::P1 One::P2); ok !$combined->does('One::P3'), 'Does not One::P3'; my $c = $combined->new; is $c->one, "one", "attr default set from class"; is $c->two, "two", "attr default set from role"; is $c->three, "three", "attr default set from role"; { package Deux; use Moo; with 'One::P1'; ::like( ::exception { has two => (is => 'ro', default => sub { 'II' }); }, qr{^You cannot overwrite a locally defined method \(two\) with a reader}, 'overwriting accesssors with roles fails' ); } { package Two; use Moo; with 'One::P1'; has '+two' => (is => 'ro', default => sub { 'II' }); } is(Two->new->two, 'II', "overwriting accessors using +attr works"); my $o = One->new; Moo::Role->apply_roles_to_object($o, 'One::P2'); is($o->three, 'three', 'attr default set from role applied to object'); ok(!$o->has_four, 'lazy attr default not set on apply'); $o = $combined->new(three => '3'); Moo::Role->apply_roles_to_object($o, 'One::P3'); is($o->three, '3', 'attr default not used when already set when role applied to object'); done_testing; Moo-2.005005/t/coerce-1.t000644 000000 000000 00000003450 14355631140 014630 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package IntConstraint; use Moo; use overload '&{}' => sub { shift->constraint }, fallback => 1; has constraint => ( is => 'ro', default => sub { sub { $_[0] eq int $_[0] or die } }, ); sub check { my $self = shift; !!eval { $self->constraint->(@_); 1 } } } # First supported interface for coerce=>1. # The type constraint provides an $isa->coerce($value) method. { package IntConstraint::WithCoerceMethod; use Moo; extends qw(IntConstraint); sub coerce { my $self = shift; int($_[0]); } } # First supported interface for coerce=>1. # The type constraint provides an $isa->coercion method # providing a coderef such that $coderef->($value) coerces. { package IntConstraint::WithCoercionMethod; use Moo; extends qw(IntConstraint); has coercion => ( is => 'ro', default => sub { sub { int($_[0]) } }, ); } { package Goo; use Moo; ::like(::exception { has foo => ( is => 'ro', isa => sub { $_[0] eq int $_[0] }, coerce => 1, ); }, qr/Invalid coercion/, 'coerce => 1 not allowed when isa has no coercion'); ::like(::exception { has foo => ( is => 'ro', isa => IntConstraint->new, coerce => 1, ); }, qr/Invalid coercion/, 'coerce => 1 not allowed when isa has no coercion'); has bar => ( is => 'ro', isa => IntConstraint::WithCoercionMethod->new, coerce => 1, ); has baz => ( is => 'ro', isa => IntConstraint::WithCoerceMethod->new, coerce => 1, ); } my $obj = Goo->new( bar => 3.14159, baz => 3.14159, ); is($obj->bar, '3', '$isa->coercion'); is($obj->baz, '3', '$isa->coerce'); done_testing; Moo-2.005005/t/moo-object.t000644 000000 000000 00000003207 14355631140 015270 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; { package MyClass; use base 'Moo::Object'; } { package MyClass2; use base 'Moo::Object'; sub BUILD { } } is_deeply +MyClass->BUILDARGS({foo => 'bar'}), {foo => 'bar'}, 'BUILDARGS: hashref accepted'; is_deeply +MyClass->BUILDARGS(foo => 'bar'), {foo => 'bar'}, 'BUILDARGS: hash accepted'; like exception { MyClass->BUILDARGS('foo') }, qr/Single parameters to new\(\) must be a HASH ref/, 'BUILDARGS: non-hashref single element rejected'; like exception { MyClass->BUILDARGS(foo => 'bar', 5) }, qr/You passed an odd number of arguments/, 'BUILDARGS: odd number of elements rejected'; is +MyClass->new({foo => 'bar'})->{foo}, undef, 'arbitrary attributes not stored when no BUILD exists'; my $built = 0; *MyClass::BUILD = *MyClass::BUILD = sub { $built++ }; is +MyClass->new({foo => 'bar'})->{foo}, undef, 'arbitrary attributes not stored second time when no BUILD exists'; is $built, 0, 'BUILD only checked for once'; is +MyClass2->new({foo => 'bar'})->{foo}, undef, 'arbitrary attributes not stored when BUILD exists'; is +MyClass2->new({foo => 'bar'})->{foo}, undef, 'arbitrary attributes not stored second time when BUILD exists'; ok !MyClass->does('MyClass2'), 'does returns false for other class'; is $INC{'Role/Tiny.pm'}, undef, " ... and doesn't load Role::Tiny"; { my $meta = MyClass->meta; $meta->make_immutable; is $INC{'Moo/HandleMoose.pm'}, undef, "->meta->make_immutable doesn't load HandleMoose"; $meta->DESTROY; } is $INC{'Moo/HandleMoose.pm'}, undef, "destroying fake metaclass doesn't load HandleMoose"; done_testing; Moo-2.005005/t/method-generate-accessor.t000644 000000 000000 00000014107 14355631140 020103 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; use Method::Generate::Accessor; use Sub::Quote 'quote_sub'; use Sub::Defer (); my $gen; BEGIN { $gen = Method::Generate::Accessor->new; } { package Foo; use Moo; } BEGIN { # lie about overload.pm just in case local $INC{'overload.pm'}; delete $INC{'overload.pm'}; my $c = bless {}, 'Gorf'; like( exception { $gen->generate_method('Foo' => 'gorf' => { is => 'ro', coerce => $c } ) }, qr/^Invalid coerce '\Q$c\E' for Foo->gorf /, "coerce - object rejected (before overload loaded)" ); } { package WithOverload; use overload '&{}' => sub { sub { 5 } }, fallback => 1; sub new { bless {} } } $gen->generate_method('Foo' => 'one' => { is => 'ro' }); $gen->generate_method('Foo' => 'two' => { is => 'rw' }); like( exception { $gen->generate_method('Foo' => 'three' => {}) }, qr/Must have an is/, 'No is rejected' ); like( exception { $gen->generate_method('Foo' => 'three' => { is => 'purple' }) }, qr/Unknown is purple/, 'is purple rejected' ); is(exception { $gen->generate_method('Foo' => 'three' => { is => 'bare', predicate => 1 }); }, undef, 'generating bare accessor works'); ok(Foo->can('has_three'), 'bare accessor will still generate predicate'); like( exception { $gen->generate_method('Foo' => 'four' => { is => 'ro', coerce => 5 }) }, qr/Invalid coerce/, "coerce - scalar rejected" ); is( exception { $gen->generate_method('Foo' => 'four' => { is => 'ro', default => 5 }) }, undef, "default - non-ref scalar accepted" ); foreach my $setting (qw( default coerce )) { like( exception { $gen->generate_method('Foo' => 'five' => { allow_overwrite => 1, is => 'ro', $setting => [] }) }, qr/Invalid $setting/, "$setting - arrayref rejected" ); like( exception { $gen->generate_method('Foo' => 'five' => { allow_overwrite => 1, is => 'ro', $setting => Foo->new }) }, qr/Invalid $setting/, "$setting - non-code-convertible object rejected" ); is( exception { $gen->generate_method('Foo' => 'six' => { allow_overwrite => 1, is => 'ro', $setting => sub { 5 } }) }, undef, "$setting - coderef accepted" ); is( exception { $gen->generate_method('Foo' => 'seven' => { allow_overwrite => 1, is => 'ro', $setting => bless sub { 5 } => 'Blah' }) }, undef, "$setting - blessed sub accepted" ); is( exception { $gen->generate_method('Foo' => 'eight' => { allow_overwrite => 1, is => 'ro', $setting => WithOverload->new }) }, undef, "$setting - object with overloaded ->() accepted" ); like( exception { $gen->generate_method('Foo' => 'nine' => { allow_overwrite => 1, is => 'ro', $setting => bless {} => 'Blah' }) }, qr/Invalid $setting/, "$setting - object rejected" ); } is( exception { $gen->generate_method('Foo' => 'ten' => { is => 'ro', builder => '_build_ten' }) }, undef, 'builder - string accepted', ); is( exception { $gen->generate_method('Foo' => 'eleven' => { is => 'ro', builder => sub {} }) }, undef, 'builder - coderef accepted' ); like( exception { $gen->generate_method('Foo' => 'twelve' => { is => 'ro', builder => 'build:twelve' }) }, qr/Invalid builder/, 'builder - invalid name rejected', ); is( exception { $gen->generate_method('Foo' => 'thirteen' => { is => 'ro', builder => 'build::thirteen' }) }, undef, 'builder - fully-qualified name accepted', ); is( exception { $gen->generate_method('Foo' => 'fifteen' => { is => 'lazy', builder => sub {15} }) }, undef, 'builder - coderef accepted' ); is( exception { $gen->generate_method('Foo' => 'sixteen' => { is => 'lazy', builder => quote_sub q{ 16 } }) }, undef, 'builder - quote_sub accepted' ); { my $methods = $gen->generate_method('Foo' => 'seventeen' => { is => 'lazy', default => 0 }, { no_defer => 0 }); ok Sub::Defer::defer_info($methods->{seventeen}), 'quote opts are passed on'; } ok !$gen->is_simple_attribute('attr', { builder => 'build_attr' }), "attribute with builder isn't simple"; ok $gen->is_simple_attribute('attr', { clearer => 'clear_attr' }), "attribute with clearer is simple"; { my ($code, $cap) = $gen->generate_get_default('$self', 'attr', { default => 5 }); is eval $code, 5, 'non-ref default code works'; is_deeply $cap, {}, 'non-ref default has no captures'; } { my ($code, $cap) = $gen->generate_simple_get('$self', 'attr', { default => 1 }); my $self = { attr => 5 }; is eval $code, 5, 'simple get code works'; is_deeply $cap, {}, 'simple get code has no captures'; } { my ($code, $cap) = $gen->generate_coerce('attr', '$value', quote_sub q{ $_[0] + 1 }); my $value = 5; is eval $code, 6, 'coerce from quoted sub code works'; is_deeply $cap, {}, 'coerce from quoted sub has no captures'; } { my ($code, $cap) = $gen->generate_trigger('attr', '$self', '$value', quote_sub q{ $_[0]{trigger} = $_[1] }); my $self = {}; my $value = 5; eval $code; is $self->{trigger}, 5, 'trigger from quoted sub code works'; is_deeply $cap, {}, 'trigger from quoted sub has no captures'; } { my ($code, $cap) = $gen->generate_isa_check('attr', '$value', quote_sub q{ die "bad value: $_[0]" unless $_[0] && $_[0] == 5 }); my $value = 4; eval $code; like $@, qr/bad value: 4/, 'isa from quoted sub code works'; is_deeply $cap, {}, 'isa from quoted sub has no captures'; } { my ($code, $cap) = $gen->generate_populate_set( '$obj', 'attr', { is => 'ro' }, undef, undef, 'attr', ); is $code, '', 'populate without eager default or test is blank'; is_deeply $cap, {}, ' ... and has no captures'; } my $foo = Foo->new; $foo->{one} = 1; is($foo->one, 1, 'ro reads'); ok(exception { $foo->one(-3) }, 'ro dies on write attempt'); is($foo->one, 1, 'ro does not write'); is($foo->two, undef, 'rw reads'); $foo->two(-3); is($foo->two, -3, 'rw writes'); is($foo->fifteen, 15, 'builder installs code sub'); is($foo->_build_fifteen, 15, 'builder installs code sub under the correct name'); is($foo->sixteen, 16, 'builder installs quote_sub'); { my $var = $gen->_sanitize_name('erk-qro yuf (fid)'); eval qq{ my \$$var = 5; \$var }; is $@, '', '_sanitize_name gives valid identifier'; } done_testing; Moo-2.005005/t/non-moo-extends.t000644 000000 000000 00000003243 13777150314 016272 0ustar00rootwheel000000 000000 use strict; use warnings; use Test::More; { package ClassA; use Moo; has 'foo' => ( is => 'ro'); has built => (is => 'rw', default => 0); sub BUILD { $_[0]->built($_[0]->built+1); } } { package ClassB; our @ISA = 'ClassA'; sub blorp {}; sub new { $_[0]->SUPER::new(@_[1..$#_]); } } { package ClassC; use Moo; extends 'ClassB'; has bar => (is => 'ro'); } { package ClassD; our @ISA = 'ClassC'; } my $o = ClassD->new(foo => 1, bar => 2); isa_ok $o, 'ClassD'; is $o->foo, 1, 'superclass attribute has correct value'; is $o->bar, 2, 'subclass attribute has correct value'; is $o->built, 1, 'BUILD called correct number of times'; { package ClassE; sub new { return ClassF->new; } } { package ClassF; use Moo; extends 'Moo::Object', 'ClassE'; } { my $o = eval { ClassF->new }; ok $o, 'explicit inheritence from Moo::Object works around broken constructor' or diag $@; isa_ok $o, 'ClassF'; } { package ClassG; use Sub::Defer; defer_sub __PACKAGE__.'::new' => sub { sub { bless {}, $_[0] } }; } { package ClassH; use Moo; extends 'ClassG'; } { my $o = eval { ClassH->new }; ok $o, 'inheriting from non-Moo with deferred new works' or diag $@; isa_ok $o, 'ClassH'; } { package ClassI; sub new { my $self = shift; my $class = ref $self ? ref $self : $self; bless { (ref $self ? %$self : ()), @_, }, $class; } } { package ClassJ; use Moo; extends 'ClassI'; has 'attr' => (is => 'ro'); } { my $o1 = ClassJ->new(attr => 1); my $o2 = $o1->new; is $o2->attr, 1, 'original invoker passed to parent new'; } done_testing; Moo-2.005005/t/accessor-shortcuts.t000644 000000 000000 00000002114 14355631140 017064 0ustar00rootwheel000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use CaptureException; my $test = "test"; my $lazy_default = "lazy_default"; { package Foo; use Moo; has rwp => (is => 'rwp'); has lazy => (is => 'lazy'); sub _build_lazy { $test } has lazy_default => (is => 'lazy', default => sub { $lazy_default }); } my $foo = Foo->new; # rwp { is $foo->rwp, undef, "rwp value starts out undefined"; ok exception { $foo->rwp($test) }, "rwp is read_only"; is exception { $foo->_set_rwp($test) }, undef, "rwp can be set by writer"; is $foo->rwp, $test, "rwp value was set by writer"; } # lazy { is $foo->{lazy}, undef, "lazy value storage is undefined"; is $foo->lazy, $test, "lazy value returns test value when called"; ok exception { $foo->lazy($test) }, "lazy is read_only"; } # lazy + default { is $foo->{lazy_default}, undef, "lazy_default value storage is undefined"; is $foo->lazy_default, $lazy_default, "lazy_default value returns test value when called"; ok exception { $foo->lazy_default($test) }, "lazy_default is read_only"; } done_testing; Moo-2.005005/t/lib/CaptureException.pm000644 000000 000000 00000000750 14355634361 017443 0ustar00rootwheel000000 000000 package CaptureException; use strict; use warnings; use lib 't/lib'; use Exporter (); BEGIN { *import = \&Exporter::import } use Carp (); our @EXPORT = qw(exception); sub exception (&) { my $cb = shift; eval { local $Test::Builder::Level = $Test::Builder::Level + 3; $cb->(); 1; } or do { return $@ if $@; Carp::confess( (defined $@ ? 'false' : 'undef') . " exception caught by CaptureException::exception" ); }; return undef; } 1; Moo-2.005005/t/lib/InlineModule.pm000644 000000 000000 00000001726 13777150314 016547 0ustar00rootwheel000000 000000 package InlineModule; use strict; use warnings; BEGIN { *_HAS_PERLIO = "$]" >= 5.008_000 ? sub(){1} : sub(){0}; } sub import { my ($class, %modules) = @_; unshift @INC, inc_hook(%modules); } sub inc_hook { my (%modules) = @_; my %files = map { (my $file = "$_.pm") =~ s{::}{/}g; $file => $modules{$_}; } keys %modules; sub { return unless exists $files{$_[1]}; my $module = $files{$_[1]}; if (!defined $module) { die "Can't locate $_[1] in \@INC (hidden) (\@INC contains: @INC).\n"; } inc_module($module); } } sub inc_module { my $code = $_[0]; if (_HAS_PERLIO) { open my $fh, '<', \$code or die "error loading module: $!"; return $fh; } else { my $pos = 0; my $last = length $code; return (sub { return 0 if $pos == $last; my $next = (1 + index $code, "\n", $pos) || $last; $_ .= substr $code, $pos, $next - $pos; $pos = $next; return 1; }); } } 1; Moo-2.005005/t/lib/TestEnv.pm000644 000000 000000 00000000525 13777354515 015560 0ustar00rootwheel000000 000000 package TestEnv; use strict; use warnings; sub import { $ENV{$_} = 1 for grep defined && length && !exists $ENV{$_}, @_[1 .. $#_]; if ($ENV{MOO_FATAL_WARNINGS}) { my @opts = ( '-Ixt/lib', '-MFatalWarnings', (exists $ENV{PERL5OPT} ? $ENV{PERL5OPT} : ()), ); $ENV{PERL5OPT} = join ' ', @opts; } } 1; Moo-2.005005/t/lib/ErrorLocation.pm000644 000000 000000 00000004646 13777150314 016751 0ustar00rootwheel000000 000000 package ErrorLocation; use strict; use warnings; use Test::Builder; use Carp qw(croak); use Exporter (); BEGIN { *import = \&Exporter::import } use Carp::Heavy (); our @EXPORT = qw(location_ok); my $builder = Test::Builder->new; my $gen = 'A000'; sub location_ok ($$) { my ($code, $name) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; my ($pre) = $code =~ /\A(.*?)(?:## fail\n.*)?\n?\z/s; my $fail_line = 1 + $pre =~ tr/\n//; my $PACKAGE = "LocationTest::_".++$gen; my $sub = eval qq{ sub { package $PACKAGE; #line 1 LocationTestFile $code } }; my $full_trace; my $last_location; my $immediate; my $trace_capture = sub { my @c = caller; my ($location) = $_[0] =~ /^.* at (.*? line \d+)\.?$/; $location ||= sprintf "%s line %s", (caller(0))[1,2]; if (!$last_location || $last_location ne $location) { $last_location = $location; $immediate = $c[1] eq 'LocationTestFile'; { local %Carp::Internal; local %Carp::CarpInternal; $full_trace = Carp::longmess(''); } $full_trace =~ s/\A.*\n//; $full_trace =~ s/^\t//mg; $full_trace =~ s/^[^\n]+ called at ${\__FILE__} line [0-9]+\n.*//ms; if ($c[0] eq 'Carp') { $full_trace =~ s/.*?(^Carp::)/$1/ms; } else { my ($arg) = @_; $arg =~ s/\Q at $c[1] line $c[2]\E\.\n\z//; my $caller = 'CORE::die(' . Carp::format_arg($arg) . ") called at $location\n"; $full_trace =~ s/\A.*\n/$caller/; } $full_trace =~ s{^(.* called at )(\(eval [0-9]+\)(?:\[[^\]]*\])?) line ([0-9]+)\n}{ my ($prefix, $file, $line) = ($1, $2, $3); my $i = 0; while (my @c = caller($i++)) { if ($c[1] eq $file && $c[2] eq $line) { $file .= "[$c[0]]"; last; } } "$prefix$file line $line\n"; }meg; $full_trace =~ s/^/ /mg; } }; croak "$name - compile error: $@" if !$sub; local $@; eval { local $Carp::Verbose = 0; local $SIG{__WARN__}; local $SIG{__DIE__} = $trace_capture; $sub->(); 1; } and croak "$name - code did not fail!"; croak "died directly in test code: $@" if $immediate; delete $LocationTest::{"_$gen"}; my ($location) = $@ =~ /.* at (.*? line \d+)\.?$/; $builder->is_eq($location, "LocationTestFile line $fail_line", $name) or $builder->diag(" error:\n $@\n full trace:\n$full_trace"), return !1; } 1;