dump.c - add ways to dump HV's and AV's and SV's to any depth.

Currently you can use sv_dump() to dump an AV or HV as these are
still SV's underneath in C terms, but it will only dump out the top
level object and will not dump out its contents, whereas if you have
an RV which references the same AV or HV it will dump it out to depth
of 4.

This adds av_dump() and hv_dump() which dump up to a depth of 3 (thus
matching what sv_dump() would have showed had it been used to dump
an RV to the same object). It also adds sv_dump_depth() which allows
passing in an arbitrary depth. You could argue the former are redundant
in light of sv_dump_depth(), but the av_dump() and hv_dump() variants
do not require a cast for their arguments.

These functions are provided as debugging aids for development. They
aren't used directly in the core, and they all wrap the same core
routine that is used for sv_dump() (do_sv_dump()).

4 files changed, 51 insertions, 3 deletions

diff --git a/dump.c b/dump.c
index eed8c86a85..1c78218bef 100644
--- a/dump.c
+++ b/dump.c
@@ -2661,7 +2661,25 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 
 Dumps the contents of an SV to the C<STDERR> filehandle.
 
-For an example of its output, see L<Devel::Peek>.
+For an example of its output, see L<Devel::Peek>. If
+the item is an SvROK it will dump items to a depth of 4,
+otherwise it will dump only the top level item, which
+means that it will not dump the contents of an AV * or
+HV *. For that use C<av_dump()> or C<hv_dump()>.
+
+=for apidoc av_dump
+
+Dumps the contents of an AV to the C<STDERR> filehandle,
+Similar to using Devel::Peek on an arrayref but does not
+expect an RV wrapper. Dumps contents to a depth of 3 levels
+deep.
+
+=for apidoc hv_dump
+
+Dumps the contents of an HV to the C<STDERR> filehandle.
+Similar to using Devel::Peek on an hashref but does not
+expect an RV wrapper. Dumps contents to a depth of 3 levels
+deep.
 
 =cut
 */
@@ -2670,9 +2688,27 @@ void
 Perl_sv_dump(pTHX_ SV *sv)
 {
     if (sv && SvROK(sv))
-        do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
+        sv_dump_depth(sv, 4);
     else
-        do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
+        sv_dump_depth(sv, 0);
+}
+
+void
+Perl_sv_dump_depth(pTHX_ SV *sv, I32 depth)
+{
+    do_sv_dump(0, Perl_debug_log, sv, 0, depth, 0, 0);
+}
+
+void
+Perl_av_dump(pTHX_ AV *av)
+{
+    sv_dump_depth((SV*)av, 3);
+}
+
+void
+Perl_hv_dump(pTHX_ HV *hv)
+{
+    sv_dump_depth((SV*)hv, 3);
 }
 
 int
diff --git a/embed.fnc b/embed.fnc
index ebb3176139..6d1b6e92e8 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1877,6 +1877,9 @@ Apd	|int	|getcwd_sv	|NN SV* sv
 Apd	|void	|sv_dec		|NULLOK SV *const sv
 Apd	|void	|sv_dec_nomg	|NULLOK SV *const sv
 Apd	|void	|sv_dump	|NULLOK SV* sv
+Apd	|void	|sv_dump_depth	|NULLOK SV* sv|I32 depth
+Apd	|void	|av_dump	|NULLOK AV* av
+Apd	|void	|hv_dump	|NULLOK HV* hv
 ApdR	|bool	|sv_derived_from|NN SV* sv|NN const char *const name
 ApdR	|bool	|sv_derived_from_sv|NN SV* sv|NN SV *namesv|U32 flags
 ApdR	|bool	|sv_derived_from_pv|NN SV* sv|NN const char *const name|U32 flags
diff --git a/embed.h b/embed.h
index 3e19de9bd1..f67897f664 100644
--- a/embed.h
+++ b/embed.h
@@ -65,6 +65,7 @@
 #define av_clear(a)		Perl_av_clear(aTHX_ a)
 #define av_count(a)		Perl_av_count(aTHX_ a)
 #define av_delete(a,b,c)	Perl_av_delete(aTHX_ a,b,c)
+#define av_dump(a)		Perl_av_dump(aTHX_ a)
 #define av_exists(a,b)		Perl_av_exists(aTHX_ a,b)
 #define av_extend(a,b)		Perl_av_extend(aTHX_ a,b)
 #define av_fetch(a,b,c)		Perl_av_fetch(aTHX_ a,b,c)
@@ -241,6 +242,7 @@
 #define hv_common_key_len(a,b,c,d,e,f)	Perl_hv_common_key_len(aTHX_ a,b,c,d,e,f)
 #define hv_copy_hints_hv(a)	Perl_hv_copy_hints_hv(aTHX_ a)
 #define hv_delayfree_ent(a,b)	Perl_hv_delayfree_ent(aTHX_ a,b)
+#define hv_dump(a)		Perl_hv_dump(aTHX_ a)
 #define hv_free_ent(a,b)	Perl_hv_free_ent(aTHX_ a,b)
 #define hv_iterinit(a)		Perl_hv_iterinit(aTHX_ a)
 #define hv_iterkey(a,b)		Perl_hv_iterkey(aTHX_ a,b)
@@ -592,6 +594,7 @@
 #define sv_does_pvn(a,b,c,d)	Perl_sv_does_pvn(aTHX_ a,b,c,d)
 #define sv_does_sv(a,b,c)	Perl_sv_does_sv(aTHX_ a,b,c)
 #define sv_dump(a)		Perl_sv_dump(aTHX_ a)
+#define sv_dump_depth(a,b)	Perl_sv_dump_depth(aTHX_ a,b)
 #define sv_eq_flags(a,b,c)	Perl_sv_eq_flags(aTHX_ a,b,c)
 #define sv_force_normal_flags(a,b)	Perl_sv_force_normal_flags(aTHX_ a,b)
 #define sv_free(a)		Perl_sv_free(aTHX_ a)
diff --git a/proto.h b/proto.h
index bb9975e243..f4f762ef0d 100644
--- a/proto.h
+++ b/proto.h
@@ -295,6 +295,8 @@ PERL_CALLCONV SV**	Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *cons
 PERL_CALLCONV SV*	Perl_av_delete(pTHX_ AV *av, SSize_t key, I32 flags);
 #define PERL_ARGS_ASSERT_AV_DELETE	\
 	assert(av)
+PERL_CALLCONV void	Perl_av_dump(pTHX_ AV* av);
+#define PERL_ARGS_ASSERT_AV_DUMP
 PERL_CALLCONV bool	Perl_av_exists(pTHX_ AV *av, SSize_t key)
 			__attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_AV_EXISTS	\
@@ -1613,6 +1615,8 @@ PERL_CALLCONV SV*	Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 has
 #define PERL_ARGS_ASSERT_HV_DELETE_ENT	\
 	assert(keysv)
 #endif
+PERL_CALLCONV void	Perl_hv_dump(pTHX_ HV* hv);
+#define PERL_ARGS_ASSERT_HV_DUMP
 PERL_CALLCONV HE**	Perl_hv_eiter_p(pTHX_ HV *hv)
 			__attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_HV_EITER_P	\
@@ -3929,6 +3933,8 @@ PERL_CALLCONV bool	Perl_sv_does_sv(pTHX_ SV* sv, SV* namesv, U32 flags)
 
 PERL_CALLCONV void	Perl_sv_dump(pTHX_ SV* sv);
 #define PERL_ARGS_ASSERT_SV_DUMP
+PERL_CALLCONV void	Perl_sv_dump_depth(pTHX_ SV* sv, I32 depth);
+#define PERL_ARGS_ASSERT_SV_DUMP_DEPTH
 #ifndef NO_MATHOMS
 PERL_CALLCONV I32	Perl_sv_eq(pTHX_ SV* sv1, SV* sv2);
 #define PERL_ARGS_ASSERT_SV_EQ