Merge pull request #135 from toddr-bot/koan.toddr.bot/fix-null-type-tag-handling

fix: harden NULL type handling in tag parser

Author: toddr

MANIFEST

@@ -52,6 +52,7 @@ t/json-singlequote.t
 t/leak.t
 t/load-blessed.t
 t/str-type-regression.t
+t/strtok-null-type.t
 t/TestYAML.pm
 t/yaml-alias.t
 t/yaml-blessed-ref.t

perl_syck.h

@@ -337,10 +337,17 @@ yaml_syck_parser_handler
                 char *type = strtok(NULL, "");
 
                 if (lang == NULL || (strEQ(lang, "perl"))) {
-                    sv = newSVpv(type, 0);
+                    if (type != NULL) {
+                        sv = newSVpv(type, 0);
+                    } else {
+                        /* Tag has no type component (e.g. "!perl =") —
+                         * fall back to raw scalar content */
+                        sv = newSVpvn(n->data.str->ptr, n->data.str->len);
+                        CHECK_UTF8;
+                    }
                 }
                 else {
-                    sv = newSVpv(form((type == NULL) ? "%s" : "%s::%s", lang, type), 0);
+                    sv = newSVpv((type == NULL) ? lang : form("%s::%s", lang, type), 0);
                 }
                 Safefree(id_copy);
             } else if ( strEQ( id, "perl/scalar" ) || strnEQ( id, "perl/scalar:", 12 ) ) {
@@ -396,7 +403,7 @@ yaml_syck_parser_handler
 						}
 					}
 					else {
-						sv_bless(sv, gv_stashpv(form((type == NULL) ? "%s" : "%s::%s", lang, type), TRUE));
+						sv_bless(sv, gv_stashpv((type == NULL) ? lang : form("%s::%s", lang, type), TRUE));
 					}
                 }
                 Safefree(id_copy);
@@ -453,7 +460,7 @@ yaml_syck_parser_handler
                 		}
                 	}
                 	else {
-                		sv_bless(sv, gv_stashpv(form((type == NULL) ? "%s" : "%s::%s", lang, type), TRUE));
+                		sv_bless(sv, gv_stashpv((type == NULL) ? lang : form("%s::%s", lang, type), TRUE));
                 	}
                 }
                 Safefree(id_copy);
@@ -501,7 +508,7 @@ yaml_syck_parser_handler
 								}
 							}
 							else {
-								sv_bless(sv, gv_stashpv(form((type == NULL) ? "%s" : "%s::%s", lang, type), TRUE));
+								sv_bless(sv, gv_stashpv((type == NULL) ? lang : form("%s::%s", lang, type), TRUE));
 							}
 						Safefree(id_copy);
 					}
@@ -551,7 +558,7 @@ yaml_syck_parser_handler
 							}
 						}
 						else {
-							sv_bless(sv, gv_stashpv(form((type == NULL) ? "%s" : "%s::%s", lang, type), TRUE));
+							sv_bless(sv, gv_stashpv((type == NULL) ? lang : form("%s::%s", lang, type), TRUE));
 						}
 						Safefree(id_copy);
 					}
@@ -610,7 +617,7 @@ yaml_syck_parser_handler
 								sv_bless(sv, gv_stashpv(type, TRUE));
 							}
 						} else {
-							sv_bless(sv, gv_stashpv(form((type == NULL) ? "%s" : "%s::%s", lang, type), TRUE));
+							sv_bless(sv, gv_stashpv((type == NULL) ? lang : form("%s::%s", lang, type), TRUE));
 						}
                     }
                     Safefree(id_copy);

t/1-basic.t

@@ -15,20 +15,19 @@ is( Load("--- Hello, world\n"), "Hello, world" );
     is( $out, '--', "Load of '--' returns plain scalar" );
 }
 
-TODO: {
+# Syck is a permissive YAML 1.0 parser: empty strings and unstructured
+# text are not errors.  This matches YAML.pm and YAML::XS behavior.
+# See GH #127 for the design discussion.
+{
     my $out = eval { Load("") };
-    is( $out, undef, "Bad data fails load" );
-
-    local $TODO = 'Load fails on empty string';
-    isnt( $@, '', "Bad data dies on Load" );
+    is( $@, '', "Load('') does not die" );
+    is( $out, undef, "Load('') returns undef" );
 }
 
-TODO: {
+{
     my $out = eval { Load("feefifofum\n\n\ndkjdkdk") };
-
-    local $TODO = 'Load fails on empty string';
-    isnt( $@, '', "Bad data dies on Load" );
-    is( $out, undef, "Bad data fails load" );
+    is( $@, '', "Load of unstructured text does not die" );
+    like( $out, qr/^feefifofum/, "unstructured text is a plain scalar" );
 }
 
 TODO: {

t/strtok-null-type.t

@@ -0,0 +1,46 @@
+use strict;
+use warnings;
+use Test::More tests => 8;
+use YAML::Syck;
+
+# strtok() returns NULL for the type component when a YAML tag contains
+# no "/" or ":" delimiter (e.g. "!perl" with no subtype).  The scalar
+# ref handler passed the NULL type to newSVpv() without checking.
+# The form() calls in the blessing code also passed NULL type as an
+# unused variadic argument.
+
+# Test 1-2: tag with no type component + ref-literal content "="
+# The "=" prefix is REF_LITERAL — triggers the scalar-ref code path
+{
+    my $yaml = "--- !perl =\n";
+    my $result = eval { YAML::Syck::Load($yaml) };
+    ok(!$@, "Load tag with no type + ref-literal content doesn't crash")
+        or diag "Error: $@";
+    is($result, '=', "falls back to raw scalar content when type is NULL");
+}
+
+# Test 3-4: custom (non-perl) tag with no type delimiter
+{
+    my $yaml = "--- !custom =\n";
+    my $result = eval { YAML::Syck::Load($yaml) };
+    ok(!$@, "Load custom tag with no type + ref-literal doesn't crash")
+        or diag "Error: $@";
+    # With no type, custom lang produces just the lang name as the SV
+    is($result, 'custom', "custom lang with no type returns lang name");
+}
+
+# Test 5-6: tags with type component still work correctly
+{
+    my $yaml = "--- !perl/ref =\n";
+    my $result = eval { YAML::Syck::Load($yaml) };
+    ok(!$@, "Load perl/ref with ref-literal works");
+    is($result, 'ref', "perl/ref returns type name");
+}
+
+# Test 7-8: custom lang with type
+{
+    my $yaml = "--- !custom/type =\n";
+    my $result = eval { YAML::Syck::Load($yaml) };
+    ok(!$@, "Load custom/type with ref-literal works");
+    is($result, 'custom::type', "custom/type returns lang::type");
+}