--- /dev/null
+blib*
+pm_to_blib*
+
+Makefile
+Makefile.old
+Build
+_build*
+
+*.tar.gz
+autovivification-*
+
+core.*
+*.[co]
+*.so
+*.bs
+*.out
+*.def
+*.exp
+
+cover_db
+*.gcda
+*.gcov
+*.gcno
+
+Debian_CPANTS.txt
--- /dev/null
+Revision history for autovivification
+
+0.01
+ First version, released on an unsuspecting world.
+
--- /dev/null
+Changes
+MANIFEST
+META.yml
+Makefile.PL
+README
+autovivification.xs
+lib/autovivification.pm
+ptable.h
+samples/hash2array.pl
+t/00-load.t
+t/20-hash.t
+t/21-array.t
+t/30-scope.t
+t/91-pod.t
+t/92-pod-coverage.t
+t/95-portability-files.t
+t/99-kwalitee.t
--- /dev/null
+--- #YAML:1.0
+name: autovivification
+version: 0.01
+abstract: ~
+author:
+ - Vincent Pit <perl@profvince.com>
+license: perl
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+ Test::More: 0
+requires:
+ perl: 5.008
+ XSLoader: 0
+resources:
+ bugtracker: http://rt.cpan.org/NoAuth/ReportBug.html?Queue=autovivification
+ homepage: http://search.cpan.org/dist/autovivification/
+ license: http://dev.perl.org/licenses/
+ repository: http://git.profvince.com/?p=perl%2Fmodules%2Fautovivification.git
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.52
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
--- /dev/null
+use 5.008;
+
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+my @DEFINES;
+
+# Threads, Windows and 5.8.x don't seem to be best friends
+if ($^O eq 'MSWin32' && $^V lt v5.9.0) {
+ push @DEFINES, '-DI_MULTIPLICITY=0';
+}
+
+@DEFINES = (DEFINE => join ' ', @DEFINES) if @DEFINES;
+
+my $dist = 'autovivification';
+
+my %META = (
+ configure_requires => {
+ 'ExtUtils::MakeMaker' => 0,
+ },
+ build_requires => {
+ 'ExtUtils::MakeMaker' => 0,
+ 'Test::More' => 0,
+ },
+ resources => {
+ bugtracker => "http://rt.cpan.org/NoAuth/ReportBug.html?Queue=$dist",
+ homepage => "http://search.cpan.org/dist/$dist/",
+ license => 'http://dev.perl.org/licenses/',
+ repository => "http://git.profvince.com/?p=perl%2Fmodules%2F$dist.git",
+ },
+);
+
+WriteMakefile(
+ NAME => 'autovivification',
+ AUTHOR => 'Vincent Pit <perl@profvince.com>',
+ LICENSE => 'perl',
+ VERSION_FROM => 'lib/autovivification.pm',
+ ABSTRACT_FROM => 'lib/autovivification.pm',
+ PL_FILES => {},
+ @DEFINES,
+ PREREQ_PM => {
+ 'XSLoader' => 0,
+ },
+ MIN_PERL_VERSION => 5.008,
+ META_MERGE => \%META,
+ dist => {
+ PREOP => 'pod2text lib/autovivification.pm > $(DISTVNAME)/README',
+ COMPRESS => 'gzip -9f', SUFFIX => 'gz'
+ },
+ clean => {
+ FILES => "$dist-* *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt"
+ },
+);
--- /dev/null
+NAME
+ autovivification - Lexically disable autovivification.
+
+VERSION
+ Version 0.01
+
+SYNOPSIS
+ no autovivification;
+ my $x;
+ $x->{foo} = 1; # croaks
+
+DESCRIPTION
+METHODS
+ "unimport"
+ Magically called when "no autovivification" is encountered. Turns the
+ module on.
+
+ "import"
+ Magically called when "use autovivification" is encountered. Turns the
+ module off.
+
+DEPENDENCIES
+ perl 5.8.
+
+ XSLoader (standard since perl 5.006).
+
+AUTHOR
+ Vincent Pit, "<perl at profvince.com>", <http://www.profvince.com>.
+
+ You can contact me by mail or on "irc.perl.org" (vincent).
+
+BUGS
+ Please report any bugs or feature requests to "bug-autovivification at
+ rt.cpan.org", or through the web interface at
+ <http://rt.cpan.org/NoAuth/ReportBug.html?Queue=autovivification>. I
+ will be notified, and then you'll automatically be notified of progress
+ on your bug as I make changes.
+
+SUPPORT
+ You can find documentation for this module with the perldoc command.
+
+ perldoc autovivification
+
+ Tests code coverage report is available at
+ <http://www.profvince.com/perl/cover/autovivification>.
+
+COPYRIGHT & LICENSE
+ Copyright 2009 Vincent Pit, all rights reserved.
+
+ This program is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
--- /dev/null
+/* This file is part of the autovivification Perl module.
+ * See http://search.cpan.org/dist/autovivification/ */
+
+#define PERL_NO_GET_CONTEXT
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define __PACKAGE__ "autovivification"
+#define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1)
+
+/* --- Compatibility wrappers ---------------------------------------------- */
+
+#define A_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
+
+#ifndef A_WORKAROUND_REQUIRE_PROPAGATION
+# define A_WORKAROUND_REQUIRE_PROPAGATION !A_HAS_PERL(5, 10, 1)
+#endif
+
+/* --- Helpers ------------------------------------------------------------- */
+
+#if A_WORKAROUND_REQUIRE_PROPAGATION
+
+typedef struct {
+ UV bits;
+ I32 requires;
+} a_hint_t;
+
+STATIC SV *a_tag(pTHX_ UV bits) {
+#define a_tag(B) a_tag(aTHX_ (B))
+ SV *tag;
+ a_hint_t h;
+
+ h.bits = bits;
+
+ {
+ const PERL_SI *si;
+ I32 requires = 0;
+
+ for (si = PL_curstackinfo; si; si = si->si_prev) {
+ I32 cxix;
+
+ for (cxix = si->si_cxix; cxix >= 0; --cxix) {
+ const PERL_CONTEXT *cx = si->si_cxstack + cxix;
+
+ if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE)
+ ++requires;
+ }
+ }
+
+ h.requires = requires;
+ }
+
+ return newSVpvn((const char *) &h, sizeof h);
+}
+
+STATIC UV a_detag(pTHX_ const SV *hint) {
+#define a_detag(H) a_detag(aTHX_ (H))
+ const a_hint_t *h;
+
+ if (!(hint && SvOK(hint)))
+ return 0;
+
+ h = (const a_hint_t *) SvPVX(hint);
+
+ {
+ const PERL_SI *si;
+ I32 requires = 0;
+
+ for (si = PL_curstackinfo; si; si = si->si_prev) {
+ I32 cxix;
+
+ for (cxix = si->si_cxix; cxix >= 0; --cxix) {
+ const PERL_CONTEXT *cx = si->si_cxstack + cxix;
+
+ if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE
+ && ++requires > h->requires)
+ return 0;
+ }
+ }
+ }
+
+ return h->bits;
+}
+
+#else /* A_WORKAROUND_REQUIRE_PROPAGATION */
+
+#define a_tag(B) newSVuv(B)
+#define a_detag(H) (((H) && SvOK(H)) ? SvUVX(H) : 0)
+
+#endif /* !A_WORKAROUND_REQUIRE_PROPAGATION */
+
+/* Used both for hints and op flags */
+#define A_HINT_STRICT 1
+#define A_HINT_WARN 2
+#define A_HINT_FETCH 4
+#define A_HINT_STORE 8
+#define A_HINT_EXISTS 16
+#define A_HINT_DELETE 32
+#define A_HINT_NOTIFY (A_HINT_STRICT|A_HINT_WARN)
+#define A_HINT_DO (A_HINT_FETCH|A_HINT_STORE|A_HINT_EXISTS|A_HINT_DELETE)
+#define A_HINT_MASK (A_HINT_NOTIFY|A_HINT_DO)
+
+/* Only used in op flags */
+#define A_HINT_DEREF 64
+
+STATIC U32 a_hash = 0;
+
+STATIC UV a_hint(pTHX) {
+#define a_hint() a_hint(aTHX)
+ const SV *hint;
+#if A_HAS_PERL(5, 9, 5)
+ hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
+ NULL,
+ __PACKAGE__, __PACKAGE_LEN__,
+ 0,
+ a_hash);
+#else
+ SV **val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__, a_hash);
+ if (!val)
+ return 0;
+ hint = *val;
+#endif
+ return a_detag(hint);
+}
+
+/* ... op => info map ...................................................... */
+
+typedef struct {
+ OP *(*old_pp)(pTHX);
+ const OP *root;
+ UV flags;
+} a_op_info;
+
+#define PTABLE_NAME ptable_map
+#define PTABLE_VAL_FREE(V) PerlMemShared_free(V)
+
+#include "ptable.h"
+
+/* PerlMemShared_free() needs the [ap]PTBLMS_? default values */
+#define ptable_map_store(T, K, V) ptable_map_store(aPTBLMS_ (T), (K), (V))
+
+STATIC ptable *a_op_map = NULL;
+
+#ifdef USE_ITHREADS
+STATIC perl_mutex a_op_map_mutex;
+#endif
+
+STATIC void a_map_store(pPTBLMS_ const OP *o, OP *(*old_pp)(pTHX), UV flags) {
+#define a_map_store(O, PP, F) a_map_store(aPTBLMS_ (O), (PP), (F))
+ a_op_info *oi;
+
+#ifdef USE_ITHREADS
+ MUTEX_LOCK(&a_op_map_mutex);
+#endif
+
+ if (!(oi = ptable_fetch(a_op_map, o))) {
+ oi = PerlMemShared_malloc(sizeof *oi);
+ ptable_map_store(a_op_map, o, oi);
+ }
+
+ oi->old_pp = old_pp;
+ oi->root = NULL;
+ oi->flags = flags;
+
+#ifdef USE_ITHREADS
+ MUTEX_UNLOCK(&a_op_map_mutex);
+#endif
+}
+
+STATIC const a_op_info *a_map_fetch(const OP *o, a_op_info *oi) {
+ const a_op_info *val;
+
+#ifdef USE_ITHREADS
+ MUTEX_LOCK(&a_op_map_mutex);
+#endif
+
+ val = ptable_fetch(a_op_map, o);
+ if (val) {
+ *oi = *val;
+ val = oi;
+ } else
+ oi->old_pp = 0;
+
+#ifdef USE_ITHREADS
+ MUTEX_UNLOCK(&a_op_map_mutex);
+#endif
+
+ return val;
+}
+
+STATIC void a_map_set_root(const OP *root, UV flags) {
+ a_op_info *oi;
+ const OP *o = root;
+
+#ifdef USE_ITHREADS
+ MUTEX_LOCK(&a_op_map_mutex);
+#endif
+
+ while (o) {
+ if (oi = ptable_fetch(a_op_map, o)) {
+ oi->root = root;
+ oi->flags = flags;
+ }
+ if (!(o->op_flags & OPf_KIDS))
+ break;
+ o = cUNOPo->op_first;
+ }
+
+#ifdef USE_ITHREADS
+ MUTEX_UNLOCK(&a_op_map_mutex);
+#endif
+}
+
+/* ... Lightweight pp_defined() ............................................ */
+
+STATIC bool a_defined(pTHX_ SV *sv) {
+#define a_defined(S) a_defined(aTHX_ (S))
+ bool defined = FALSE;
+
+ switch (SvTYPE(sv)) {
+ case SVt_PVAV:
+ if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)
+ || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
+ defined = TRUE;
+ break;
+ case SVt_PVHV:
+ if (HvARRAY(sv) || SvGMAGICAL(sv)
+ || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
+ defined = TRUE;
+ break;
+ default:
+ defined = SvOK(sv);
+ }
+
+ return defined;
+}
+
+/* --- PP functions -------------------------------------------------------- */
+
+/* ... pp_rv2av ............................................................ */
+
+STATIC OP *a_pp_rv2av(pTHX) {
+ a_op_info oi;
+ UV hint;
+ dSP;
+
+ if (!SvOK(TOPs)) {
+ SV *av;
+ POPs;
+ av = sv_2mortal((SV *) newAV());
+ PUSHs(av);
+ RETURN;
+ }
+
+ a_map_fetch(PL_op, &oi);
+
+ return CALL_FPTR(oi.old_pp)(aTHX);
+}
+
+/* ... pp_rv2hv ............................................................ */
+
+STATIC OP *a_pp_rv2hv(pTHX) {
+ a_op_info oi;
+ UV hint;
+ dSP;
+
+ if (!SvOK(TOPs))
+ RETURN;
+
+ a_map_fetch(PL_op, &oi);
+
+ return CALL_FPTR(oi.old_pp)(aTHX);
+}
+
+/* ... pp_deref (aelem,helem,rv2sv,padsv) .................................. */
+
+STATIC const char a_msg_forbidden[] = "Reference vivification forbidden";
+STATIC const char a_msg_impossible[] = "Can't vivify reference";
+
+STATIC OP *a_pp_deref(pTHX) {
+ a_op_info oi;
+ UV flags;
+ dSP;
+
+ a_map_fetch(PL_op, &oi);
+ flags = oi.flags;
+
+ if (flags & A_HINT_DEREF) {
+ OP *o;
+ U8 old_private;
+
+deref:
+ old_private = PL_op->op_private;
+ PL_op->op_private &= ~OPpDEREF;
+ PL_op->op_private |= OPpLVAL_DEFER;
+ o = CALL_FPTR(oi.old_pp)(aTHX);
+ PL_op->op_private = old_private;
+
+ if (flags & (A_HINT_NOTIFY|A_HINT_STORE)) {
+ SPAGAIN;
+ if (!SvOK(TOPs)) {
+ if (flags & A_HINT_STRICT)
+ croak(a_msg_forbidden);
+ else if (flags & A_HINT_WARN)
+ warn(a_msg_forbidden);
+ else /* A_HINT_STORE */
+ croak(a_msg_impossible);
+ }
+ }
+
+ return o;
+ } else if (flags && (PL_op->op_private & OPpDEREF || PL_op == oi.root)) {
+ oi.flags = flags & A_HINT_NOTIFY;
+
+ if (oi.root->op_flags & OPf_MOD) {
+ if (flags & A_HINT_STORE)
+ oi.flags |= (A_HINT_STORE|A_HINT_DEREF);
+ } else if (flags & A_HINT_FETCH)
+ oi.flags |= (A_HINT_FETCH|A_HINT_DEREF);
+
+ if (PL_op == oi.root)
+ oi.flags &= ~A_HINT_DEREF;
+
+ /* We will need the updated flags value in the deref part */
+ flags = oi.flags;
+
+ if (flags & A_HINT_DEREF)
+ goto deref;
+
+ /* This op doesn't need to skip autovivification, so restore the original
+ * state. Be aware that another extension might have saved a_pp_deref as the
+ * ppaddr for this op, so restoring PL_op->op_ppaddr doesn't ensure that this
+ * function will never be called again. That's why we don't remove the op info
+ * from our map and we reset oi.flags to 0, so that it can still run correctly
+ * if required. */
+ oi.flags = 0;
+ PL_op->op_ppaddr = oi.old_pp;
+ }
+
+ return CALL_FPTR(oi.old_pp)(aTHX);
+}
+
+/* ... pp_root (exists,delete) ............................................. */
+
+STATIC OP *a_pp_root(pTHX) {
+ a_op_info oi;
+ dSP;
+
+ if (!a_defined(TOPm1s)) {
+ POPs;
+ POPs;
+ if (PL_op->op_type == OP_EXISTS)
+ RETPUSHNO;
+ else
+ RETPUSHUNDEF;
+ }
+
+ a_map_fetch(PL_op, &oi);
+
+ return CALL_FPTR(oi.old_pp)(aTHX);
+}
+
+/* --- Check functions ----------------------------------------------------- */
+
+/* ... ck_pad{any,sv} ...................................................... */
+
+/* Sadly, the PADSV OPs we are interested in don't trigger the padsv check
+ * function, but are instead manually mutated from a PADANY. This is why we set
+ * PL_ppaddr[OP_PADSV] in the padany check function so that PADSV OPs will have
+ * their op_ppaddr set to our pp_padsv. PL_ppaddr[OP_PADSV] is then reset at the
+ * beginning of every ck_pad{any,sv}. Some unwanted OPs can still call our
+ * pp_padsv, but much less than if we would have set PL_ppaddr[OP_PADSV]
+ * globally. */
+
+STATIC OP *(*a_pp_padsv_saved)(pTHX) = 0;
+
+STATIC void a_pp_padsv_save(void) {
+ if (a_pp_padsv_saved)
+ return;
+
+ a_pp_padsv_saved = PL_ppaddr[OP_PADSV];
+ PL_ppaddr[OP_PADSV] = a_pp_deref;
+}
+
+STATIC void a_pp_padsv_restore(OP *o) {
+ if (!a_pp_padsv_saved)
+ return;
+
+ if (o->op_ppaddr == a_pp_deref)
+ o->op_ppaddr = a_pp_padsv_saved;
+
+ PL_ppaddr[OP_PADSV] = a_pp_padsv_saved;
+ a_pp_padsv_saved = 0;
+}
+
+STATIC OP *(*a_old_ck_padany)(pTHX_ OP *) = 0;
+
+STATIC OP *a_ck_padany(pTHX_ OP *o) {
+ UV hint;
+
+ a_pp_padsv_restore(o);
+
+ o = CALL_FPTR(a_old_ck_padany)(aTHX_ o);
+
+ hint = a_hint();
+ if (hint & A_HINT_DO) {
+ a_pp_padsv_save();
+ a_map_store(o, a_pp_padsv_saved, hint);
+ } else
+ a_map_store(o, 0, 0);
+
+ return o;
+}
+
+STATIC OP *(*a_old_ck_padsv)(pTHX_ OP *) = 0;
+
+STATIC OP *a_ck_padsv(pTHX_ OP *o) {
+ UV hint;
+
+ a_pp_padsv_restore(o);
+
+ o = CALL_FPTR(a_old_ck_padsv)(aTHX_ o);
+
+ hint = a_hint();
+ if (hint & A_HINT_DO) {
+ a_map_store(o, o->op_ppaddr, hint);
+ o->op_ppaddr = a_pp_deref;
+ } else
+ a_map_store(o, 0, 0);
+
+ return o;
+}
+
+/* ... ck_deref (aelem,helem,rv2sv) ........................................ */
+
+STATIC OP *(*a_old_ck_aelem)(pTHX_ OP *) = 0;
+STATIC OP *(*a_old_ck_helem)(pTHX_ OP *) = 0;
+STATIC OP *(*a_old_ck_rv2sv)(pTHX_ OP *) = 0;
+
+STATIC OP *a_ck_deref(pTHX_ OP *o) {
+ OP * (*old_ck)(pTHX_ OP *o) = 0;
+ UV hint;
+
+ switch (o->op_type) {
+ case OP_AELEM: old_ck = a_old_ck_aelem; break;
+ case OP_HELEM: old_ck = a_old_ck_helem; break;
+ case OP_RV2SV: old_ck = a_old_ck_rv2sv; break;
+ }
+ o = CALL_FPTR(old_ck)(aTHX_ o);
+
+ hint = a_hint();
+ if (hint & A_HINT_DO) {
+ if (!(hint & A_HINT_STRICT) && o->op_flags & OPf_KIDS) {
+ OP *kid = cUNOPo->op_first;
+ switch (kid->op_type) {
+ case OP_RV2AV:
+ a_map_store(kid, kid->op_ppaddr, hint);
+ kid->op_ppaddr = a_pp_rv2av;
+ break;
+ case OP_RV2HV:
+ a_map_store(kid, kid->op_ppaddr, hint);
+ kid->op_ppaddr = a_pp_rv2hv;
+ break;
+ }
+ }
+ a_map_store(o, o->op_ppaddr, hint);
+ o->op_ppaddr = a_pp_deref;
+ a_map_set_root(o, hint);
+ } else
+ a_map_store(o, 0, 0);
+
+ return o;
+}
+
+/* ... ck_root (exists,delete) ............................................. */
+
+STATIC OP *(*a_old_ck_exists)(pTHX_ OP *) = 0;
+STATIC OP *(*a_old_ck_delete)(pTHX_ OP *) = 0;
+
+STATIC OP *a_ck_root(pTHX_ OP *o) {
+ OP * (*old_ck)(pTHX_ OP *o) = 0;
+ bool enabled = FALSE;
+ UV hint = a_hint();
+
+ switch (o->op_type) {
+ case OP_EXISTS:
+ old_ck = a_old_ck_exists;
+ enabled = hint & A_HINT_EXISTS;
+ break;
+ case OP_DELETE:
+ old_ck = a_old_ck_delete;
+ enabled = hint & A_HINT_DELETE;
+ break;
+ }
+ o = CALL_FPTR(old_ck)(aTHX_ o);
+
+ if (enabled) {
+ a_map_set_root(o, hint | A_HINT_DEREF);
+ a_map_store(o, o->op_ppaddr, hint);
+ o->op_ppaddr = a_pp_root;
+ } else {
+ a_map_set_root(o, 0);
+ }
+
+ return o;
+}
+
+STATIC U32 a_initialized = 0;
+
+/* --- XS ------------------------------------------------------------------ */
+
+MODULE = autovivification PACKAGE = autovivification
+
+PROTOTYPES: ENABLE
+
+BOOT:
+{
+ if (!a_initialized++) {
+ HV *stash;
+
+ a_op_map = ptable_new();
+#ifdef USE_ITHREADS
+ MUTEX_INIT(&a_op_map_mutex);
+#endif
+
+ PERL_HASH(a_hash, __PACKAGE__, __PACKAGE_LEN__);
+
+ a_old_ck_padany = PL_check[OP_PADANY];
+ PL_check[OP_PADANY] = MEMBER_TO_FPTR(a_ck_padany);
+ a_old_ck_padsv = PL_check[OP_PADSV];
+ PL_check[OP_PADSV] = MEMBER_TO_FPTR(a_ck_padsv);
+ a_old_ck_aelem = PL_check[OP_AELEM];
+ PL_check[OP_AELEM] = MEMBER_TO_FPTR(a_ck_deref);
+ a_old_ck_helem = PL_check[OP_HELEM];
+ PL_check[OP_HELEM] = MEMBER_TO_FPTR(a_ck_deref);
+ a_old_ck_rv2sv = PL_check[OP_RV2SV];
+ PL_check[OP_RV2SV] = MEMBER_TO_FPTR(a_ck_deref);
+ a_old_ck_exists = PL_check[OP_EXISTS];
+ PL_check[OP_EXISTS] = MEMBER_TO_FPTR(a_ck_root);
+ a_old_ck_delete = PL_check[OP_DELETE];
+ PL_check[OP_DELETE] = MEMBER_TO_FPTR(a_ck_root);
+
+ stash = gv_stashpvn(__PACKAGE__, __PACKAGE_LEN__, 1);
+ newCONSTSUB(stash, "A_HINT_STRICT", newSVuv(A_HINT_STRICT));
+ newCONSTSUB(stash, "A_HINT_WARN", newSVuv(A_HINT_WARN));
+ newCONSTSUB(stash, "A_HINT_FETCH", newSVuv(A_HINT_FETCH));
+ newCONSTSUB(stash, "A_HINT_STORE", newSVuv(A_HINT_STORE));
+ newCONSTSUB(stash, "A_HINT_EXISTS", newSVuv(A_HINT_EXISTS));
+ newCONSTSUB(stash, "A_HINT_DELETE", newSVuv(A_HINT_DELETE));
+ newCONSTSUB(stash, "A_HINT_MASK", newSVuv(A_HINT_MASK));
+ }
+}
+
+SV *
+_tag(SV *hint)
+PROTOTYPE: $
+CODE:
+ RETVAL = a_tag(SvOK(hint) ? SvUV(hint) : 0);
+OUTPUT:
+ RETVAL
+
+SV *
+_detag(SV *tag)
+PROTOTYPE: $
+CODE:
+ if (!SvOK(tag))
+ XSRETURN_UNDEF;
+ RETVAL = newSVuv(a_detag(tag));
+OUTPUT:
+ RETVAL
--- /dev/null
+package autovivification;
+
+use 5.008;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+autovivification - Lexically disable autovivification.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION;
+BEGIN {
+ $VERSION = '0.01';
+}
+
+=head1 SYNOPSIS
+
+ no autovivification;
+
+ my $hashref;
+
+ my $a = $hashref->{key_a}; # $hashref stays undef
+
+ if (exists $hashref->{option}) { # Still undef
+ ...
+ }
+
+ delete $hashref->{old}; # Still undef again
+
+ $hashref->{new} = $value; # Vivifies to { new => $value }
+
+=head1 DESCRIPTION
+
+When an undefined variable is dereferenced, it gets silently upgraded to an array or hash reference (depending of the type of the dereferencing).
+This behaviour is called I<autovivification> and usually does what you mean (e.g. when you store a value) but it's sometimes unnatural or surprising because your variables gets populated behind your back.
+This is especially true when several levels of dereferencing are involved, in which case all levels are vivified up to the last, or when it happens in intuitively read-only constructs like C<exists>.
+
+This pragma lets you disable autovivification for some constructs and optionally throws a warning or an error when it would have happened.
+
+=cut
+
+BEGIN {
+ require XSLoader;
+ XSLoader::load(__PACKAGE__, $VERSION);
+}
+
+=head1 METHODS
+
+=head2 C<unimport @opts>
+
+Magically called when C<no autovivification> is encountered.
+Enables the features given in C<@opts>, which can be :
+
+=over 4
+
+=item *
+
+C<'fetch'>
+
+Turn off autovivification for rvalue dereferencing expressions, such as C<< $value = $hashref->{key}[$idx]{$field} >>.
+C<undef> is returned when the expression would have autovivified.
+
+=item *
+
+C<'exists'>
+
+Turn off autovivification for dereferencing expressions that are parts of an C<exists>, such as C<< exists $hashref->{key}[$idx]{$field} >>.
+C<''> is returned when the expression would have autovivified.
+
+=item *
+
+C<'delete'>
+
+Turn off autovivification for dereferencing expressions that are parts of a C<delete>, such as C<< delete $hashref->{key}[$idx]{$field} >>.
+C<undef> is returned when the expression would have autovivified.
+
+=item *
+
+C<'store'>
+
+Turn off autovivification for lvalue dereferencing expressions, such as C<< $hashref->{key}[$idx]{$field} = $value >>.
+An exception is thrown if vivification is needed to store the value, which means that effectively you can only assign to levels that are already defined (in the example, this would require C<< $hashref->{key}[$idx] >> to already be a hash reference).
+
+=item *
+
+C<'warn'>
+
+Emit a warning when an autovivification is avoided.
+
+=item *
+
+C<'strict'>
+
+Throw an exception when an autovivification is avoided.
+
+=back
+
+Each call to C<unimport> adds the specified features to the ones already in use in the current lexical scope.
+
+When C<@opts> is empty, it defaults to C<qw/fetch exists delete/>.
+
+=cut
+
+my %bits = (
+ strict => A_HINT_STRICT,
+ warn => A_HINT_WARN,
+ fetch => A_HINT_FETCH,
+ store => A_HINT_STORE,
+ exists => A_HINT_EXISTS,
+ delete => A_HINT_DELETE,
+);
+
+sub unimport {
+ shift;
+ my $hint = _detag($^H{+(__PACKAGE__)}) || 0;
+ @_ = qw/fetch exists delete/ unless @_;
+ $hint |= $bits{$_} for grep exists $bits{$_}, @_;
+ $^H |= 0x00020000;
+ $^H{+(__PACKAGE__)} = _tag($hint);
+ ();
+}
+
+=head2 C<import @opts>
+
+Magically called when C<use autovivification> is encountered.
+Disables the features given in C<@opts>, which can be the same as for L</unimport>.
+
+Each call to C<import> removes the specified features to the ones already in use in the current lexical scope.
+
+When C<@opts> is empty, it defaults to restoring the original Perl autovivification behaviour.
+
+=cut
+
+sub import {
+ shift;
+ my $hint = 0;
+ if (@_) {
+ $hint = _detag($^H{+(__PACKAGE__)}) || 0;
+ $hint &= ~$bits{$_} for grep exists $bits{$_}, @_;
+ }
+ $^H |= 0x00020000;
+ $^H{+(__PACKAGE__)} = _tag($hint);
+ ();
+}
+
+=head1 DEPENDENCIES
+
+L<perl> 5.8.
+
+L<XSLoader> (standard since perl 5.006).
+
+=head1 SEE ALSO
+
+L<perlref>.
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-autovivification at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=autovivification>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc autovivification
+
+Tests code coverage report is available at L<http://www.profvince.com/perl/cover/autovivification>.
+
+=head1 ACKNOWLEDGEMENTS
+
+Matt S. Trout asked for it.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2009 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of autovivification
--- /dev/null
+/* This file is part of the autovivification Perl module.
+ * See http://search.cpan.org/dist/autovivification/ */
+
+/* This is a pointer table implementation essentially copied from the ptr_table
+ * implementation in perl's sv.c, except that it has been modified to use memory
+ * shared across threads.
+ * Copyright goes to the original authors, bug reports to me. */
+
+/* This header is designed to be included several times with different
+ * definitions for PTABLE_NAME and PTABLE_VAL_FREE(). */
+
+#undef pPTBLMS
+#undef pPTBLMS_
+#undef aPTBLMS
+#undef aPTBLMS_
+
+/* Context for PerlMemShared_* functions */
+
+#ifdef PERL_IMPLICIT_SYS
+# define pPTBLMS pTHX
+# define pPTBLMS_ pTHX_
+# define aPTBLMS aTHX
+# define aPTBLMS_ aTHX_
+#else
+# define pPTBLMS
+# define pPTBLMS_
+# define aPTBLMS
+# define aPTBLMS_
+#endif
+
+#ifndef pPTBL
+# define pPTBL pPTBLMS
+#endif
+#ifndef pPTBL_
+# define pPTBL_ pPTBLMS_
+#endif
+#ifndef aPTBL
+# define aPTBL aPTBLMS
+#endif
+#ifndef aPTBL_
+# define aPTBL_ aPTBLMS_
+#endif
+
+#ifndef PTABLE_NAME
+# define PTABLE_NAME ptable
+#endif
+
+#ifndef PTABLE_VAL_FREE
+# define PTABLE_VAL_FREE(V)
+#endif
+
+#ifndef PTABLE_JOIN
+# define PTABLE_PASTE(A, B) A ## B
+# define PTABLE_JOIN(A, B) PTABLE_PASTE(A, B)
+#endif
+
+#ifndef PTABLE_PREFIX
+# define PTABLE_PREFIX(X) PTABLE_JOIN(PTABLE_NAME, X)
+#endif
+
+#ifndef ptable_ent
+typedef struct ptable_ent {
+ struct ptable_ent *next;
+ const void * key;
+ void * val;
+} ptable_ent;
+#define ptable_ent ptable_ent
+#endif /* !ptable_ent */
+
+#ifndef ptable
+typedef struct ptable {
+ ptable_ent **ary;
+ UV max;
+ UV items;
+} ptable;
+#define ptable ptable
+#endif /* !ptable */
+
+#ifndef ptable_new
+STATIC ptable *ptable_new(pPTBLMS) {
+#define ptable_new() ptable_new(aPTBLMS)
+ ptable *t = PerlMemShared_malloc(sizeof *t);
+ t->max = 63;
+ t->items = 0;
+ t->ary = PerlMemShared_calloc(t->max + 1, sizeof *t->ary);
+ return t;
+}
+#endif /* !ptable_new */
+
+#ifndef PTABLE_HASH
+# define PTABLE_HASH(ptr) \
+ ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
+#endif
+
+#ifndef ptable_find
+STATIC ptable_ent *ptable_find(const ptable * const t, const void * const key) {
+#define ptable_find ptable_find
+ ptable_ent *ent;
+ const UV hash = PTABLE_HASH(key);
+
+ ent = t->ary[hash & t->max];
+ for (; ent; ent = ent->next) {
+ if (ent->key == key)
+ return ent;
+ }
+
+ return NULL;
+}
+#endif /* !ptable_find */
+
+#ifndef ptable_fetch
+STATIC void *ptable_fetch(const ptable * const t, const void * const key) {
+#define ptable_fetch ptable_fetch
+ const ptable_ent *const ent = ptable_find(t, key);
+
+ return ent ? ent->val : NULL;
+}
+#endif /* !ptable_fetch */
+
+#ifndef ptable_split
+STATIC void ptable_split(pPTBLMS_ ptable * const t) {
+#define ptable_split(T) ptable_split(aPTBLMS_ (T))
+ ptable_ent **ary = t->ary;
+ const UV oldsize = t->max + 1;
+ UV newsize = oldsize * 2;
+ UV i;
+
+ ary = PerlMemShared_realloc(ary, newsize * sizeof(*ary));
+ Zero(&ary[oldsize], newsize - oldsize, sizeof(*ary));
+ t->max = --newsize;
+ t->ary = ary;
+
+ for (i = 0; i < oldsize; i++, ary++) {
+ ptable_ent **curentp, **entp, *ent;
+ if (!*ary)
+ continue;
+ curentp = ary + oldsize;
+ for (entp = ary, ent = *ary; ent; ent = *entp) {
+ if ((newsize & PTABLE_HASH(ent->key)) != i) {
+ *entp = ent->next;
+ ent->next = *curentp;
+ *curentp = ent;
+ continue;
+ } else
+ entp = &ent->next;
+ }
+ }
+}
+#endif /* !ptable_split */
+
+STATIC void PTABLE_PREFIX(_store)(pPTBL_ ptable * const t, const void * const key, void * const val) {
+ ptable_ent *ent = ptable_find(t, key);
+
+ if (ent) {
+ void *oldval = ent->val;
+ PTABLE_VAL_FREE(oldval);
+ ent->val = val;
+ } else if (val) {
+ const UV i = PTABLE_HASH(key) & t->max;
+ ent = PerlMemShared_malloc(sizeof *ent);
+ ent->key = key;
+ ent->val = val;
+ ent->next = t->ary[i];
+ t->ary[i] = ent;
+ t->items++;
+ if (ent->next && t->items > t->max)
+ ptable_split(t);
+ }
+}
+
+#ifndef ptable_walk
+STATIC void ptable_walk(pTHX_ ptable * const t, void (*cb)(pTHX_ ptable_ent *ent, void *userdata), void *userdata) {
+#define ptable_walk(T, CB, UD) ptable_walk(aTHX_ (T), (CB), (UD))
+ if (t && t->items) {
+ register ptable_ent ** const array = t->ary;
+ UV i = t->max;
+ do {
+ ptable_ent *entry;
+ for (entry = array[i]; entry; entry = entry->next)
+ cb(aTHX_ entry, userdata);
+ } while (i--);
+ }
+}
+#endif /* !ptable_walk */
+
+STATIC void PTABLE_PREFIX(_clear)(pPTBL_ ptable * const t) {
+ if (t && t->items) {
+ register ptable_ent ** const array = t->ary;
+ UV i = t->max;
+
+ do {
+ ptable_ent *entry = array[i];
+ while (entry) {
+ ptable_ent * const oentry = entry;
+ void *val = oentry->val;
+ entry = entry->next;
+ PTABLE_VAL_FREE(val);
+ PerlMemShared_free(oentry);
+ }
+ array[i] = NULL;
+ } while (i--);
+
+ t->items = 0;
+ }
+}
+
+STATIC void PTABLE_PREFIX(_free)(pPTBL_ ptable * const t) {
+ if (!t)
+ return;
+ PTABLE_PREFIX(_clear)(aPTBL_ t);
+ PerlMemShared_free(t->ary);
+ PerlMemShared_free(t);
+}
+
+#undef pPTBL
+#undef pPTBL_
+#undef aPTBL
+#undef aPTBL_
+
+#undef PTABLE_NAME
+#undef PTABLE_VAL_FREE
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use Fatal qw/open/;
+use Text::Balanced qw/extract_bracketed/;
+
+open my $hash_t, '<', 't/20-hash.t';
+open my $array_t, '>', 't/21-array.t';
+
+sub num { ord($_[0]) - ord('a') }
+
+sub hash2array {
+ my ($h) = @_;
+ return $h unless $h and ref $h eq 'HASH';
+ my @array;
+ for (keys %$h) {
+ $array[num($_)] = hash2array($h->{$_});
+ }
+ return \@array;
+}
+
+sub dump_array {
+ my ($a) = @_;
+ return 'undef' unless defined $a;
+ return $a unless ref $a;
+ die "Invalid argument" unless ref $a eq 'ARRAY';
+ return '[ ' . join(', ', map dump_array($_), @$a) . ' ]';
+}
+
+sub extract ($) { extract_bracketed $_[0], '{', qr/.*?(?<!\\)(?:\\\\)*(?={)/ }
+
+my $in_data;
+while (<$hash_t>) {
+ if (/^__DATA__$/) {
+ $in_data = 1;
+ print $array_t $_;
+ } elsif (!$in_data) {
+ s{s/\^\$/%/}{s/^\$/@/};
+ print $array_t $_;
+ } else {
+ s!->{([a-z])}!'->[' . num($1) . ']'!eg;
+ my $buf;
+ my $suffix = $_;
+ my ($bracket, $prefix);
+ while (do { ($bracket, $suffix, $prefix) = extract($suffix); $bracket }) {
+ $buf .= $prefix . dump_array(hash2array(eval $bracket));
+ }
+ $buf .= $suffix;
+ $buf =~ s/\s+/ /g;
+ print $array_t "$buf\n";
+ }
+}
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'autovivification' );
+}
+
+diag( "Testing autovivification $autovivification::VERSION, Perl $], $^X" );
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 6 * 3 * 240;
+
+sub testcase {
+ my ($var, $init, $code, $exp, $use, $global) = @_;
+ my $decl = $global ? "our $var; local $var;" : "my $var;";
+ my $test = $var =~ /^[@%]/ ? "\\$var" : $var;
+ return <<TESTCASE;
+my \@exp = ($exp);
+$decl
+$init
+my \$res = eval {
+ local \$SIG{__WARN__} = sub { die join '', 'warn:', \@_ };
+ $use
+ $code
+};
+if (ref \$exp[0]) {
+ like \$@, \$exp[0], \$desc . ' [exception]';
+} else {
+ is \$@, \$exp[0], \$desc . ' [exception]';
+}
+is_deeply \$res, \$exp[1], \$desc . ' [return]';
+is_deeply $test, \$exp[2], \$desc . ' [variable]';
+TESTCASE
+}
+
+while (<DATA>) {
+ 1 while chomp;
+ next unless /#/;
+ my @chunks = split /#+/, "$_ ";
+ s/^\s+//, s/\s+$// for @chunks;
+ my ($init, $code, $exp, $opts) = @chunks;
+ (my $var = $init) =~ s/[^\$@%\w].*//;
+ $init = $var eq $init ? '' : "$init;";
+ my $use;
+ if ($opts) {
+ for (split ' ', $opts) {
+ my $no = 1;
+ $no = 0 if s/^([-+])// and $1 eq '-';
+ $use .= ($no ? 'no' : 'use') . " autovivification '$_';"
+ }
+ } elsif (defined $opts) {
+ $opts = 'empty';
+ $use = 'no autovivification;';
+ } else {
+ $opts = 'default';
+ $use = '';
+ }
+ my @testcases = (
+ [ $var, $init, $code, $exp, $use, 0 ],
+ [ $var, "use strict; $init", $code, $exp, $use, 1 ],
+ [ $var, "no strict; $init", $code, $exp, $use, 1 ],
+ );
+ my @extra;
+ for (@testcases) {
+ my $var = $_->[0];
+ if ($var =~ /\$/) {
+ my @new = @$_;
+ $new[0] =~ s/^$/%/;
+ $new[1] =~ s/$var\->/$var/g;
+ $new[2] =~ s/$var\->/$var/g;
+ push @extra, \@new;
+ }
+ }
+ push @testcases, @extra;
+ for (@testcases) {
+ my $testcase = testcase(@$_);
+ my ($var, $init, $code) = @$_;
+ my $desc = do { (my $x = "$var | $init") =~ s,;\s+$,,; $x } . " | $code | $opts";
+ eval $testcase;
+ diag "== This testcase failed to compile ==\n$testcase\n## Reason: $@" if $@;
+ }
+}
+
+__DATA__
+
+--- fetch ---
+
+$x # $x->{a} # '', undef, { }
+$x # $x->{a} # '', undef, undef #
+$x # $x->{a} # '', undef, undef # +fetch
+$x # $x->{a} # '', undef, { } # +exists
+$x # $x->{a} # '', undef, { } # +delete
+$x # $x->{a} # '', undef, { } # +store
+
+$x # $x->{a} # qr/^Reference vivification forbidden/, undef, undef # +strict +fetch
+$x # $x->{a} # '', undef, { } # +strict +exists
+$x # $x->{a} # '', undef, { } # +strict +delete
+$x # $x->{a} # '', undef, { } # +strict +store
+
+$x # $x->{a}->{b} # '', undef, { a => { } }
+$x # $x->{a}->{b} # '', undef, undef #
+$x # $x->{a}->{b} # '', undef, undef # +fetch
+$x # $x->{a}->{b} # '', undef, { a => { } } # +exists
+$x # $x->{a}->{b} # '', undef, { a => { } } # +delete
+$x # $x->{a}->{b} # '', undef, { a => { } } # +store
+
+$x # $x->{a}->{b} # qr/^Reference vivification forbidden/, undef, undef # +strict +fetch
+$x # $x->{a}->{b} # '', undef, { a => { } } # +strict +exists
+$x # $x->{a}->{b} # '', undef, { a => { } } # +strict +delete
+$x # $x->{a}->{b} # '', undef, { a => { } } # +strict +store
+
+$x->{a} = 1 # $x->{a} # '', 1, { a => 1 } # +fetch
+$x->{a} = 1 # $x->{b} # '', undef, { a => 1 } # +fetch
+$x->{a} = 1 # $x->{a} # '', 1, { a => 1 } # +exists
+$x->{a} = 1 # $x->{b} # '', undef, { a => 1 } # +exists
+$x->{a} = 1 # $x->{a} # '', 1, { a => 1 } # +delete
+$x->{a} = 1 # $x->{b} # '', undef, { a => 1 } # +delete
+$x->{a} = 1 # $x->{a} # '', 1, { a => 1 } # +store
+$x->{a} = 1 # $x->{b} # '', undef, { a => 1 } # +store
+
+$x->{a} = 1 # $x->{a} # '', 1, { a => 1 } # +strict +fetch
+$x->{a} = 1 # $x->{b} # '', undef, { a => 1 } # +strict +fetch
+$x->{a} = 1 # $x->{a} # '', 1, { a => 1 } # +strict +exists
+$x->{a} = 1 # $x->{b} # '', undef, { a => 1 } # +strict +exists
+$x->{a} = 1 # $x->{a} # '', 1, { a => 1 } # +strict +delete
+$x->{a} = 1 # $x->{b} # '', undef, { a => 1 } # +strict +delete
+$x->{a} = 1 # $x->{a} # '', 1, { a => 1 } # +strict +store
+$x->{a} = 1 # $x->{b} # '', undef, { a => 1 } # +strict +store
+
+$x->{a}->{b} = 1 # $x->{a}->{b} # '', 1, { a => { b => 1 } } # +fetch
+$x->{a}->{b} = 1 # $x->{a}->{d} # '', undef, { a => { b => 1 } } # +fetch
+$x->{a}->{b} = 1 # $x->{c}->{d} # '', undef, { a => { b => 1 } } # +fetch
+$x->{a}->{b} = 1 # $x->{a}->{b} # '', 1, { a => { b => 1 } } # +exists
+$x->{a}->{b} = 1 # $x->{a}->{d} # '', undef, { a => { b => 1 } } # +exists
+$x->{a}->{b} = 1 # $x->{c}->{d} # '', undef, { a => { b => 1 }, c => { } } # +exists
+$x->{a}->{b} = 1 # $x->{a}->{b} # '', 1, { a => { b => 1 } } # +delete
+$x->{a}->{b} = 1 # $x->{a}->{d} # '', undef, { a => { b => 1 } } # +delete
+$x->{a}->{b} = 1 # $x->{c}->{d} # '', undef, { a => { b => 1 }, c => { } } # +delete
+$x->{a}->{b} = 1 # $x->{a}->{b} # '', 1, { a => { b => 1 } } # +store
+$x->{a}->{b} = 1 # $x->{a}->{d} # '', undef, { a => { b => 1 } } # +store
+$x->{a}->{b} = 1 # $x->{c}->{d} # '', undef, { a => { b => 1 }, c => { } } # +store
+
+$x->{a}->{b} = 1 # $x->{a}->{b} # '', 1, { a => { b => 1 } } # +strict +fetch
+$x->{a}->{b} = 1 # $x->{a}->{d} # '', undef, { a => { b => 1 } } # +strict +fetch
+$x->{a}->{b} = 1 # $x->{c}->{d} # qr/^Reference vivification forbidden/, undef, { a => { b => 1 } } # +strict +fetch
+$x->{a}->{b} = 1 # $x->{a}->{b} # '', 1, { a => { b => 1 } } # +strict +exists
+$x->{a}->{b} = 1 # $x->{a}->{d} # '', undef, { a => { b => 1 } } # +strict +exists
+$x->{a}->{b} = 1 # $x->{c}->{d} # '', undef, { a => { b => 1 }, c => { } } # +strict +exists
+$x->{a}->{b} = 1 # $x->{a}->{b} # '', 1, { a => { b => 1 } } # +strict +delete
+$x->{a}->{b} = 1 # $x->{a}->{d} # '', undef, { a => { b => 1 } } # +strict +delete
+$x->{a}->{b} = 1 # $x->{c}->{d} # '', undef, { a => { b => 1 }, c => { } } # +strict +delete
+$x->{a}->{b} = 1 # $x->{a}->{b} # '', 1, { a => { b => 1 } } # +strict +store
+$x->{a}->{b} = 1 # $x->{a}->{d} # '', undef, { a => { b => 1 } } # +strict +store
+$x->{a}->{b} = 1 # $x->{c}->{d} # '', undef, { a => { b => 1 }, c => { } } # +strict +store
+
+--- exists ---
+
+$x # exists $x->{a} # '', '', { }
+$x # exists $x->{a} # '', '', undef #
+$x # exists $x->{a} # '', '', { } # +fetch
+$x # exists $x->{a} # '', '', undef # +exists
+$x # exists $x->{a} # '', '', { } # +delete
+$x # exists $x->{a} # '', '', { } # +store
+
+$x # exists $x->{a} # '', '', { } # +strict +fetch
+$x # exists $x->{a} # qr/^Reference vivification forbidden/, undef, undef # +strict +exists
+$x # exists $x->{a} # '', '', { } # +strict +delete
+$x # exists $x->{a} # '', '', { } # +strict +store
+
+$x # exists $x->{a}->{b} # '', '', { a => { } }
+$x # exists $x->{a}->{b} # '', '', undef #
+$x # exists $x->{a}->{b} # '', '', { a => { } } # +fetch
+$x # exists $x->{a}->{b} # '', '', undef # +exists
+$x # exists $x->{a}->{b} # '', '', { a => { } } # +delete
+$x # exists $x->{a}->{b} # '', '', { a => { } } # +store
+
+$x # exists $x->{a}->{b} # '', '', { a => { } } # +strict +fetch
+$x # exists $x->{a}->{b} # qr/^Reference vivification forbidden/, undef, undef # +strict +exists
+$x # exists $x->{a}->{b} # '', '', { a => { } } # +strict +delete
+$x # exists $x->{a}->{b} # '', '', { a => { } } # +strict +store
+
+$x->{a} = 1 # exists $x->{a} # '', 1, { a => 1 } # +fetch
+$x->{a} = 1 # exists $x->{b} # '', '', { a => 1 } # +fetch
+$x->{a} = 1 # exists $x->{a} # '', 1, { a => 1 } # +exists
+$x->{a} = 1 # exists $x->{b} # '', '', { a => 1 } # +exists
+$x->{a} = 1 # exists $x->{a} # '', 1, { a => 1 } # +delete
+$x->{a} = 1 # exists $x->{b} # '', '', { a => 1 } # +delete
+$x->{a} = 1 # exists $x->{a} # '', 1, { a => 1 } # +store
+$x->{a} = 1 # exists $x->{b} # '', '', { a => 1 } # +store
+
+$x->{a} = 1 # exists $x->{a} # '', 1, { a => 1 } # +strict +fetch
+$x->{a} = 1 # exists $x->{b} # '', '', { a => 1 } # +strict +fetch
+$x->{a} = 1 # exists $x->{a} # '', 1, { a => 1 } # +strict +exists
+$x->{a} = 1 # exists $x->{b} # '', '', { a => 1 } # +strict +exists
+$x->{a} = 1 # exists $x->{a} # '', 1, { a => 1 } # +strict +delete
+$x->{a} = 1 # exists $x->{b} # '', '', { a => 1 } # +strict +delete
+$x->{a} = 1 # exists $x->{a} # '', 1, { a => 1 } # +strict +store
+$x->{a} = 1 # exists $x->{b} # '', '', { a => 1 } # +strict +store
+
+$x->{a}->{b} = 1 # exists $x->{a}->{b} # '', 1, { a => { b => 1 } } # +fetch
+$x->{a}->{b} = 1 # exists $x->{a}->{d} # '', '', { a => { b => 1 } } # +fetch
+$x->{a}->{b} = 1 # exists $x->{c}->{d} # '', '', { a => { b => 1 }, c => { } } # +fetch
+$x->{a}->{b} = 1 # exists $x->{a}->{b} # '', 1, { a => { b => 1 } } # +exists
+$x->{a}->{b} = 1 # exists $x->{a}->{d} # '', '', { a => { b => 1 } } # +exists
+$x->{a}->{b} = 1 # exists $x->{c}->{d} # '', '', { a => { b => 1 } } # +exists
+$x->{a}->{b} = 1 # exists $x->{a}->{b} # '', 1, { a => { b => 1 } } # +delete
+$x->{a}->{b} = 1 # exists $x->{a}->{d} # '', '', { a => { b => 1 } } # +delete
+$x->{a}->{b} = 1 # exists $x->{c}->{d} # '', '', { a => { b => 1 }, c => { } } # +delete
+$x->{a}->{b} = 1 # exists $x->{a}->{b} # '', 1, { a => { b => 1 } } # +store
+$x->{a}->{b} = 1 # exists $x->{a}->{d} # '', '', { a => { b => 1 } } # +store
+$x->{a}->{b} = 1 # exists $x->{c}->{d} # '', '', { a => { b => 1 }, c => { } } # +store
+
+$x->{a}->{b} = 1 # exists $x->{a}->{b} # '', 1, { a => { b => 1 } } # +strict +fetch
+$x->{a}->{b} = 1 # exists $x->{a}->{d} # '', '', { a => { b => 1 } } # +strict +fetch
+$x->{a}->{b} = 1 # exists $x->{c}->{d} # '', '', { a => { b => 1 }, c => { } } # +strict +fetch
+$x->{a}->{b} = 1 # exists $x->{a}->{b} # '', 1, { a => { b => 1 } } # +strict +exists
+$x->{a}->{b} = 1 # exists $x->{a}->{d} # '', '', { a => { b => 1 } } # +strict +exists
+$x->{a}->{b} = 1 # exists $x->{c}->{d} # qr/^Reference vivification forbidden/, undef, { a => { b => 1 } } # +strict +exists
+$x->{a}->{b} = 1 # exists $x->{a}->{b} # '', 1, { a => { b => 1 } } # +strict +delete
+$x->{a}->{b} = 1 # exists $x->{a}->{d} # '', '', { a => { b => 1 } } # +strict +delete
+$x->{a}->{b} = 1 # exists $x->{c}->{d} # '', '', { a => { b => 1 }, c => { } } # +strict +delete
+$x->{a}->{b} = 1 # exists $x->{a}->{b} # '', 1, { a => { b => 1 } } # +strict +store
+$x->{a}->{b} = 1 # exists $x->{a}->{d} # '', '', { a => { b => 1 } } # +strict +store
+$x->{a}->{b} = 1 # exists $x->{c}->{d} # '', '', { a => { b => 1 }, c => { } } # +strict +store
+
+--- delete ---
+
+$x # delete $x->{a} # '', undef, { }
+$x # delete $x->{a} # '', undef, undef #
+$x # delete $x->{a} # '', undef, { } # +fetch
+$x # delete $x->{a} # '', undef, { } # +exists
+$x # delete $x->{a} # '', undef, undef # +delete
+$x # delete $x->{a} # '', undef, { } # +store
+
+$x # delete $x->{a} # '', undef, { } # +strict +fetch
+$x # delete $x->{a} # '', undef, { } # +strict +exists
+$x # delete $x->{a} # qr/^Reference vivification forbidden/, undef, undef # +strict +delete
+$x # delete $x->{a} # '', undef, { } # +strict +store
+
+$x # delete $x->{a}->{b} # '', undef, { a => { } }
+$x # delete $x->{a}->{b} # '', undef, undef #
+$x # delete $x->{a}->{b} # '', undef, { a => { } } # +fetch
+$x # delete $x->{a}->{b} # '', undef, { a => { } } # +exists
+$x # delete $x->{a}->{b} # '', undef, undef # +delete
+$x # delete $x->{a}->{b} # '', undef, { a => { } } # +store
+
+$x # delete $x->{a}->{b} # '', undef, { a => { } } # +strict +fetch
+$x # delete $x->{a}->{b} # '', undef, { a => { } } # +strict +exists
+$x # delete $x->{a}->{b} # qr/^Reference vivification forbidden/, undef, undef # +strict +delete
+$x # delete $x->{a}->{b} # '', undef, { a => { } } # +strict +store
+
+$x->{a} = 1 # delete $x->{a} # '', 1, { } # +fetch
+$x->{a} = 1 # delete $x->{b} # '', undef, { a => 1 } # +fetch
+$x->{a} = 1 # delete $x->{a} # '', 1, { } # +exists
+$x->{a} = 1 # delete $x->{b} # '', undef, { a => 1 } # +exists
+$x->{a} = 1 # delete $x->{a} # '', 1, { } # +delete
+$x->{a} = 1 # delete $x->{b} # '', undef, { a => 1 } # +delete
+$x->{a} = 1 # delete $x->{a} # '', 1, { } # +store
+$x->{a} = 1 # delete $x->{b} # '', undef, { a => 1 } # +store
+
+$x->{a} = 1 # delete $x->{a} # '', 1, { } # +strict +fetch
+$x->{a} = 1 # delete $x->{b} # '', undef, { a => 1 } # +strict +fetch
+$x->{a} = 1 # delete $x->{a} # '', 1, { } # +strict +exists
+$x->{a} = 1 # delete $x->{b} # '', undef, { a => 1 } # +strict +exists
+$x->{a} = 1 # delete $x->{a} # '', 1, { } # +strict +delete
+$x->{a} = 1 # delete $x->{b} # '', undef, { a => 1 } # +strict +delete
+$x->{a} = 1 # delete $x->{a} # '', 1, { } # +strict +store
+$x->{a} = 1 # delete $x->{b} # '', undef, { a => 1 } # +strict +store
+
+$x->{a}->{b} = 1 # delete $x->{a}->{b} # '', 1, { a => { } } # +fetch
+$x->{a}->{b} = 1 # delete $x->{a}->{d} # '', undef, { a => { b => 1 } }# +fetch
+$x->{a}->{b} = 1 # delete $x->{c}->{d} # '', undef, { a => { b => 1 }, c => { } } # +fetch
+$x->{a}->{b} = 1 # delete $x->{a}->{b} # '', 1, { a => { } } # +exists
+$x->{a}->{b} = 1 # delete $x->{a}->{d} # '', undef, { a => { b => 1 } }# +exists
+$x->{a}->{b} = 1 # delete $x->{c}->{d} # '', undef, { a => { b => 1 }, c => { } } # +exists
+$x->{a}->{b} = 1 # delete $x->{a}->{b} # '', 1, { a => { } } # +delete
+$x->{a}->{b} = 1 # delete $x->{a}->{d} # '', undef, { a => { b => 1 } }# +delete
+$x->{a}->{b} = 1 # delete $x->{c}->{d} # '', undef, { a => { b => 1 } }# +delete
+$x->{a}->{b} = 1 # delete $x->{a}->{b} # '', 1, { a => { } } # +store
+$x->{a}->{b} = 1 # delete $x->{a}->{d} # '', undef, { a => { b => 1 } }# +store
+$x->{a}->{b} = 1 # delete $x->{c}->{d} # '', undef, { a => { b => 1 }, c => { } } # +store
+
+$x->{a}->{b} = 1 # delete $x->{a}->{b} # '', 1, { a => { } } # +strict +fetch
+$x->{a}->{b} = 1 # delete $x->{a}->{d} # '', undef, { a => { b => 1 } } # +strict +fetch
+$x->{a}->{b} = 1 # delete $x->{c}->{d} # '', undef, { a => { b => 1 }, c => {} }# +strict +fetch
+$x->{a}->{b} = 1 # delete $x->{a}->{b} # '', 1, { a => { } } # +strict +exists
+$x->{a}->{b} = 1 # delete $x->{a}->{d} # '', undef, { a => { b => 1 } } # +strict +exists
+$x->{a}->{b} = 1 # delete $x->{c}->{d} # '', undef, { a => { b => 1 }, c => {} }# +strict +exists
+$x->{a}->{b} = 1 # delete $x->{a}->{b} # '', 1, { a => { } } # +strict +delete
+$x->{a}->{b} = 1 # delete $x->{a}->{d} # '', undef, { a => { b => 1 } } # +strict +delete
+$x->{a}->{b} = 1 # delete $x->{c}->{d} # qr/^Reference vivification forbidden/, undef, { a => { b => 1 } } # +strict +delete
+$x->{a}->{b} = 1 # delete $x->{a}->{b} # '', 1, { a => { } } # +strict +store
+$x->{a}->{b} = 1 # delete $x->{a}->{d} # '', undef, { a => { b => 1 } } # +strict +store
+$x->{a}->{b} = 1 # delete $x->{c}->{d} # '', undef, { a => { b => 1 }, c => {} }# +strict +store
+
+--- store ---
+
+$x # $x->{a} = 1 # '', 1, { a => 1 }
+$x # $x->{a} = 1 # '', 1, { a => 1 } #
+$x # $x->{a} = 1 # '', 1, { a => 1 } # +fetch
+$x # $x->{a} = 1 # '', 1, { a => 1 } # +exists
+$x # $x->{a} = 1 # '', 1, { a => 1 } # +delete
+$x # $x->{a} = 1 # qr/^Can't vivify reference/, undef, undef # +store
+
+$x # $x->{a} = 1 # '', 1, { a => 1 } # +strict +fetch
+$x # $x->{a} = 1 # '', 1, { a => 1 } # +strict +exists
+$x # $x->{a} = 1 # '', 1, { a => 1 } # +strict +delete
+$x # $x->{a} = 1 # qr/^Reference vivification forbidden/, undef, undef # +strict +store
+
+$x # $x->{a}->{b} = 1 # '', 1, { a => { b => 1 } }
+$x # $x->{a}->{b} = 1 # '', 1, { a => { b => 1 } } #
+$x # $x->{a}->{b} = 1 # '', 1, { a => { b => 1 } } # +fetch
+$x # $x->{a}->{b} = 1 # '', 1, { a => { b => 1 } } # +exists
+$x # $x->{a}->{b} = 1 # '', 1, { a => { b => 1 } } # +delete
+$x # $x->{a}->{b} = 1 # qr/^Can't vivify reference/, undef, undef # +store
+
+$x # $x->{a}->{b} = 1 # '', 1, { a => { b => 1 } } # +strict +fetch
+$x # $x->{a}->{b} = 1 # '', 1, { a => { b => 1 } } # +strict +exists
+$x # $x->{a}->{b} = 1 # '', 1, { a => { b => 1 } } # +strict +delete
+$x # $x->{a}->{b} = 1 # qr/^Reference vivification forbidden/, undef, undef # +strict +store
+
+$x->{a} = 1 # $x->{a} = 2 # '', 2, { a => 2 } # +fetch
+$x->{a} = 1 # $x->{b} = 2 # '', 2, { a => 1, b => 2 } # +fetch
+$x->{a} = 1 # $x->{a} = 2 # '', 2, { a => 2 } # +exists
+$x->{a} = 1 # $x->{b} = 2 # '', 2, { a => 1, b => 2 } # +exists
+$x->{a} = 1 # $x->{a} = 2 # '', 2, { a => 2 } # +delete
+$x->{a} = 1 # $x->{b} = 2 # '', 2, { a => 1, b => 2 } # +delete
+$x->{a} = 1 # $x->{a} = 2 # '', 2, { a => 2 } # +store
+$x->{a} = 1 # $x->{b} = 2 # '', 2, { a => 1, b => 2 } # +store
+
+$x->{a} = 1 # $x->{a} = 2 # '', 2, { a => 2 } # +strict +fetch
+$x->{a} = 1 # $x->{b} = 2 # '', 2, { a => 1, b => 2 } # +strict +fetch
+$x->{a} = 1 # $x->{a} = 2 # '', 2, { a => 2 } # +strict +exists
+$x->{a} = 1 # $x->{b} = 2 # '', 2, { a => 1, b => 2 } # +strict +exists
+$x->{a} = 1 # $x->{a} = 2 # '', 2, { a => 2 } # +strict +delete
+$x->{a} = 1 # $x->{b} = 2 # '', 2, { a => 1, b => 2 } # +strict +delete
+$x->{a} = 1 # $x->{a} = 2 # '', 2, { a => 2 } # +strict +store
+$x->{a} = 1 # $x->{b} = 2 # '', 2, { a => 1, b => 2 } # +strict +store
+
+$x->{a}->{b} = 1 # $x->{a}->{b} = 2 # '', 2, { a => { b => 2 } } # +fetch
+$x->{a}->{b} = 1 # $x->{a}->{d} = 2 # '', 2, { a => { b => 1, d => 2 } } # +fetch
+$x->{a}->{b} = 1 # $x->{c}->{d} = 2 # '', 2, { a => { b => 1 }, c => { d => 2 } } # +fetch
+$x->{a}->{b} = 1 # $x->{a}->{b} = 2 # '', 2, { a => { b => 2 } } # +exists
+$x->{a}->{b} = 1 # $x->{a}->{d} = 2 # '', 2, { a => { b => 1, d => 2 } } # +exists
+$x->{a}->{b} = 1 # $x->{c}->{d} = 2 # '', 2, { a => { b => 1 }, c => { d => 2 } } # +exists
+$x->{a}->{b} = 1 # $x->{a}->{b} = 2 # '', 2, { a => { b => 2 } } # +delete
+$x->{a}->{b} = 1 # $x->{a}->{d} = 2 # '', 2, { a => { b => 1, d => 2 } } # +delete
+$x->{a}->{b} = 1 # $x->{c}->{d} = 2 # '', 2, { a => { b => 1 }, c => { d => 2 } } # +delete
+$x->{a}->{b} = 1 # $x->{a}->{b} = 2 # '', 2, { a => { b => 2 } } # +store
+$x->{a}->{b} = 1 # $x->{a}->{d} = 2 # '', 2, { a => { b => 1, d => 2 } } # +store
+$x->{a}->{b} = 1 # $x->{c}->{d} = 2 # qr/^Can't vivify reference/, undef, { a => { b => 1 } } # +store
+
+$x->{a}->{b} = 1 # $x->{a}->{b} = 2 # '', 2, { a => { b => 2 } } # +strict +fetch
+$x->{a}->{b} = 1 # $x->{a}->{d} = 2 # '', 2, { a => { b => 1, d => 2 } } # +strict +fetch
+$x->{a}->{b} = 1 # $x->{c}->{d} = 2 # '', 2, { a => { b => 1 }, c => { d => 2 } } # +strict +fetch
+$x->{a}->{b} = 1 # $x->{a}->{b} = 2 # '', 2, { a => { b => 2 } } # +strict +exists
+$x->{a}->{b} = 1 # $x->{a}->{d} = 2 # '', 2, { a => { b => 1, d => 2 } } # +strict +exists
+$x->{a}->{b} = 1 # $x->{c}->{d} = 2 # '', 2, { a => { b => 1 }, c => { d => 2 } } # +strict +exists
+$x->{a}->{b} = 1 # $x->{a}->{b} = 2 # '', 2, { a => { b => 2 } } # +strict +delete
+$x->{a}->{b} = 1 # $x->{a}->{d} = 2 # '', 2, { a => { b => 1, d => 2 } } # +strict +delete
+$x->{a}->{b} = 1 # $x->{c}->{d} = 2 # '', 2, { a => { b => 1 }, c => { d => 2 } } # +strict +delete
+$x->{a}->{b} = 1 # $x->{a}->{b} = 2 # '', 2, { a => { b => 2 } } # +strict +store
+$x->{a}->{b} = 1 # $x->{a}->{d} = 2 # '', 2, { a => { b => 1, d => 2 } } # +strict +store
+$x->{a}->{b} = 1 # $x->{c}->{d} = 2 # qr/^Reference vivification forbidden/, undef, { a => { b => 1 } } # +strict +store
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 6 * 3 * 240;
+
+sub testcase {
+ my ($var, $init, $code, $exp, $use, $global) = @_;
+ my $decl = $global ? "our $var; local $var;" : "my $var;";
+ my $test = $var =~ /^[@%]/ ? "\\$var" : $var;
+ return <<TESTCASE;
+my \@exp = ($exp);
+$decl
+$init
+my \$res = eval {
+ local \$SIG{__WARN__} = sub { die join '', 'warn:', \@_ };
+ $use
+ $code
+};
+if (ref \$exp[0]) {
+ like \$@, \$exp[0], \$desc . ' [exception]';
+} else {
+ is \$@, \$exp[0], \$desc . ' [exception]';
+}
+is_deeply \$res, \$exp[1], \$desc . ' [return]';
+is_deeply $test, \$exp[2], \$desc . ' [variable]';
+TESTCASE
+}
+
+while (<DATA>) {
+ 1 while chomp;
+ next unless /#/;
+ my @chunks = split /#+/, "$_ ";
+ s/^\s+//, s/\s+$// for @chunks;
+ my ($init, $code, $exp, $opts) = @chunks;
+ (my $var = $init) =~ s/[^\$@%\w].*//;
+ $init = $var eq $init ? '' : "$init;";
+ my $use;
+ if ($opts) {
+ for (split ' ', $opts) {
+ my $no = 1;
+ $no = 0 if s/^([-+])// and $1 eq '-';
+ $use .= ($no ? 'no' : 'use') . " autovivification '$_';"
+ }
+ } elsif (defined $opts) {
+ $opts = 'empty';
+ $use = 'no autovivification;';
+ } else {
+ $opts = 'default';
+ $use = '';
+ }
+ my @testcases = (
+ [ $var, $init, $code, $exp, $use, 0 ],
+ [ $var, "use strict; $init", $code, $exp, $use, 1 ],
+ [ $var, "no strict; $init", $code, $exp, $use, 1 ],
+ );
+ my @extra;
+ for (@testcases) {
+ my $var = $_->[0];
+ if ($var =~ /\$/) {
+ my @new = @$_;
+ $new[0] =~ s/^$/@/;
+ $new[1] =~ s/$var\->/$var/g;
+ $new[2] =~ s/$var\->/$var/g;
+ push @extra, \@new;
+ }
+ }
+ push @testcases, @extra;
+ for (@testcases) {
+ my $testcase = testcase(@$_);
+ my ($var, $init, $code) = @$_;
+ my $desc = do { (my $x = "$var | $init") =~ s,;\s+$,,; $x } . " | $code | $opts";
+ eval $testcase;
+ diag "== This testcase failed to compile ==\n$testcase\n## Reason: $@" if $@;
+ }
+}
+
+__DATA__
+
+--- fetch ---
+
+$x # $x->[0] # '', undef, [ ]
+$x # $x->[0] # '', undef, undef #
+$x # $x->[0] # '', undef, undef # +fetch
+$x # $x->[0] # '', undef, [ ] # +exists
+$x # $x->[0] # '', undef, [ ] # +delete
+$x # $x->[0] # '', undef, [ ] # +store
+
+$x # $x->[0] # qr/^Reference vivification forbidden/, undef, undef # +strict +fetch
+$x # $x->[0] # '', undef, [ ] # +strict +exists
+$x # $x->[0] # '', undef, [ ] # +strict +delete
+$x # $x->[0] # '', undef, [ ] # +strict +store
+
+$x # $x->[0]->[1] # '', undef, [ [ ] ]
+$x # $x->[0]->[1] # '', undef, undef #
+$x # $x->[0]->[1] # '', undef, undef # +fetch
+$x # $x->[0]->[1] # '', undef, [ [ ] ] # +exists
+$x # $x->[0]->[1] # '', undef, [ [ ] ] # +delete
+$x # $x->[0]->[1] # '', undef, [ [ ] ] # +store
+
+$x # $x->[0]->[1] # qr/^Reference vivification forbidden/, undef, undef # +strict +fetch
+$x # $x->[0]->[1] # '', undef, [ [ ] ] # +strict +exists
+$x # $x->[0]->[1] # '', undef, [ [ ] ] # +strict +delete
+$x # $x->[0]->[1] # '', undef, [ [ ] ] # +strict +store
+
+$x->[0] = 1 # $x->[0] # '', 1, [ 1 ] # +fetch
+$x->[0] = 1 # $x->[1] # '', undef, [ 1 ] # +fetch
+$x->[0] = 1 # $x->[0] # '', 1, [ 1 ] # +exists
+$x->[0] = 1 # $x->[1] # '', undef, [ 1 ] # +exists
+$x->[0] = 1 # $x->[0] # '', 1, [ 1 ] # +delete
+$x->[0] = 1 # $x->[1] # '', undef, [ 1 ] # +delete
+$x->[0] = 1 # $x->[0] # '', 1, [ 1 ] # +store
+$x->[0] = 1 # $x->[1] # '', undef, [ 1 ] # +store
+
+$x->[0] = 1 # $x->[0] # '', 1, [ 1 ] # +strict +fetch
+$x->[0] = 1 # $x->[1] # '', undef, [ 1 ] # +strict +fetch
+$x->[0] = 1 # $x->[0] # '', 1, [ 1 ] # +strict +exists
+$x->[0] = 1 # $x->[1] # '', undef, [ 1 ] # +strict +exists
+$x->[0] = 1 # $x->[0] # '', 1, [ 1 ] # +strict +delete
+$x->[0] = 1 # $x->[1] # '', undef, [ 1 ] # +strict +delete
+$x->[0] = 1 # $x->[0] # '', 1, [ 1 ] # +strict +store
+$x->[0] = 1 # $x->[1] # '', undef, [ 1 ] # +strict +store
+
+$x->[0]->[1] = 1 # $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +fetch
+$x->[0]->[1] = 1 # $x->[0]->[3] # '', undef, [ [ undef, 1 ] ] # +fetch
+$x->[0]->[1] = 1 # $x->[2]->[3] # '', undef, [ [ undef, 1 ] ] # +fetch
+$x->[0]->[1] = 1 # $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +exists
+$x->[0]->[1] = 1 # $x->[0]->[3] # '', undef, [ [ undef, 1 ] ] # +exists
+$x->[0]->[1] = 1 # $x->[2]->[3] # '', undef, [ [ undef, 1 ], undef, [ ] ] # +exists
+$x->[0]->[1] = 1 # $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +delete
+$x->[0]->[1] = 1 # $x->[0]->[3] # '', undef, [ [ undef, 1 ] ] # +delete
+$x->[0]->[1] = 1 # $x->[2]->[3] # '', undef, [ [ undef, 1 ], undef, [ ] ] # +delete
+$x->[0]->[1] = 1 # $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +store
+$x->[0]->[1] = 1 # $x->[0]->[3] # '', undef, [ [ undef, 1 ] ] # +store
+$x->[0]->[1] = 1 # $x->[2]->[3] # '', undef, [ [ undef, 1 ], undef, [ ] ] # +store
+
+$x->[0]->[1] = 1 # $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +strict +fetch
+$x->[0]->[1] = 1 # $x->[0]->[3] # '', undef, [ [ undef, 1 ] ] # +strict +fetch
+$x->[0]->[1] = 1 # $x->[2]->[3] # qr/^Reference vivification forbidden/, undef, [ [ undef, 1 ] ] # +strict +fetch
+$x->[0]->[1] = 1 # $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +strict +exists
+$x->[0]->[1] = 1 # $x->[0]->[3] # '', undef, [ [ undef, 1 ] ] # +strict +exists
+$x->[0]->[1] = 1 # $x->[2]->[3] # '', undef, [ [ undef, 1 ], undef, [ ] ] # +strict +exists
+$x->[0]->[1] = 1 # $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +strict +delete
+$x->[0]->[1] = 1 # $x->[0]->[3] # '', undef, [ [ undef, 1 ] ] # +strict +delete
+$x->[0]->[1] = 1 # $x->[2]->[3] # '', undef, [ [ undef, 1 ], undef, [ ] ] # +strict +delete
+$x->[0]->[1] = 1 # $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +strict +store
+$x->[0]->[1] = 1 # $x->[0]->[3] # '', undef, [ [ undef, 1 ] ] # +strict +store
+$x->[0]->[1] = 1 # $x->[2]->[3] # '', undef, [ [ undef, 1 ], undef, [ ] ] # +strict +store
+
+--- exists ---
+
+$x # exists $x->[0] # '', '', [ ]
+$x # exists $x->[0] # '', '', undef #
+$x # exists $x->[0] # '', '', [ ] # +fetch
+$x # exists $x->[0] # '', '', undef # +exists
+$x # exists $x->[0] # '', '', [ ] # +delete
+$x # exists $x->[0] # '', '', [ ] # +store
+
+$x # exists $x->[0] # '', '', [ ] # +strict +fetch
+$x # exists $x->[0] # qr/^Reference vivification forbidden/, undef, undef # +strict +exists
+$x # exists $x->[0] # '', '', [ ] # +strict +delete
+$x # exists $x->[0] # '', '', [ ] # +strict +store
+
+$x # exists $x->[0]->[1] # '', '', [ [ ] ]
+$x # exists $x->[0]->[1] # '', '', undef #
+$x # exists $x->[0]->[1] # '', '', [ [ ] ] # +fetch
+$x # exists $x->[0]->[1] # '', '', undef # +exists
+$x # exists $x->[0]->[1] # '', '', [ [ ] ] # +delete
+$x # exists $x->[0]->[1] # '', '', [ [ ] ] # +store
+
+$x # exists $x->[0]->[1] # '', '', [ [ ] ] # +strict +fetch
+$x # exists $x->[0]->[1] # qr/^Reference vivification forbidden/, undef, undef # +strict +exists
+$x # exists $x->[0]->[1] # '', '', [ [ ] ] # +strict +delete
+$x # exists $x->[0]->[1] # '', '', [ [ ] ] # +strict +store
+
+$x->[0] = 1 # exists $x->[0] # '', 1, [ 1 ] # +fetch
+$x->[0] = 1 # exists $x->[1] # '', '', [ 1 ] # +fetch
+$x->[0] = 1 # exists $x->[0] # '', 1, [ 1 ] # +exists
+$x->[0] = 1 # exists $x->[1] # '', '', [ 1 ] # +exists
+$x->[0] = 1 # exists $x->[0] # '', 1, [ 1 ] # +delete
+$x->[0] = 1 # exists $x->[1] # '', '', [ 1 ] # +delete
+$x->[0] = 1 # exists $x->[0] # '', 1, [ 1 ] # +store
+$x->[0] = 1 # exists $x->[1] # '', '', [ 1 ] # +store
+
+$x->[0] = 1 # exists $x->[0] # '', 1, [ 1 ] # +strict +fetch
+$x->[0] = 1 # exists $x->[1] # '', '', [ 1 ] # +strict +fetch
+$x->[0] = 1 # exists $x->[0] # '', 1, [ 1 ] # +strict +exists
+$x->[0] = 1 # exists $x->[1] # '', '', [ 1 ] # +strict +exists
+$x->[0] = 1 # exists $x->[0] # '', 1, [ 1 ] # +strict +delete
+$x->[0] = 1 # exists $x->[1] # '', '', [ 1 ] # +strict +delete
+$x->[0] = 1 # exists $x->[0] # '', 1, [ 1 ] # +strict +store
+$x->[0] = 1 # exists $x->[1] # '', '', [ 1 ] # +strict +store
+
+$x->[0]->[1] = 1 # exists $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +fetch
+$x->[0]->[1] = 1 # exists $x->[0]->[3] # '', '', [ [ undef, 1 ] ] # +fetch
+$x->[0]->[1] = 1 # exists $x->[2]->[3] # '', '', [ [ undef, 1 ], undef, [ ] ] # +fetch
+$x->[0]->[1] = 1 # exists $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +exists
+$x->[0]->[1] = 1 # exists $x->[0]->[3] # '', '', [ [ undef, 1 ] ] # +exists
+$x->[0]->[1] = 1 # exists $x->[2]->[3] # '', '', [ [ undef, 1 ] ] # +exists
+$x->[0]->[1] = 1 # exists $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +delete
+$x->[0]->[1] = 1 # exists $x->[0]->[3] # '', '', [ [ undef, 1 ] ] # +delete
+$x->[0]->[1] = 1 # exists $x->[2]->[3] # '', '', [ [ undef, 1 ], undef, [ ] ] # +delete
+$x->[0]->[1] = 1 # exists $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +store
+$x->[0]->[1] = 1 # exists $x->[0]->[3] # '', '', [ [ undef, 1 ] ] # +store
+$x->[0]->[1] = 1 # exists $x->[2]->[3] # '', '', [ [ undef, 1 ], undef, [ ] ] # +store
+
+$x->[0]->[1] = 1 # exists $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +strict +fetch
+$x->[0]->[1] = 1 # exists $x->[0]->[3] # '', '', [ [ undef, 1 ] ] # +strict +fetch
+$x->[0]->[1] = 1 # exists $x->[2]->[3] # '', '', [ [ undef, 1 ], undef, [ ] ] # +strict +fetch
+$x->[0]->[1] = 1 # exists $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +strict +exists
+$x->[0]->[1] = 1 # exists $x->[0]->[3] # '', '', [ [ undef, 1 ] ] # +strict +exists
+$x->[0]->[1] = 1 # exists $x->[2]->[3] # qr/^Reference vivification forbidden/, undef, [ [ undef, 1 ] ] # +strict +exists
+$x->[0]->[1] = 1 # exists $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +strict +delete
+$x->[0]->[1] = 1 # exists $x->[0]->[3] # '', '', [ [ undef, 1 ] ] # +strict +delete
+$x->[0]->[1] = 1 # exists $x->[2]->[3] # '', '', [ [ undef, 1 ], undef, [ ] ] # +strict +delete
+$x->[0]->[1] = 1 # exists $x->[0]->[1] # '', 1, [ [ undef, 1 ] ] # +strict +store
+$x->[0]->[1] = 1 # exists $x->[0]->[3] # '', '', [ [ undef, 1 ] ] # +strict +store
+$x->[0]->[1] = 1 # exists $x->[2]->[3] # '', '', [ [ undef, 1 ], undef, [ ] ] # +strict +store
+
+--- delete ---
+
+$x # delete $x->[0] # '', undef, [ ]
+$x # delete $x->[0] # '', undef, undef #
+$x # delete $x->[0] # '', undef, [ ] # +fetch
+$x # delete $x->[0] # '', undef, [ ] # +exists
+$x # delete $x->[0] # '', undef, undef # +delete
+$x # delete $x->[0] # '', undef, [ ] # +store
+
+$x # delete $x->[0] # '', undef, [ ] # +strict +fetch
+$x # delete $x->[0] # '', undef, [ ] # +strict +exists
+$x # delete $x->[0] # qr/^Reference vivification forbidden/, undef, undef # +strict +delete
+$x # delete $x->[0] # '', undef, [ ] # +strict +store
+
+$x # delete $x->[0]->[1] # '', undef, [ [ ] ]
+$x # delete $x->[0]->[1] # '', undef, undef #
+$x # delete $x->[0]->[1] # '', undef, [ [ ] ] # +fetch
+$x # delete $x->[0]->[1] # '', undef, [ [ ] ] # +exists
+$x # delete $x->[0]->[1] # '', undef, undef # +delete
+$x # delete $x->[0]->[1] # '', undef, [ [ ] ] # +store
+
+$x # delete $x->[0]->[1] # '', undef, [ [ ] ] # +strict +fetch
+$x # delete $x->[0]->[1] # '', undef, [ [ ] ] # +strict +exists
+$x # delete $x->[0]->[1] # qr/^Reference vivification forbidden/, undef, undef # +strict +delete
+$x # delete $x->[0]->[1] # '', undef, [ [ ] ] # +strict +store
+
+$x->[0] = 1 # delete $x->[0] # '', 1, [ ] # +fetch
+$x->[0] = 1 # delete $x->[1] # '', undef, [ 1 ] # +fetch
+$x->[0] = 1 # delete $x->[0] # '', 1, [ ] # +exists
+$x->[0] = 1 # delete $x->[1] # '', undef, [ 1 ] # +exists
+$x->[0] = 1 # delete $x->[0] # '', 1, [ ] # +delete
+$x->[0] = 1 # delete $x->[1] # '', undef, [ 1 ] # +delete
+$x->[0] = 1 # delete $x->[0] # '', 1, [ ] # +store
+$x->[0] = 1 # delete $x->[1] # '', undef, [ 1 ] # +store
+
+$x->[0] = 1 # delete $x->[0] # '', 1, [ ] # +strict +fetch
+$x->[0] = 1 # delete $x->[1] # '', undef, [ 1 ] # +strict +fetch
+$x->[0] = 1 # delete $x->[0] # '', 1, [ ] # +strict +exists
+$x->[0] = 1 # delete $x->[1] # '', undef, [ 1 ] # +strict +exists
+$x->[0] = 1 # delete $x->[0] # '', 1, [ ] # +strict +delete
+$x->[0] = 1 # delete $x->[1] # '', undef, [ 1 ] # +strict +delete
+$x->[0] = 1 # delete $x->[0] # '', 1, [ ] # +strict +store
+$x->[0] = 1 # delete $x->[1] # '', undef, [ 1 ] # +strict +store
+
+$x->[0]->[1] = 1 # delete $x->[0]->[1] # '', 1, [ [ ] ] # +fetch
+$x->[0]->[1] = 1 # delete $x->[0]->[3] # '', undef, [ [ undef, 1 ] ]# +fetch
+$x->[0]->[1] = 1 # delete $x->[2]->[3] # '', undef, [ [ undef, 1 ], undef, [ ] ] # +fetch
+$x->[0]->[1] = 1 # delete $x->[0]->[1] # '', 1, [ [ ] ] # +exists
+$x->[0]->[1] = 1 # delete $x->[0]->[3] # '', undef, [ [ undef, 1 ] ]# +exists
+$x->[0]->[1] = 1 # delete $x->[2]->[3] # '', undef, [ [ undef, 1 ], undef, [ ] ] # +exists
+$x->[0]->[1] = 1 # delete $x->[0]->[1] # '', 1, [ [ ] ] # +delete
+$x->[0]->[1] = 1 # delete $x->[0]->[3] # '', undef, [ [ undef, 1 ] ]# +delete
+$x->[0]->[1] = 1 # delete $x->[2]->[3] # '', undef, [ [ undef, 1 ] ]# +delete
+$x->[0]->[1] = 1 # delete $x->[0]->[1] # '', 1, [ [ ] ] # +store
+$x->[0]->[1] = 1 # delete $x->[0]->[3] # '', undef, [ [ undef, 1 ] ]# +store
+$x->[0]->[1] = 1 # delete $x->[2]->[3] # '', undef, [ [ undef, 1 ], undef, [ ] ] # +store
+
+$x->[0]->[1] = 1 # delete $x->[0]->[1] # '', 1, [ [ ] ] # +strict +fetch
+$x->[0]->[1] = 1 # delete $x->[0]->[3] # '', undef, [ [ undef, 1 ] ] # +strict +fetch
+$x->[0]->[1] = 1 # delete $x->[2]->[3] # '', undef, [ [ undef, 1 ], undef, [ ] ]# +strict +fetch
+$x->[0]->[1] = 1 # delete $x->[0]->[1] # '', 1, [ [ ] ] # +strict +exists
+$x->[0]->[1] = 1 # delete $x->[0]->[3] # '', undef, [ [ undef, 1 ] ] # +strict +exists
+$x->[0]->[1] = 1 # delete $x->[2]->[3] # '', undef, [ [ undef, 1 ], undef, [ ] ]# +strict +exists
+$x->[0]->[1] = 1 # delete $x->[0]->[1] # '', 1, [ [ ] ] # +strict +delete
+$x->[0]->[1] = 1 # delete $x->[0]->[3] # '', undef, [ [ undef, 1 ] ] # +strict +delete
+$x->[0]->[1] = 1 # delete $x->[2]->[3] # qr/^Reference vivification forbidden/, undef, [ [ undef, 1 ] ] # +strict +delete
+$x->[0]->[1] = 1 # delete $x->[0]->[1] # '', 1, [ [ ] ] # +strict +store
+$x->[0]->[1] = 1 # delete $x->[0]->[3] # '', undef, [ [ undef, 1 ] ] # +strict +store
+$x->[0]->[1] = 1 # delete $x->[2]->[3] # '', undef, [ [ undef, 1 ], undef, [ ] ]# +strict +store
+
+--- store ---
+
+$x # $x->[0] = 1 # '', 1, [ 1 ]
+$x # $x->[0] = 1 # '', 1, [ 1 ] #
+$x # $x->[0] = 1 # '', 1, [ 1 ] # +fetch
+$x # $x->[0] = 1 # '', 1, [ 1 ] # +exists
+$x # $x->[0] = 1 # '', 1, [ 1 ] # +delete
+$x # $x->[0] = 1 # qr/^Can't vivify reference/, undef, undef # +store
+
+$x # $x->[0] = 1 # '', 1, [ 1 ] # +strict +fetch
+$x # $x->[0] = 1 # '', 1, [ 1 ] # +strict +exists
+$x # $x->[0] = 1 # '', 1, [ 1 ] # +strict +delete
+$x # $x->[0] = 1 # qr/^Reference vivification forbidden/, undef, undef # +strict +store
+
+$x # $x->[0]->[1] = 1 # '', 1, [ [ undef, 1 ] ]
+$x # $x->[0]->[1] = 1 # '', 1, [ [ undef, 1 ] ] #
+$x # $x->[0]->[1] = 1 # '', 1, [ [ undef, 1 ] ] # +fetch
+$x # $x->[0]->[1] = 1 # '', 1, [ [ undef, 1 ] ] # +exists
+$x # $x->[0]->[1] = 1 # '', 1, [ [ undef, 1 ] ] # +delete
+$x # $x->[0]->[1] = 1 # qr/^Can't vivify reference/, undef, undef # +store
+
+$x # $x->[0]->[1] = 1 # '', 1, [ [ undef, 1 ] ] # +strict +fetch
+$x # $x->[0]->[1] = 1 # '', 1, [ [ undef, 1 ] ] # +strict +exists
+$x # $x->[0]->[1] = 1 # '', 1, [ [ undef, 1 ] ] # +strict +delete
+$x # $x->[0]->[1] = 1 # qr/^Reference vivification forbidden/, undef, undef # +strict +store
+
+$x->[0] = 1 # $x->[0] = 2 # '', 2, [ 2 ] # +fetch
+$x->[0] = 1 # $x->[1] = 2 # '', 2, [ 1, 2 ] # +fetch
+$x->[0] = 1 # $x->[0] = 2 # '', 2, [ 2 ] # +exists
+$x->[0] = 1 # $x->[1] = 2 # '', 2, [ 1, 2 ] # +exists
+$x->[0] = 1 # $x->[0] = 2 # '', 2, [ 2 ] # +delete
+$x->[0] = 1 # $x->[1] = 2 # '', 2, [ 1, 2 ] # +delete
+$x->[0] = 1 # $x->[0] = 2 # '', 2, [ 2 ] # +store
+$x->[0] = 1 # $x->[1] = 2 # '', 2, [ 1, 2 ] # +store
+
+$x->[0] = 1 # $x->[0] = 2 # '', 2, [ 2 ] # +strict +fetch
+$x->[0] = 1 # $x->[1] = 2 # '', 2, [ 1, 2 ] # +strict +fetch
+$x->[0] = 1 # $x->[0] = 2 # '', 2, [ 2 ] # +strict +exists
+$x->[0] = 1 # $x->[1] = 2 # '', 2, [ 1, 2 ] # +strict +exists
+$x->[0] = 1 # $x->[0] = 2 # '', 2, [ 2 ] # +strict +delete
+$x->[0] = 1 # $x->[1] = 2 # '', 2, [ 1, 2 ] # +strict +delete
+$x->[0] = 1 # $x->[0] = 2 # '', 2, [ 2 ] # +strict +store
+$x->[0] = 1 # $x->[1] = 2 # '', 2, [ 1, 2 ] # +strict +store
+
+$x->[0]->[1] = 1 # $x->[0]->[1] = 2 # '', 2, [ [ undef, 2 ] ] # +fetch
+$x->[0]->[1] = 1 # $x->[0]->[3] = 2 # '', 2, [ [ undef, 1, undef, 2 ] ] # +fetch
+$x->[0]->[1] = 1 # $x->[2]->[3] = 2 # '', 2, [ [ undef, 1 ], undef, [ undef, undef, undef, 2 ] ] # +fetch
+$x->[0]->[1] = 1 # $x->[0]->[1] = 2 # '', 2, [ [ undef, 2 ] ] # +exists
+$x->[0]->[1] = 1 # $x->[0]->[3] = 2 # '', 2, [ [ undef, 1, undef, 2 ] ] # +exists
+$x->[0]->[1] = 1 # $x->[2]->[3] = 2 # '', 2, [ [ undef, 1 ], undef, [ undef, undef, undef, 2 ] ] # +exists
+$x->[0]->[1] = 1 # $x->[0]->[1] = 2 # '', 2, [ [ undef, 2 ] ] # +delete
+$x->[0]->[1] = 1 # $x->[0]->[3] = 2 # '', 2, [ [ undef, 1, undef, 2 ] ] # +delete
+$x->[0]->[1] = 1 # $x->[2]->[3] = 2 # '', 2, [ [ undef, 1 ], undef, [ undef, undef, undef, 2 ] ] # +delete
+$x->[0]->[1] = 1 # $x->[0]->[1] = 2 # '', 2, [ [ undef, 2 ] ] # +store
+$x->[0]->[1] = 1 # $x->[0]->[3] = 2 # '', 2, [ [ undef, 1, undef, 2 ] ] # +store
+$x->[0]->[1] = 1 # $x->[2]->[3] = 2 # qr/^Can't vivify reference/, undef, [ [ undef, 1 ] ] # +store
+
+$x->[0]->[1] = 1 # $x->[0]->[1] = 2 # '', 2, [ [ undef, 2 ] ] # +strict +fetch
+$x->[0]->[1] = 1 # $x->[0]->[3] = 2 # '', 2, [ [ undef, 1, undef, 2 ] ] # +strict +fetch
+$x->[0]->[1] = 1 # $x->[2]->[3] = 2 # '', 2, [ [ undef, 1 ], undef, [ undef, undef, undef, 2 ] ] # +strict +fetch
+$x->[0]->[1] = 1 # $x->[0]->[1] = 2 # '', 2, [ [ undef, 2 ] ] # +strict +exists
+$x->[0]->[1] = 1 # $x->[0]->[3] = 2 # '', 2, [ [ undef, 1, undef, 2 ] ] # +strict +exists
+$x->[0]->[1] = 1 # $x->[2]->[3] = 2 # '', 2, [ [ undef, 1 ], undef, [ undef, undef, undef, 2 ] ] # +strict +exists
+$x->[0]->[1] = 1 # $x->[0]->[1] = 2 # '', 2, [ [ undef, 2 ] ] # +strict +delete
+$x->[0]->[1] = 1 # $x->[0]->[3] = 2 # '', 2, [ [ undef, 1, undef, 2 ] ] # +strict +delete
+$x->[0]->[1] = 1 # $x->[2]->[3] = 2 # '', 2, [ [ undef, 1 ], undef, [ undef, undef, undef, 2 ] ] # +strict +delete
+$x->[0]->[1] = 1 # $x->[0]->[1] = 2 # '', 2, [ [ undef, 2 ] ] # +strict +store
+$x->[0]->[1] = 1 # $x->[0]->[3] = 2 # '', 2, [ [ undef, 1, undef, 2 ] ] # +strict +store
+$x->[0]->[1] = 1 # $x->[2]->[3] = 2 # qr/^Reference vivification forbidden/, undef, [ [ undef, 1 ] ] # +strict +store
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+use lib 't/lib';
+
+our $blurp;
+
+{
+ local $blurp;
+ eval 'no autovivification; use autovivification::TestRequired1; $blurp->{x}';
+ is $@, '', 'first require test doesn\'t croak prematurely';
+ is_deeply $blurp, { r1_main => { }, r1_eval => { } },
+ 'first require vivified correctly';
+}
+
+{
+ local $blurp;
+ eval 'no autovivification; use autovivification::TestRequired2; $blurp->{a}';
+ is $@, '', 'second require test doesn\'t croak prematurely';
+ my $expect;
+ $expect = { r1_main => { }, r1_eval => { } };
+ $expect->{r2_eval} = { } if $] < 5.009005;
+ is_deeply $blurp, $expect, 'second require test didn\'t vivify';
+}
+
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod::Coverage
+my $min_tpc = 1.08;
+eval "use Test::Pod::Coverage $min_tpc";
+plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@;
+
+# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
+# but older versions don't recognize some common documentation styles
+my $min_pc = 0.18;
+eval "use Pod::Coverage $min_pc";
+plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@;
+
+all_pod_coverage_ok({ also_private => [ qr/^A_HINT_/ ] });
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Portability::Files";
+plan skip_all => "Test::Portability::Files required for testing filenames portability" if $@;
+run_tests();
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval { require Test::Kwalitee; Test::Kwalitee->import() };
+plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@;
--- /dev/null
+package autovivification::TestRequired1;
+
+my $x = $main::blurp->{r1_main}->{vivify};
+
+eval 'my $y = $main::blurp->{r1_eval}->{vivify}';
+
+1;
--- /dev/null
+package autovivification::TestRequired2;
+
+no autovivification;
+
+BEGIN {
+# use autovivification "delete";
+ use autovivification;
+ delete $INC{'autovivification/TestRequired1.pm'};
+}
+
+use lib 't/lib';
+use autovivification::TestRequired1;
+
+my $x = $main::blurp->{r2_main}->{vivify};
+
+eval 'my $y = $main::blurp->{r2_eval}->{vivify}';
+
+1;
projects / perl / modules / autovivification.git / commitdiff