Fix -dumpcode option

It didn't work for blessed coderefs
perlpunk · Apr 29, 2023 · 5222a05 · 5222a05
1 parent 900ccfe
commit 5222a05
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 23 deletions.
diff --git a/lib/YAML/PP/Schema/Perl.pm b/lib/YAML/PP/Schema/Perl.pm
@@ -360,26 +360,14 @@ sub register {
             $node->{data} = $self->represent_ref($node->{value});
         },
     );
-    if ($dumpcode) {
-        $schema->add_representer(
-            coderef => 1,
-            code => sub {
-                my ($rep, $node) = @_;
-                $node->{tag} = $perl_tag . "/code";
-                $node->{data} = $self->represent_code($node->{value});
-            },
-        );
-    }
-    else {
-        $schema->add_representer(
-            coderef => 1,
-            code => sub {
-                my ($rep, $node) = @_;
-                $node->{tag} = $perl_tag . "/code";
-                $node->{data} = '{ "DUMMY" }';
-            },
-        );
-    }
+    $schema->add_representer(
+        coderef => 1,
+        code => sub {
+            my ($rep, $node) = @_;
+            $node->{tag} = $perl_tag . "/code";
+            $node->{data} = $dumpcode ? $self->represent_code($node->{value}) : '{ "DUMMY" }';
+        },
+    );
     $schema->add_representer(
         glob => 1,
         code => sub {
@@ -442,7 +430,7 @@ sub register {
             }
 
             elsif ($node->{reftype} eq 'CODE') {
-                $node->{data} = $self->represent_code($node->{value});
+                $node->{data} = $dumpcode ? $self->represent_code($node->{value}) : '{ "DUMMY" }';
             }
             elsif ($node->{reftype} eq 'GLOB') {
                 $node->{data} = $self->represent_glob($node->{value});

diff --git a/t/37.schema-perl.t b/t/37.schema-perl.t
@@ -352,11 +352,14 @@ EOM
 };
 
 subtest no_dumpcode => sub {
-    my $data = { foo => sub { 23 } };
+    my $code1 = sub { 23 };
+    my $code2 = sub { 23 };
+    my $data = { foo => bless ($code1, "Foo"), bar => $code2 };
     my $yaml = $yp_no_dumpcode->dump_string($data);
     my $exp = <<'EOM';
 ---
-foo: !perl/code '{ "DUMMY" }'
+bar: !perl/code '{ "DUMMY" }'
+foo: !perl/code:Foo '{ "DUMMY" }'
 EOM
     is $yaml, $exp, "Use -loadcode";
 };