view release on metacpan or  search on metacpan

t/roundtrip.t  view on Meta::CPAN

#!/usr/bin/env perl
# encode round-trip tests for the XS DMS parser. Mirrors the pure-Perl
# port's t/roundtrip.t. SPEC v0.14 renamed parse/to_dms to decode/encode.
#
# Caveat: the underlying C parser does not yet record original_forms,
# so integer-base / string-form preservation tests are weakened to
# data-equivalence checks (the emitter falls back to default forms:
# decimal integers, basic-quoted strings). Comments, structure, and
# overall round-trip stability still hold.
use strict;
use warnings;
use Test::More;
use FindBin;
use lib "$FindBin::Bin/../lib";
use lib "$FindBin::Bin/../blib/lib";
use lib "$FindBin::Bin/../blib/arch";
use DMS::XS::Parser;

sub roundtrip {
    my ($src) = @_;
    my $doc = DMS::XS::Parser::decode_document($src);
    return DMS::XS::Parser::encode($doc);
}

# 1. Integer body equivalence after round-trip (byte-identical literal
# forms not guaranteed without C-side original_forms recording).
{
    my $src = "a: 0x1F40\nb: 0o755\nc: 0b1010_0110\nd: 1_000_000\ne: +42\nf: -7\n";
    my $out = roundtrip($src);
    my $d1 = DMS::XS::Parser::decode_document($src);
    my $d2 = DMS::XS::Parser::decode_document($out);
    is_deeply($d2->{body}, $d1->{body}, 'integer body equivalent after round-trip');
}

# 2. String body equivalence.
{
    my $src = qq{basic: "hello"
lit: 'C:\\path'
hd_b_lab: """END
  hello
  END
};
    my $out = roundtrip($src);
    my $d1 = DMS::XS::Parser::decode_document($src);
    my $d2 = DMS::XS::Parser::decode_document($out);
    is_deeply($d2->{body}, $d1->{body}, 'string body equivalent after round-trip');
}

# 3. Comments at attached paths preserved.
{
    my $src = "# leading on a\n"
            . "a: 1   # trailing on a\n"
            . "b:\n"
            . "  x: 2\n"
            . "  # floating in b\n";
    my $out = roundtrip($src);
    my $d2 = DMS::XS::Parser::decode_document($out);
    is(scalar @{ $d2->{comments} }, 3, 'three comments survive round-trip');
    my ($have_l, $have_t, $have_f) = (0, 0, 0);
    for my $ac (@{ $d2->{comments} }) {
        my $pos = $ac->{position};
        my @path = @{ $ac->{path} };
        if ($pos eq 'leading'  && @path == 1 && !ref($path[0]) && $path[0] eq 'a') { $have_l = 1; }
        if ($pos eq 'trailing' && @path == 1 && !ref($path[0]) && $path[0] eq 'a') { $have_t = 1; }
        if ($pos eq 'floating' && @path == 1 && !ref($path[0]) && $path[0] eq 'b') { $have_f = 1; }
    }