Moo-2.003004/0000755000000000000000000000000013210132315012602 5ustar00rootwheel00000000000000Moo-2.003004/Changes0000644000000000000000000006377713210132122014115 0ustar00rootwheel00000000000000Revision history for Moo 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.003004/lib/0000755000000000000000000000000013210132311013344 5ustar00rootwheel00000000000000Moo-2.003004/lib/Method/0000755000000000000000000000000013210132311014564 5ustar00rootwheel00000000000000Moo-2.003004/lib/Method/Generate/0000755000000000000000000000000013210132311016316 5ustar00rootwheel00000000000000Moo-2.003004/lib/Method/Generate/Accessor.pm0000644000000000000000000004747413210126527020452 0ustar00rootwheel00000000000000package Method::Generate::Accessor; use Moo::_strictures; use Moo::_Utils qw(_load_module _maybe_load_module _install_coderef); 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) } 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; } my $module_name_only = qr/\A$Module::Runtime::module_name_rx\z/; 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/^\+//; croak "Must have an is" unless my $is = $spec->{is}; if ($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_only; } 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 = do { if (ref($hspec) eq 'ARRAY') { map [ $_ => $_ ], @$hspec; } elsif (ref($hspec) eq 'HASH') { map [ $_ => ref($hspec->{$_}) ? @{$hspec->{$_}} : $hspec->{$_} ], keys %$hspec; } elsif (!ref($hspec)) { require Moo::Role; _load_module $hspec; map [ $_ => $_ ], Moo::Role->methods_provided_by($hspec) } else { 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 (!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.003004/lib/Method/Generate/BuildAll.pm0000644000000000000000000000173513205055410020362 0ustar00rootwheel00000000000000package Method::Generate::BuildAll; use Moo::_strictures; use Moo::Object (); BEGIN { our @ISA = qw(Moo::Object) } use Sub::Quote qw(quote_sub quotify); use Moo::_Utils qw(_getglob); use Moo::_mro; 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 @{mro::get_linear_isa($into)}; ' (('.$args.')[0]->{__no_BUILD__} or ('."\n" .join('', map qq{ ${me}->${_}(${args}),\n}, @builds) ." )),\n"; } 1; Moo-2.003004/lib/Method/Generate/Constructor.pm0000644000000000000000000001714113207533066021227 0ustar00rootwheel00000000000000package Method::Generate::Constructor; use Moo::_strictures; use Sub::Quote qw(quote_sub quotify); use Sub::Defer; use Moo::_Utils qw(_getstash _getglob); use Moo::_mro; 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/^\+//) { croak "has '+${name}' given but no ${name} attribute already exists" unless my $old_spec = $specs->{$name}; $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) = @{mro::get_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) = @{mro::get_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.003004/lib/Method/Generate/DemolishAll.pm0000644000000000000000000000244413205055410021065 0ustar00rootwheel00000000000000package Method::Generate::DemolishAll; use Moo::_strictures; use Moo::Object (); BEGIN { our @ISA = qw(Moo::Object) } use Sub::Quote qw(quote_sub quotify); use Moo::_Utils qw(_getglob); use Moo::_mro; 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", join '', q! my $self = shift; my $e = do { local $?; local $@; require Devel::GlobalDestruction; eval { $self->DEMOLISHALL(Devel::GlobalDestruction::in_global_destruction); }; $@; }; # fatal warnings+die in DESTROY = bad times (perl rt#123398) no warnings FATAL => 'all'; use warnings 'all'; die $e if $e; # rethrow !; } sub demolishall_body_for { my ($self, $into, $me, $args) = @_; my @demolishers = grep *{_getglob($_)}{CODE}, map "${_}::DEMOLISH", @{mro::get_linear_isa($into)}; join '', map qq{ ${me}->${_}(${args});\n}, @demolishers; } sub _handle_subdemolish { my ($self, $into) = @_; ' if (ref($_[0]) ne '.quotify($into).') {'."\n". ' return shift->Moo::Object::DEMOLISHALL(@_)'.";\n". ' }'."\n"; } 1; Moo-2.003004/lib/Moo/0000755000000000000000000000000013210132311014076 5ustar00rootwheel00000000000000Moo-2.003004/lib/Moo/_mro.pm0000644000000000000000000000017013205055410015376 0ustar00rootwheel00000000000000package Moo::_mro; use Moo::_strictures; if ("$]" >= 5.010_000) { require mro; } else { require MRO::Compat; } 1; Moo-2.003004/lib/Moo/_strictures.pm0000644000000000000000000000046013205055410017012 0ustar00rootwheel00000000000000package Moo::_strictures; use strict; use warnings; sub import { if ($ENV{MOO_FATAL_WARNINGS}) { require strictures; strictures->VERSION(2); @_ = ('strictures'); goto &strictures::import; } else { strict->import; warnings->import; warnings->unimport('once'); } } 1; Moo-2.003004/lib/Moo/_Utils.pm0000644000000000000000000000664513205055410015716 0ustar00rootwheel00000000000000package Moo::_Utils; use Moo::_strictures; { no strict 'refs'; 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}; } use Module::Runtime qw(use_package_optimistically module_notional_filename); use Devel::GlobalDestruction (); use Exporter qw(import); use Config; use Carp qw(croak); our @EXPORT = qw( _getglob _install_modifier _load_module _maybe_load_module _getstash _install_coderef _name_coderef _unimport_coderefs _set_loaded ); sub _install_modifier { my ($into, $type, $name, $code) = @_; if ($INC{'Sub/Defer.pm'} and my $to_modify = $into->can($name)) { # CMM will throw for us if not Sub::Defer::undefer_sub($to_modify); } require Class::Method::Modifiers; Class::Method::Modifiers::install_modifier(@_); } sub _load_module { my $module = $_[0]; my $file = eval { module_notional_filename($module) } or croak $@; use_package_optimistically($module); return 1 if $INC{$file}; my $error = $@ || "Can't locate $file"; # 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)||{}; return 1 if grep +(ref($_) || *$_{CODE}), values %$stash; return 1 if $INC{"Moose.pm"} && Class::MOP::class_of($module) or Mouse::Util->can('find_meta') && Mouse::Util::find_meta($module); croak $error; } our %MAYBE_LOADED; sub _maybe_load_module { my $module = $_[0]; return $MAYBE_LOADED{$module} if exists $MAYBE_LOADED{$module}; if(! eval { use_package_optimistically($module) }) { warn "$module exists but failed to load with error: $@"; } elsif ( $INC{module_notional_filename($module)} ) { return $MAYBE_LOADED{$module} = 1; } return $MAYBE_LOADED{$module} = 0; } sub _set_loaded { $INC{Module::Runtime::module_notional_filename($_[0])} ||= $_[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 _unimport_coderefs { my ($target, $info) = @_; return unless $info and my $exports = $info->{exports}; my %rev = reverse %$exports; my $stash = _getstash($target); foreach my $name (keys %$exports) { if ($stash->{$name} and defined(&{$stash->{$name}})) { if ($rev{$target->can($name)}) { 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{useithreads}) { require Moo::HandleMoose::_TypeMap; } 1; Moo-2.003004/lib/Moo/HandleMoose/0000755000000000000000000000000013210132311016274 5ustar00rootwheel00000000000000Moo-2.003004/lib/Moo/HandleMoose/_TypeMap.pm0000644000000000000000000000314613205055410020364 0ustar00rootwheel00000000000000package Moo::HandleMoose::_TypeMap; use Moo::_strictures; package Moo::HandleMoose; our %TYPE_MAP; package Moo::HandleMoose::_TypeMap; use Scalar::Util (); use Config; 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 } return $ref; } return $in; } sub TIEHASH { bless {}, $_[0] } sub STORE { my ($self, $key, $value) = @_; my $type = _str_to_ref($key); $WEAK_TYPES{$type} = $type; Scalar::Util::weaken($WEAK_TYPES{$type}) 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{useithreads}) { my @types = %TYPE_MAP; tie %TYPE_MAP, __PACKAGE__; %TYPE_MAP = @types; } 1; Moo-2.003004/lib/Moo/HandleMoose/FakeMetaClass.pm0000644000000000000000000000170413205055410021307 0ustar00rootwheel00000000000000package Moo::HandleMoose::FakeMetaClass; use Moo::_strictures; 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; require Moo::HandleMoose; Moo::HandleMoose::inject_real_metaclass_for($self->{name})->isa(@_) } sub make_immutable { $_[0] } 1; Moo-2.003004/lib/Moo/HandleMoose.pm0000644000000000000000000001725613205055410016655 0ustar00rootwheel00000000000000package Moo::HandleMoose; use Moo::_strictures; 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.003004/lib/Moo/Object.pm0000644000000000000000000000362513205055410015660 0ustar00rootwheel00000000000000package Moo::Object; use Moo::_strictures; 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.003004/lib/Moo/Role.pm0000644000000000000000000003434313210132116015347 0ustar00rootwheel00000000000000package Moo::Role; use Moo::_strictures; use Moo::_Utils qw( _getglob _getstash _install_coderef _install_modifier _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 ); } our $VERSION = '2.003004'; $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 _install_tracked { my ($target, $name, $code) = @_; $INFO{$target}{exports}{$name} = $code; _install_coderef "${target}::${name}" => "Moo::Role::${name}" => $code; } 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 _install_subs { my ($me, $target) = @_; _install_tracked $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) { my $spec_ref = @name_proto > 1 ? +{%spec} : \%spec; ($INFO{$target}{accessor_maker} ||= do { require Method::Generate::Accessor; Method::Generate::Accessor->new })->generate_method($target, $name, $spec_ref); push @{$INFO{$target}{attributes}||=[]}, $name, $spec_ref; $me->_maybe_reset_handlemoose($target); } }; # install before/after/around subs foreach my $type (qw(before after around)) { _install_tracked $target => $type => sub { push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ]; $me->_maybe_reset_handlemoose($target); }; } _install_tracked $target => requires => sub { push @{$INFO{$target}{requires}||=[]}, @_; $me->_maybe_reset_handlemoose($target); }; _install_tracked $target => with => sub { $me->apply_roles_to_package($target, @_); $me->_maybe_reset_handlemoose($target); }; *{_getglob("${target}::meta")} = $me->can('meta'); } 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, $INFO{$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 methods_provided_by { my ($self, $role) = @_; _load_module($role); $self->_inhale_if_moose($role); croak "${role} is not a Moo::Role" unless $self->is_role($role); return $self->SUPER::methods_provided_by($role); } 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 apply_roles_to_package { my ($me, $to, @roles) = @_; foreach my $role (@roles) { _load_module($role); $me->_inhale_if_moose($role); croak "${role} is not a Moo::Role" unless $me->is_role($role); } $me->SUPER::apply_roles_to_package($to, @roles); } sub apply_single_role_to_package { my ($me, $to, $role) = @_; _load_module($role); $me->_inhale_if_moose($role); croak "${role} is not a Moo::Role" unless $me->is_role($role); $me->SUPER::apply_single_role_to_package($to, $role); } sub create_class_with_roles { my ($me, $superclass, @roles) = @_; my ($new_name, $compose_name) = $me->_composite_name($superclass, @roles); return $new_name if $COMPOSED{class}{$new_name}; foreach my $role (@roles) { _load_module($role); $me->_inhale_if_moose($role); croak "${role} is not a Moo::Role" unless $me->is_role($role); } my $m; if ($INC{"Moo.pm"} and $m = Moo->_accessor_maker_for($superclass) and ref($m) ne 'Method::Generate::Accessor') { # old fashioned way time. @{*{_getglob("${new_name}::ISA")}{ARRAY}} = ($superclass); $Moo::MAKERS{$new_name} = {is_class => 1}; $me->apply_roles_to_package($new_name, @roles); } else { $me->SUPER::create_class_with_roles($superclass, @roles); $Moo::MAKERS{$new_name} = {is_class => 1}; $me->_handle_constructor($new_name, $_) for @roles; } if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) { Moo::HandleMoose::inject_fake_metaclass_for($new_name); } $COMPOSED{class}{$new_name} = 1; _set_loaded($new_name, (caller)[1]); return $new_name; } 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]); my $apply_defaults = exists $APPLY_DEFAULTS{$class} ? $APPLY_DEFAULTS{$class} : $APPLY_DEFAULTS{$class} = do { my %attrs = map { @{$INFO{$_}{attributes}||[]} } @roles; if ($INC{'Moo.pm'} and keys %attrs and my $con_gen = Moo->_constructor_maker_for($class) and my $m = Moo->_accessor_maker_for($class)) { my $specs = $con_gen->all_attribute_specs; my %captures; my $code = join('', ( map { my $name = $_; my $spec = $specs->{$name}; if ($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); "($set),"; } else { (); } } sort keys %attrs ), ); if ($code) { require Sub::Quote; Sub::Quote::quote_sub( "${class}::_apply_defaults", "no warnings 'void';\n$code", \%captures, { package => $class, no_install => 1, } ); } else { 0; } } else { 0; } }; if ($apply_defaults) { local $Carp::Internal{+__PACKAGE__} = 1; local $Carp::Internal{$class} = 1; $new->$apply_defaults; } return $new; } sub _composable_package_for { my ($self, $role) = @_; my $composed_name = 'Role::Tiny::_COMPOSABLE::'.$role; return $composed_name if $COMPOSED{role}{$composed_name}; $self->_make_accessors_if_moose($composed_name, $role); $self->SUPER::_composable_package_for($role); } 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. 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.003004/lib/Moo/sification.pm0000644000000000000000000000135313205055410016576 0ustar00rootwheel00000000000000package Moo::sification; use Moo::_strictures; no warnings 'once'; use Devel::GlobalDestruction qw(in_global_destruction); use Carp qw(croak); BEGIN { our @CARP_NOT = qw(Moo::HandleMoose) } 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.003004/lib/Moo.pm0000644000000000000000000010151113210132116014436 0ustar00rootwheel00000000000000package Moo; use Moo::_strictures; use Moo::_mro; use Moo::_Utils qw( _getglob _getstash _install_coderef _install_modifier _load_module _set_loaded _unimport_coderefs ); use Scalar::Util qw(reftype); use Carp qw(croak); BEGIN { our @CARP_NOT = qw( Method::Generate::Constructor Method::Generate::Accessor Moo::sification Moo::_Utils Moo::Role ); } our $VERSION = '2.003004'; $VERSION =~ tr/_//d; require Moo::sification; Moo::sification->import; our %MAKERS; sub _install_tracked { my ($target, $name, $code) = @_; $MAKERS{$target}{exports}{$name} = $code; _install_coderef "${target}::${name}" => "Moo::${name}" => $code; } sub import { my $target = caller; my $class = shift; _set_loaded(caller); strict->import; warnings->import; if ($INC{'Role/Tiny.pm'} and Role::Tiny->is_role($target)) { croak "Cannot import Moo into a role"; } $MAKERS{$target} ||= {}; _install_tracked $target => extends => sub { $class->_set_superclasses($target, @_); $class->_maybe_reset_handlemoose($target); return; }; _install_tracked $target => with => sub { require Moo::Role; Moo::Role->apply_roles_to_package($target, @_); $class->_maybe_reset_handlemoose($target); }; _install_tracked $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; $class->_constructor_maker_for($target) ->register_attribute_specs($name, $spec_ref); $class->_accessor_maker_for($target) ->generate_method($target, $name, $spec_ref); $class->_maybe_reset_handlemoose($target); } return; }; foreach my $type (qw(before after around)) { _install_tracked $target => $type => sub { _install_modifier($target, $type, @_); return; }; } return if $MAKERS{$target}{is_class}; # already exported into this package my $stash = _getstash($target); my @not_methods = map +( !ref($_) ? *$_{CODE}||() : reftype($_) eq 'CODE' ? $_ : () ), values %$stash; @{$MAKERS{$target}{not_methods}={}}{@not_methods} = @not_methods; $MAKERS{$target}{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); } } sub unimport { my $target = caller; _unimport_coderefs($target, $MAKERS{$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'"; } } # Can't do *{...} = \@_ or 5.10.0's mro.pm stops seeing @ISA @{*{_getglob("${target}::ISA")}{ARRAY}} = @_; 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 { if (my $m = do { require Sub::Defer; if (my $defer_target = (Sub::Defer::defer_info($target->can('new'))||[])->[0] ) { my ($pkg) = ($defer_target =~ /^(.*)::[^:]+$/); $MAKERS{$pkg} && $MAKERS{$pkg}{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 = @{mro::get_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}; # grab class symbol table my $stash = _getstash($class); # reverse so our keys become the values (captured coderefs) in case # they got copied or re-used since my $not_methods = { reverse %{$makers->{not_methods}||{}} }; +{ # grab all code entries that aren't in the not_methods list map {; no strict 'refs'; my $code = exists &{"${class}::$_"} ? \&{"${class}::$_"} : undef; ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code) } grep +(!ref($stash->{$_}) || reftype($stash->{$_}) eq 'CODE'), keys %$stash }; } 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. 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; If you were to import C after L you would be able to call C<< ->md5_hex() >> on your C instances (and it probably wouldn't do what you expect!). 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 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); 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. 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. 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-E$::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; 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 SUPPORT Users' IRC: #moose on irc.perl.org =for :html L<(click for instant chatroom login)|http://chat.mibbit.com/#moose@irc.perl.org> Development and contribution IRC: #web-simple on irc.perl.org =for :html L<(click for instant chatroom login)|http://chat.mibbit.com/#web-simple@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.003004/lib/oo.pm0000644000000000000000000000230213205055410014324 0ustar00rootwheel00000000000000package oo; use Moo::_strictures; use Moo::_Utils qw(_load_module); sub moo { print <<'EOMOO'; ______ < Moo! > ------ \ ^__^ \ (oo)\_______ (__)\ )\/\ ||----w | || || EOMOO exit 0; } BEGIN { my $package; sub import { moo() if $0 eq '-'; $package = $_[1] || 'Class'; if ($package =~ /^\+/) { $package =~ s/^\+//; _load_module($package); } } use Filter::Simple sub { s/^/package $package;\nuse Moo;\n/; } } 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.003004/maint/0000755000000000000000000000000013210132311013706 5ustar00rootwheel00000000000000Moo-2.003004/maint/Makefile.PL.include0000644000000000000000000000054013205053273017316 0ustar00rootwheel00000000000000BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/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.003004/Makefile.PL0000644000000000000000000001140413207533066014572 0ustar00rootwheel00000000000000use strict; use warnings FATAL => 'all'; use 5.006; my %META = ( name => 'Moo', license => 'perl_5', prereqs => { configure => { requires => { 'ExtUtils::MakeMaker' => 0, } }, build => { requires => { } }, test => { requires => { 'Test::More' => 0.94, 'Test::Fatal' => 0.003, }, recommends => { 'CPAN::Meta' => 0, 'CPAN::Meta::Requirements' => 0, }, }, runtime => { requires => { 'Class::Method::Modifiers' => 1.10, # for RT#80194 'Module::Runtime' => 0.014, # for RT#86394 'Role::Tiny' => 2.000004, 'Devel::GlobalDestruction' => 0.11, # for RT#78617 'Scalar::Util' => 0, 'perl' => 5.006, 'Exporter' => 5.57, # Import 'import' 'Sub::Quote' => 2.003001, 'Sub::Defer' => 2.003001, }, recommends => { 'Class::XSAccessor' => 1.18, 'Sub::Name' => 0.08, 'strictures' => 2, }, }, develop => { requires => { 'strictures' => 2, 'indirect' => 0, 'multidimensional' => 0, 'bareword::filehandles' => 0, 'Moose' => 0, 'Mouse' => 0, 'namespace::clean' => 0, 'namespace::autoclean' => 0, 'MooseX::Types::Common::Numeric' => 0, 'Type::Tiny' => 0, 'Class::Tiny' => 1.001, }, }, }, 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 => [ 'http://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', x_cpants => { ignore => { use_strict => 'internal module used to apply strict', use_warnings => 'internal module used to apply warnings', } }, ); my %MM_ARGS = ( PREREQ_PM => { ("$]" >= 5.008_000 ? () : ('Task::Weaken' => 0)), ("$]" >= 5.010_000 ? () : ('MRO::Compat' => 0)), }, ); { 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' ? "MOO_FATAL_WARNINGS" : ''; <<"POSTAMBLE"; MOO_TEST_ENV=$MOO_TEST_ENV fulltest: test test_no_xs test_no_xs: pure_all \t\$(NOECHO)\$(MAKE) test MOO_TEST_ENV="\$(MOO_TEST_ENV),MOO_XS_DISABLE" POSTAMBLE } } ## 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.003004/MANIFEST0000644000000000000000000000667513210132316013752 0ustar00rootwheel00000000000000Changes 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/_mro.pm lib/Moo/_strictures.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/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/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.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/perl-56-like.t t/strictures.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/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 META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) README README file (added by Distar) Moo-2.003004/META.json0000644000000000000000000000574613210132315014237 0ustar00rootwheel00000000000000{ "abstract" : "Minimalist Object Orientation (with Moose compatibility)", "author" : [ "mst - Matt S. Trout (cpan:MSTROUT) " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.3, 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" : "0", "MooseX::Types::Common::Numeric" : "0", "Mouse" : "0", "Type::Tiny" : "0", "bareword::filehandles" : "0", "indirect" : "0", "multidimensional" : "0", "namespace::autoclean" : "0", "namespace::clean" : "0", "strictures" : "2" } }, "runtime" : { "recommends" : { "Class::XSAccessor" : "1.18", "Sub::Name" : "0.08", "strictures" : "2" }, "requires" : { "Class::Method::Modifiers" : "1.1", "Devel::GlobalDestruction" : "0.11", "Exporter" : "5.57", "Module::Runtime" : "0.014", "Role::Tiny" : "2.000004", "Scalar::Util" : "0", "Sub::Defer" : "2.003001", "Sub::Quote" : "2.003001", "perl" : "5.006" } }, "test" : { "recommends" : { "CPAN::Meta" : "0", "CPAN::Meta::Requirements" : "0" }, "requires" : { "Test::Fatal" : "0.003", "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" : [ "http://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.003004", "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_cpants" : { "ignore" : { "use_strict" : "internal module used to apply strict", "use_warnings" : "internal module used to apply warnings" } }, "x_serialization_backend" : "JSON::PP version 2.94" } Moo-2.003004/META.yml0000644000000000000000000000272113210132313014053 0ustar00rootwheel00000000000000--- abstract: 'Minimalist Object Orientation (with Moose compatibility)' author: - 'mst - Matt S. Trout (cpan:MSTROUT) ' build_requires: Test::Fatal: '0.003' Test::More: '0.94' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.3, 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::Name: '0.08' strictures: '2' requires: Class::Method::Modifiers: '1.1' Devel::GlobalDestruction: '0.11' Exporter: '5.57' Module::Runtime: '0.014' Role::Tiny: '2.000004' Scalar::Util: '0' Sub::Defer: '2.003001' Sub::Quote: '2.003001' perl: '5.006' resources: IRC: irc://irc.perl.org/#moose bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Moo license: http://dev.perl.org/licenses/ repository: https://github.com/moose/Moo.git version: '2.003004' 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_cpants: ignore: use_strict: 'internal module used to apply strict' use_warnings: 'internal module used to apply warnings' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Moo-2.003004/README0000644000000000000000000006466113210132316013500 0ustar00rootwheel00000000000000NAME 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. 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; If you were to import "md5_hex" after namespace::clean you would be able to call "->md5_hex()" on your "Record" instances (and it probably wouldn't do what you expect!). 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 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); "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. 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. 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; 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. SUPPORT Users' IRC: #moose on irc.perl.org Development and contribution IRC: #web-simple 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.003004/t/0000755000000000000000000000000013210132311013041 5ustar00rootwheel00000000000000Moo-2.003004/t/accessor-coerce.t0000644000000000000000000000560213205055410016301 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/accessor-default.t0000644000000000000000000000603513205055410016466 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/accessor-generator-extension.t0000644000000000000000000000632713205055410021046 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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 mro::get_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.003004/t/accessor-handles.t0000644000000000000000000000521613205055410016460 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; use lib "t/lib"; { 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.003004/t/accessor-isa.t0000644000000000000000000001150713210126527015622 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/accessor-mixed.t0000644000000000000000000000315113205055410016144 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/accessor-pred-clear.t0000644000000000000000000000140313205055410017052 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/accessor-reader-writer.t0000644000000000000000000000267613205055410017625 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/accessor-roles.t0000644000000000000000000000327313205055410016167 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/accessor-shortcuts.t0000644000000000000000000000206113205055410017073 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/accessor-trigger.t0000644000000000000000000000441513205055410016505 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/accessor-weaken-pre-5_8_3.t0000644000000000000000000000036613205055410017714 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/accessor-weaken.t0000644000000000000000000000404013205055410016306 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Moo::_Utils (); 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'); 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.003004/t/buildall-subconstructor.t0000644000000000000000000000323613205055410020127 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/buildall.t0000644000000000000000000000354213205055410015032 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/buildargs-error.t0000644000000000000000000000057313205055410016346 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/t/buildargs.t0000644000000000000000000000631113205055410015213 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/coerce-1.t0000644000000000000000000000341513205055410014637 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/t/compose-conflicts.t0000644000000000000000000000726213205055410016674 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/compose-non-role.t0000644000000000000000000000037613205055410016440 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; $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.003004/t/compose-roles.t0000644000000000000000000001046213205055410016030 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/t/constructor-modify.t0000644000000000000000000000513313205055410017112 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/croak-locations.t0000644000000000000000000001303613205055410016331 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Carp qw(croak); no Moo::sification; use lib 't/lib'; 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 done_testing; Moo-2.003004/t/demolish-basics.t0000644000000000000000000000154313205055410016307 0ustar00rootwheel00000000000000 use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/demolish-bugs-eats_exceptions.t0000644000000000000000000000705613205055410021203 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/demolish-bugs-eats_mini.t0000644000000000000000000000241413205055410017747 0ustar00rootwheel00000000000000 use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/t/demolish-global_destruction.t0000644000000000000000000000105613205055410020725 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/demolish-throw.t0000644000000000000000000000206013205055410016201 0ustar00rootwheel00000000000000sub clean_die { use warnings; die @_; } use Moo::_strictures; use Test::More; use Test::Fatal; { 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]; clean_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.003004/t/does.t0000644000000000000000000000133513205055410014172 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/extend-constructor.t0000644000000000000000000000101313205055410017103 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/extends-non-moo.t0000644000000000000000000000317513205055410016276 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/t/extends-role.t0000644000000000000000000000034213205055410015646 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { package MyRole; use Moo::Role; } { package MyClass; use Moo; ::isnt ::exception { extends "MyRole"; }, undef, "Can't extend role"; } done_testing; Moo-2.003004/t/foreignbuildargs.t0000644000000000000000000000240113205055410016561 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/global-destruction-helper.pl0000644000000000000000000000036613205055410020471 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/global_underscore.t0000644000000000000000000000114313205055410016726 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use lib qw(t/lib); 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.003004/t/has-array.t0000644000000000000000000000212313205055410015123 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/has-before-extends.t0000644000000000000000000000055213205055410016723 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/has-plus.t0000644000000000000000000000313613205055410014775 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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'; done_testing; Moo-2.003004/t/init-arg.t0000644000000000000000000000364213205055410014755 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/t/isa-interfere.t0000644000000000000000000000210513205055410015771 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; use Moo (); BEGIN { package BaseClass; sub new { my $class = shift; my $self = bless {}, $class; return $self; } } BEGIN { package ExtraClass; sub new { my $class = shift; $class->next::method(@_); } } 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.003004/t/lazy_isa.t0000644000000000000000000000310513205055410015050 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/lib/0000755000000000000000000000000013210132311013607 5ustar00rootwheel00000000000000Moo-2.003004/t/lib/ErrorLocation.pm0000644000000000000000000000455413205055410016747 0ustar00rootwheel00000000000000package ErrorLocation; use Moo::_strictures; use Test::Builder; use Carp qw(croak); use Exporter 'import'; 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; Moo-2.003004/t/lib/InlineModule.pm0000644000000000000000000000172213205055410016543 0ustar00rootwheel00000000000000package InlineModule; use Moo::_strictures; 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.003004/t/lib/TestEnv.pm0000644000000000000000000000022013205055410015537 0ustar00rootwheel00000000000000package TestEnv; use strict; use warnings; sub import { $ENV{$_} = 1 for grep defined && length && !exists $ENV{$_}, @_[1 .. $#_]; } 1; Moo-2.003004/t/load_module.t0000644000000000000000000000060113205055410015517 0ustar00rootwheel00000000000000# this test is replicated to t/load_module_role_tiny.t for Role::Tiny use Moo::_strictures; use Test::More; use lib 't/lib'; use Moo::_Utils qw(_load_module); use InlineModule ( 'Foo::Bar' => q{ package Foo::Bar; sub baz { 1 } 1; }, ); { package Foo::Bar::Baz; sub quux { } } _load_module("Foo::Bar"); ok(eval { Foo::Bar->baz }, 'Loaded module ok'); done_testing; Moo-2.003004/t/load_module_error.t0000644000000000000000000000076513205055410016743 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; use lib 't/lib'; 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.003004/t/load_module_role_tiny.t0000644000000000000000000000056513205055410017614 0ustar00rootwheel00000000000000# this test is replicated to t/load_module.t for Moo::_Utils use Moo::_strictures; use Test::More; use lib 't/lib'; use Role::Tiny (); use InlineModule ( 'Foo::Bar' => q{ package Foo::Bar; sub baz { 1 } 1; }, ); { package Foo::Bar::Baz; sub quux { } } Role::Tiny::_load_module("Foo::Bar"); ok(eval { Foo::Bar->baz }, 'Loaded module ok'); done_testing; Moo-2.003004/t/long-package-name.t0000644000000000000000000000161013205055410016502 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/t/method-generate-accessor.t0000644000000000000000000001330413205055410020107 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; use Method::Generate::Accessor; use Sub::Quote 'quote_sub'; use Sub::Defer (); my $gen = Method::Generate::Accessor->new; { package Foo; use Moo; } { 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.003004/t/method-generate-constructor.t0000644000000000000000000000357613205055410020704 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/modify_lazy_handlers.t0000644000000000000000000000162013205055410017443 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/moo-accessors.t0000644000000000000000000000173613205055410016022 0ustar00rootwheel00000000000000use Moo::_strictures; 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 unless caller; Moo-2.003004/t/moo-c3.t0000644000000000000000000000136413205055410014337 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/moo-object.t0000644000000000000000000000313213205055410015273 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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 = 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.003004/t/moo-utils-_name_coderef.t0000644000000000000000000000107413205055410017734 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/moo-utils-_subname.t0000644000000000000000000000043413205055410016756 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/moo-utils.t0000644000000000000000000000475013207533066015206 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; use Moo::_Utils; use lib 't/lib'; 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.003004/t/moo.t0000644000000000000000000000267413205055410014041 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/t/mutual-requires.t0000644000000000000000000000147413205055410016410 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/no-build.t0000644000000000000000000000262713205055410014756 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Moo::_mro; 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} } @{mro::get_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.003004/t/no-moo.t0000644000000000000000000000340613205055410014445 0ustar00rootwheel00000000000000use Moo::_strictures; 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'); done_testing; Moo-2.003004/t/non-moo-extends-c3.t0000644000000000000000000000173613205055410016602 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Moo (); use Moo::_mro; { 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.003004/t/non-moo-extends.t0000644000000000000000000000323613205055410016274 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/not-both.t0000644000000000000000000000142213205055410014767 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/not-methods.t0000644000000000000000000000212713205055410015501 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; BEGIN { package FooClass; sub early { 1 } use Moo; sub late { 2 } } BEGIN { is_deeply [sort keys %{Moo->_concrete_methods_of('FooClass')}], [qw(late)], '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'; } done_testing; Moo-2.003004/t/overloaded-coderefs.t0000644000000000000000000000374213205055410017160 0ustar00rootwheel00000000000000use Moo::_strictures; 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( Scalar::Util::refaddr($luke), Scalar::Util::refaddr( Moo->_constructor_maker_for("Doubleena")->all_attribute_specs->{"b"}{"isa"} ), '$spec->{isa} reference is not mutated', ); is( Scalar::Util::refaddr($theforce), Scalar::Util::refaddr( Moo->_constructor_maker_for("Doubleena")->all_attribute_specs->{"b"}{"coerce"} ), '$spec->{coerce} reference is not mutated', ); done_testing; Moo-2.003004/t/overridden-core-funcs.t0000644000000000000000000000362413205055410017446 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/t/perl-56-like.t0000644000000000000000000000050513205055410015352 0ustar00rootwheel00000000000000use B (); BEGIN { delete $B::{perlstring} }; use Moo::_strictures; use Test::More; use Test::Fatal; { package MyClass; use Moo; my $string = join('', "\x00" .. "\x7F"); has foo => (is => 'ro', default => $string); ::is +__PACKAGE__->new->foo, $string, "can quote arbitrary strings 5.6 style"; } done_testing; Moo-2.003004/t/strictures.t0000644000000000000000000000147313205055410015452 0ustar00rootwheel00000000000000BEGIN { delete $ENV{MOO_FATAL_WARNINGS} } use strict; use warnings; use Test::More; $INC{'strictures.pm'} = __FILE__; my $strictures = 0; my $version; sub strictures::VERSION { $version = $_[1]; 2;; } sub strictures::import { $strictures++; strict->import; warnings->import(FATAL => 'all'); } local $SIG{__WARN__} = sub {}; eval q{ use Moo::_strictures; 0 + "string"; }; is $strictures, 0, 'strictures not imported without MOO_FATAL_WARNINGS'; is $@, '', 'warnings not fatal without MOO_FATAL_WARNINGS'; $ENV{MOO_FATAL_WARNINGS} = 1; eval q{ use Moo::_strictures; 0 + "string"; }; is $strictures, 1, 'strictures imported with MOO_FATAL_WARNINGS'; is $version, 2, 'strictures version 2 requested with MOO_FATAL_WARNINGS'; like $@, qr/isn't numeric/, 'warnings fatal with MOO_FATAL_WARNINGS'; done_testing; Moo-2.003004/t/sub-and-handles.t0000644000000000000000000000322013205055410016200 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/subconstructor.t0000644000000000000000000000032013205055410016330 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/undef-bug.t0000644000000000000000000000027713171145661015132 0ustar00rootwheel00000000000000use Test::More tests => 1; 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"; Moo-2.003004/t/use-after-no.t0000644000000000000000000000076613205055410015554 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/t/zzz-check-breaks.t0000644000000000000000000000266013205055410016417 0ustar00rootwheel00000000000000use strict; use warnings; use Test::More; my $meta_file; BEGIN { eval { require CPAN::Meta } or plan skip_all => 'CPAN::Meta required for checking breakages'; eval { require CPAN::Meta::Requirements } or plan skip_all => 'CPAN::Meta::Requirements 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; use Module::Runtime qw(module_notional_filename); my $meta = CPAN::Meta->load_file($meta_file)->as_struct; my $req = CPAN::Meta::Requirements->from_string_hash( $meta->{x_breaks} ); pass 'checking breakages...'; my @breaks; for my $module ($req->required_modules) { my ($pm_file) = grep -e, map $_.'/'.module_notional_filename($module), @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 = $req->requirements_for_module($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.003004/xt/0000755000000000000000000000000013210132311013231 5ustar00rootwheel00000000000000Moo-2.003004/xt/bless-override.t0000644000000000000000000000053413205055410016355 0ustar00rootwheel00000000000000use Moo::_strictures; BEGIN { *CORE::GLOBAL::bless = sub { my $obj = CORE::bless( $_[0], (@_ > 1) ? $_[1] : CORE::caller() ); $obj->isa("Foo"); $obj; }; } use Test::More; use Test::Fatal; use Moose (); is exception { package SomeClass; use Moo; }, undef, "isa call in bless override doesn't break Moo+Moose"; done_testing; Moo-2.003004/xt/class-tiny.t0000644000000000000000000000060413205055410015514 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/croak-locations.t0000644000000000000000000000162513205055410016522 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/fakemetaclass.t0000644000000000000000000000154513205055410016236 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/xt/global-destruct-jenga-helper.pl0000644000000000000000000000034613205055410021233 0ustar00rootwheel00000000000000use Moo::_strictures; { 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.003004/xt/global-destruct-jenga.t0000644000000000000000000000076613205055410017614 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/handle_moose.t0000644000000000000000000000426613205055410016073 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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(looks_like_number); use Moo; my $meta = Class::MOP::get_metaclass_by_name(__PACKAGE__); ::ok(!$meta->has_method('looks_like_number'), '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.003004/xt/has-after-meta.t0000644000000000000000000000111613205055410016223 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/xt/implicit-moose-types.t0000644000000000000000000000116613205055410017526 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/inflate-our-classes.t0000644000000000000000000000110113205055410017277 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; use Moo::HandleMoose; use Module::Runtime qw(use_module); 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 { Moo::HandleMoose::inject_real_metaclass_for(use_module($class)) }, undef, "No exceptions inflating $class"; ok !@warnings, "No warnings inflating $class" or diag "Got warnings: @warnings"; } done_testing; Moo-2.003004/xt/inflate-undefer.t0000644000000000000000000000062313205055410016477 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/jenga.t0000644000000000000000000000136713205055410014521 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/moo-attr-handles-moose-role.t0000644000000000000000000000076213205055410020670 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/moo-consume-moose-role-coerce.t0000644000000000000000000000075013205055410021206 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/moo-consume-moose-role-multiple.t0000644000000000000000000000071213205055410021577 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/moo-consume-mouse-role-coerce.t0000644000000000000000000000106413205055410021213 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/moo-does-moose-role.t0000644000000000000000000000754313205055410017240 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/xt/moo-does-mouse-role.t0000644000000000000000000000254113205055410017237 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More "$]" < 5.008009 ? (skip_all => 'Mouse is broken on perl <= 5.8.8') : (); use Test::Fatal; 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.003004/xt/moo-extend-moose.t0000644000000000000000000000143113205055410016624 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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'); done_testing; Moo-2.003004/xt/moo-inflate.t0000644000000000000000000000062213205055410015640 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/xt/moo-object-meta-can.t0000644000000000000000000000257513205055410017160 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/xt/moo-role-types.t0000644000000000000000000000275713205055410016334 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/xt/moo-roles-into-moose-class-attr-override-with-autoclean.t0000644000000000000000000000127313205055410026246 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use lib "t/lib"; use InlineModule ( MooRoleWithAttrWithAutoclean => q{ package MooRoleWithAttrWithAutoclean; use Moo::Role; # Note that autoclean here is the key bit! # It 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 use namespace::autoclean; 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.003004/xt/moo-roles-into-moose-class.t0000644000000000000000000000266113205055410020541 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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; no Moose; ::ok(!__PACKAGE__->can('has'), 'No has function after no Moose;'); Moose::with('Baz', 'Bar'); } ::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.003004/xt/moo-sification-handlemoose.t0000644000000000000000000000054113205055410020642 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/xt/moo-sification-meta.t0000644000000000000000000000226413205055410017276 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/xt/moo-sification.t0000644000000000000000000000042313205055410016345 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/moose-accessor-isa.t0000644000000000000000000000270713205055410017130 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/xt/moose-autoclean-lazy-attr-builders.t0000644000000000000000000000107513205055410022260 0ustar00rootwheel00000000000000use Moo::_strictures; # 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 use namespace::autoclean; has attr => ( is => 'lazy' ); sub _build_attr {2} } use Test::More; # 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.003004/xt/moose-consume-moo-role-after-consumed-by-moo.t0000644000000000000000000000064513205055410024065 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/moose-consume-moo-role-no-moo-loaded.t0000644000000000000000000000026413205055410022400 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; { package ExampleRole; use Moo::Role; } { package ExampleClass; use Moose; with 'ExampleRole'; } ok 1; done_testing; Moo-2.003004/xt/moose-does-moo-role.t0000644000000000000000000000304113205055410017225 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/xt/moose-extend-moo.t0000644000000000000000000000326413205055410016632 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/xt/moose-handles-moo-class.t0000644000000000000000000000047413205055410020064 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/xt/moose-inflate-error-recurse.t0000644000000000000000000000213413205055410020765 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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' ]); } like( exception { WTF::Class->meta->get_attribute('ftw'); }, qr/Attribute \(wtf\) is required/, 'reasonable error rather than deep recursion for inflating invalid attr (traits)', ); done_testing; Moo-2.003004/xt/moose-lazy.t0000644000000000000000000000311213205055410015522 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/moose-method-modifiers.t0000644000000000000000000000225413205055410020010 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/moose-override-attribute-from-moo-role.t0000644000000000000000000000103613205055410023056 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/xt/moose-override-attribute-with-plus-syntax.t0000644000000000000000000000200613205055410023642 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; { 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.003004/xt/more-jenga.t0000644000000000000000000000101313205055410015445 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/release/0000755000000000000000000000000013210132311014651 5ustar00rootwheel00000000000000Moo-2.003004/xt/release/kwalitee.t0000644000000000000000000000074613205055410016662 0ustar00rootwheel00000000000000use 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.003004/xt/role-tiny-inflate.t0000644000000000000000000000134613205055410016774 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/super-jenga.t0000644000000000000000000000201013205055410015637 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/test-my-dependents.t0000644000000000000000000002356113205055410017166 0ustar00rootwheel00000000000000use 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 ); use JSON::PP; use HTTP::Tiny; use List::Util (); 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 =~ /^\d+$/) { $count = $env; } else { @pick = split /,/, $env; s/^\s+//, s/\s+$// for @pick; } } # avoid any modules that depend on these my @bad_prereqs = qw(Gtk2 Padre Wx); my $res = decode_json(HTTP::Tiny->new->post( 'http://api.metacpan.org/v0/search/reverse_dependencies/Moo', { content => encode_json({ query => { filtered => { query => { "match_all" => {} }, filter => { and => [ { term => { 'release.status' => 'latest' } }, { term => { 'release.authorized' => \1 } }, { not => { filter => { or => [ map { { term => { 'dependency.module' => $_ } } } @bad_prereqs, ], } } } ], }, }, }, size => 5000, fields => ['distribution', 'provides', 'metadata.provides'], }) }, )->{content}); 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 %dists; my @modules; for my $hit (@{ $res->{hits}{hits} }) { my $dist = $hit->{fields}{distribution}; my $module = (sort { length $a <=> length $b || $a cmp $b } do { if (my $provides = $hit->{fields}{provides}) { ref $provides ? @$provides : ($provides); } elsif (my $provides = $hit->{fields}{'metadata.provides'}) { keys %$provides; } else { (my $module = $dist) =~ s/-/::/g; ($module); } })[0]; $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"; } $dists{$module} = $dist; push @modules, $module; $module; } @modules = sort @modules; if ( $moox ) { @modules = grep /^MooX(?:$|::)/, @modules; } elsif ( $count ) { $count = $count == 1 ? 200 : $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_modules{$_} } 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_modules{@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$dists{$module}-//; print { $skip_report } "$dists{$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.003004/xt/type-inflate-coercion.t0000644000000000000000000000265213205055410017633 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; use Test::Fatal; 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.003004/xt/type-inflate-threads.t0000644000000000000000000000260413205055410017461 0ustar00rootwheel00000000000000use Config; BEGIN { unless ($Config{useithreads}) { print "1..0 # SKIP your perl does not support ithreads\n"; exit 0; } } use threads; use Moo::_strictures; use Test::More; use Type::Tiny; 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" }, ); 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'); done_testing; Moo-2.003004/xt/type-inflate-type-tiny.t0000644000000000000000000000130413205055410017765 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/type-inflate.t0000644000000000000000000000351513205055410016033 0ustar00rootwheel00000000000000use Moo::_strictures; use Test::More; { package TypeOMatic; use Moo::Role; use Sub::Quote; use Moo::HandleMoose (); sub Str { my $type = sub { die unless defined $_[0] && !ref $_[0]; }; $Moo::HandleMoose::TYPE_MAP{$type} = sub { require Moose::Util::TypeConstraints; Moose::Util::TypeConstraints::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 { require Moose::Util::TypeConstraints; require MooseX::Types::Common::Numeric; Moose::Util::TypeConstraints::find_type_constraint( "MooseX::Types::Common::Numeric::PositiveInt"); }; return ($type, @_); } 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, 'MooseX::Types::Common::Numeric::PositiveInt', 'External (MooseX::Types type) 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.003004/xt/type-tiny-coerce.t0000644000000000000000000000053113205055410016625 0ustar00rootwheel00000000000000use Moo::_strictures; 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.003004/xt/withautoclean.t0000644000000000000000000000151613205055410016300 0ustar00rootwheel00000000000000use Moo::_strictures; use lib "t/lib"; use Test::More; use InlineModule ( 'withautoclean::Class' => q{ package withautoclean::Class; use Moo; with 'withautoclean::Role'; before _clear_ctx => sub {}; 1; }, 'withautoclean::Role' => q{ package withautoclean::Role; use Moo::Role; # Doing this (or loading a class which is built with Moose) # and then loading autoclean - everything breaks... use Moose (); use namespace::autoclean; # Wouldn't happen normally, but is likely to as you part-port something. has _ctx => ( is => 'ro', default => sub { }, clearer => '_clear_ctx', ); 1; }, ); use_ok 'withautoclean::Class'; my $o = withautoclean::Class->new(_ctx => 1); $o->_clear_ctx; is $o->_ctx, undef, 'modified method works'; done_testing;