From 37df788ffcc8130a22846fe68296da3a469c64e6 Mon Sep 17 00:00:00 2001
From: Alexandr Evstigneev <Alexandr.Evstigneev@jetbrains.com>
Date: Tue, 15 Jun 2021 18:04:28 +0300
Subject: [PATCH] Release 2021.1 fixed cyclic references crash

Fixes #33
Fixes #56
---
 Changes                             |  3 +++
 lib/Devel/Camelcadedb.pm            | 33 +++++++++++++++++++++++------
 t/reference_descriptor_serializer.t | 23 ++++++++++++++++++++
 3 files changed, 53 insertions(+), 6 deletions(-)
 create mode 100644 t/reference_descriptor_serializer.t

diff --git a/Changes b/Changes
index fa26b5b..b8df166 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Devel-Camelcadedb
 
+2021.1
+        Fixed crash on cyclic references rendering, #38 #56
+
 2020.3
         Taint mode support, by @djstauffer
         Typo fixes, by @HenkPoley
diff --git a/lib/Devel/Camelcadedb.pm b/lib/Devel/Camelcadedb.pm
index 2a82500..b4e6c15 100644
--- a/lib/Devel/Camelcadedb.pm
+++ b/lib/Devel/Camelcadedb.pm
@@ -1,6 +1,6 @@
 package Devel::Camelcadedb;
 # must be quoted to work correctly with JSON protocol
-our $VERSION = "v2020.3"; # DO NOT REMOVE FUCKING v, IT KEEPS PROPER VERSIONING
+our $VERSION = "v2021.1"; # DO NOT REMOVE FUCKING v, IT KEEPS PROPER VERSIONING
 
 # to ensure protocol compatibility between the IDE and the debugger, we will use $API_VERSION variable, to be able
 # to bump debugger version without necessity to update IDE part.
@@ -550,7 +550,7 @@ sub _from_utf8
 
 sub _get_reference_descriptor
 {
-    my ($name, $value) = @_;
+    my ($name, $value, $uniq_map) = @_;
 
     my $key = $value;
     my $reftype = Scalar::Util::reftype( $value );
@@ -567,6 +567,7 @@ sub _get_reference_descriptor
     my $fileno = undef;
     my $rendered = undef;
     my $rendered_error = \0;
+    my $error = undef;
     my $tied;
 
     if (!$reftype)
@@ -585,9 +586,18 @@ sub _get_reference_descriptor
     }
     elsif ($reftype eq 'REF')
     {
-        my $result = _get_reference_descriptor( $name, $$value );
-        $result->{ref_depth}++;
-        return $result;
+        $uniq_map //= {};
+        if( exists $uniq_map->{$type} ){
+            $value = "Cyclic reference to $type";
+            $error = 1;
+        }
+        else{
+            $uniq_map->{$type} = 1;
+            my $result = _get_reference_descriptor( $name, $$value, $uniq_map );
+            $result->{ref_depth}++;
+            return $result;
+        }
+
     }
     elsif ($reftype eq 'ARRAY')
     {
@@ -688,7 +698,18 @@ sub _get_reference_descriptor
     }
     $result->{layers} = $layers if $layers;
     $result->{fileno} = "".$fileno if defined $fileno;
-    $result->{tied_with} = _get_reference_descriptor(object => $tied) if $tied;
+    if( $tied){
+        $uniq_map //= {};
+        if( exists $uniq_map->{$type} ){
+            $result->{tied_with} = "Cyclic reference to $type";
+            $result->{error} = \1;
+        }
+        else {
+            $uniq_map->{$type} = 1;
+            $result->{tied_with} = _get_reference_descriptor(object => $tied, $uniq_map);
+        }
+    }
+    $result->{error} = \1 if $error;
 
     return $result;
 }
diff --git a/t/reference_descriptor_serializer.t b/t/reference_descriptor_serializer.t
new file mode 100644
index 0000000..7976f15
--- /dev/null
+++ b/t/reference_descriptor_serializer.t
@@ -0,0 +1,23 @@
+#!perl -T
+use v5.10;
+use strict;
+use warnings;
+use Test::More;
+use Data::Dumper;
+
+subtest "Cyclic reference" => sub{
+    $ENV{PERL5_DEBUG_AUTOSTART} = 0;
+    $ENV{PERL5_DEBUG_ROLE} = 'server';
+    $ENV{PERL5_DEBUG_HOST} = 'localhost';
+    $ENV{PERL5_DEBUG_PORT} = 42;
+    require Devel::Camelcadedb;
+
+    my $reference = 'test';
+    my $reference2 = \$reference;
+    my $reference3 = \$reference2;
+    $reference = \$reference3;
+    DB::_get_reference_descriptor("testname", $reference);
+    pass();
+};
+
+done_testing();
\ No newline at end of file