From 3fbf7664942dabbfafd65e86412b7ad494948bf8 Mon Sep 17 00:00:00 2001
From: Graham Knop <haarg@haarg.org>
Date: Tue, 23 May 2023 14:26:53 +0200
Subject: [PATCH] is_deeply: fix handling of VSTRING and LVALUE refs

VSTRING and LVALUE are possible return types from ref, but they are
essentially special cases of SCALAR refs. As far as is_deeply is
concerned, they should be treated as equivalent.

Update the _type function to normalize VSTRING and LVALUE into SCALAR,
so that the deep checks properly treat them as equivalent.

This fixes errors from doing comparisons with LVALUE refs, as well as
fixing VSTRINGs comparing equal to an equivalent normal SCALAR string.
---
 lib/Test/More.pm          | 19 +++++++++++++++++--
 t/Legacy/is_deeply_fail.t | 30 +++++++++++++++++++++++++++++-
 2 files changed, 46 insertions(+), 3 deletions(-)
 mode change 100644 => 100755 t/Legacy/is_deeply_fail.t

diff --git a/lib/Test/More.pm b/lib/Test/More.pm
index 55f70e33a..affc1ab6e 100644
--- a/lib/Test/More.pm
+++ b/lib/Test/More.pm
@@ -1206,13 +1206,28 @@ sub _format_stack {
     return $out;
 }
 
+my %_types = (
+  (map +($_ => $_), qw(
+    Regexp
+    ARRAY
+    HASH
+    SCALAR
+    REF
+    GLOB
+    CODE
+  )),
+  'LVALUE'  => 'SCALAR',
+  'REF'     => 'SCALAR',
+  'VSTRING' => 'SCALAR',
+);
+
 sub _type {
     my $thing = shift;
 
     return '' if !ref $thing;
 
-    for my $type (qw(Regexp ARRAY HASH REF SCALAR GLOB CODE VSTRING)) {
-        return $type if UNIVERSAL::isa( $thing, $type );
+    for my $type (keys %_types) {
+        return $_types{$type} if UNIVERSAL::isa( $thing, $type );
     }
 
     return '';
diff --git a/t/Legacy/is_deeply_fail.t b/t/Legacy/is_deeply_fail.t
old mode 100644
new mode 100755
index c43b3a2e1..cab70e267
--- a/t/Legacy/is_deeply_fail.t
+++ b/t/Legacy/is_deeply_fail.t
@@ -26,7 +26,7 @@ package main;
 
 
 my $TB = Test::Builder->create;
-$TB->plan(tests => 102);
+$TB->plan(tests => 110);
 
 # Utility testing functions.
 sub ok ($;$) {
@@ -428,3 +428,31 @@ ERR
     ok !is_deeply( [\\$version1], [\\$version2], "version objects");
     is( $out, "not ok 42 - version objects\n" );
 }
+
+{
+    my $version1 = v1.2.3;
+    my $version2 = '' . v1.2.3;
+    ok is_deeply( [\$version1], [\$version2], "version objects");
+    is( $out, "ok 43 - version objects\n" );
+}
+
+{
+    my $version1 = v1.2.3;
+    my $version2 = v1.2.3;
+    ok !is_deeply( [$version1], [\$version2], "version objects");
+    is( $out, "not ok 44 - version objects\n" );
+}
+
+{
+    my $string = "abc";
+    my $string2 = "b";
+    ok is_deeply( [\substr($string, 1, 1)], [\$string2], "lvalue ref");
+    is( $out, "ok 45 - lvalue ref\n" );
+}
+
+{
+    my $string = "b";
+    my $string2 = "b";
+    ok !is_deeply( [\substr($string, 1, 1)], ["b"], "lvalue ref");
+    is( $out, "not ok 46 - lvalue ref\n" );
+}