<commit_before>use v6;
use Test;
# L<S02/Names and Variables/To get a Perlish representation of any object>

#?pugs emit plan 89;

my @tests = (
    # Basic scalar values
    42, 
    42/10, 
    4.2, 
    #?pugs emit #
    sqrt(2),
    3e5,
    Inf, -Inf, NaN,

    "a string", "", "\0", "\t", "\n", 
    "\r\n", 
    "\o7",
    '{', # "\d123",	# XXX there is no \d escape!!!
    '}',
    '$a @string %with &sigils()',
    'שלום',

    ?1, ?0,
    #?rakudo emit # Mu eq Mu is an error now
    #?niecza emit # Dunno what's wrong with this one
    #?pugs emit #
    Mu,
    #?rakudo emit # parse error
    #?niecza emit # Autoloading NYI
    #?pugs emit #
    rx:P5/foo/, rx:P5//, rx:P5/^.*$/,

    # References to scalars
    \42, \Inf, \-Inf, \NaN, \"string", \"", \?1, \?0, 

    #?pugs emit #
    \Mu,

    #?pugs emit #
    (a => 1),
    #?pugs emit #
    :b(2),

    # References to aggregates
    #?pugs emit #
    {},           # empty hash
    #?pugs emit #
    { a => 42 },  # only one elem
    #?pugs emit #
    { :a(1), :b(2), :c(3) },

    # Nested things
    #?pugs emit #
    { a => [1,2,3] },  # only one elem
    #?pugs emit #
    { a => [1,2,3], b => [4,5,6] },
    #?pugs emit #
    [ { :a(1) }, { :b(2), :c(3) } ],

    # a Parcel
    <a b c>
);

#?pugs emit unless $?PUGS_BACKEND eq "BACKEND_PUGS" {
#?pugs emit   skip_rest "EVAL() not yet implemented in $?PUGS_BACKEND.";
#?pugs emit   exit;
#?pugs emit }

# L<S02/Names and Variables/To get a Perlish representation of any object>
# Quoting S02 (emphasis added):
#   To get a Perlish representation of any data value, use the .perl method.
#   This will put quotes around strings, square brackets around list values,
#   curlies around hash values, etc., **such that standard Perl could reparse
#   the result**.
{
    for @tests -> $obj {
        my $s = (~$obj).subst(/\n/, '␤');
        ok EVAL($obj.perl) eq $obj,
            "($s.perl()).perl returned something whose EVAL()ed stringification is unchanged";
        is WHAT(EVAL($obj.perl)).gist, $obj.WHAT.gist,
            "($s.perl()).perl returned something whose EVAL()ed .WHAT is unchanged";
    }
}

# Recursive data structures
#?rakudo skip 'recursive data structure'
{
    my $foo = { a => 42 }; $foo<b> = $foo;
    is $foo<b><b><b><a>, 42, "basic recursive hashref";

    #?pugs skip 'hanging test'
    #?niecza skip 'hanging test'
    is ~$foo.perl.EVAL, ~$foo,
        ".perl worked correctly on a recursive hashref";
}

#?rakudo skip '{...}.perl does not work'
{
    my $foo = [ 42 ];
    my $bar = { a => 23 };
    $foo[1] = $bar;
    $bar<b> = $foo;

    is $foo[1]<b>[1]<b>[0], 42, "mixed arrayref/hashref recursive structure";

    #?pugs skip 'hanging test'
    #?niecza skip 'hanging test'
    is ~$foo.perl.EVAL, ~$foo,
        ".perl worked correctly on a mixed arrayref/hashref recursive structure";
}

{
    # test a bug reported by Chewie[] - apparently this is from S03
    is(EVAL((("f","oo","bar").keys).perl), <0 1 2>, ".perl on a .keys list");
}


# RT #61918
#?niecza skip ">>>Stub code executed"
#?pugs   skip ">>>Stub code executed"
{
    class RT61918 {
        has $.inst is rw;
        has $!priv is rw;
        has $.string = 'krach';

        method init {
            $.inst = [ rand, rand ];
            $!priv = [ rand, rand ].perl;
        }
    }

    my $t1 = RT61918.new();
    my $t1_new = $t1.perl;
    $t1.init;
    my $t1_init = $t1.perl;

    ok $t1_new ne $t1_init, 'changing object changes .perl output';

    # TODO: more tests that show EVAL($t1_init) has the same guts as $t1.
    #?pugs todo
    ok $t1_new ~~ /<< krach >>/, 'attribute value appears in .perl output';

    # RT #62002 -- validity of default .perl
    my $t2_init = EVAL($t1_init).perl;
    is $t1_init, $t2_init, '.perl on user-defined type roundtrips okay';
}

# RT #64080<commit_msg>Skip tests that rely on ordered hash keys<commit_after>use v6;
use Test;
# L<S02/Names and Variables/To get a Perlish representation of any object>

#?pugs emit plan 89;

my @tests = (
    # Basic scalar values
    42, 
    42/10, 
    4.2, 
    #?pugs emit #
    sqrt(2),
    3e5,
    Inf, -Inf, NaN,

    "a string", "", "\0", "\t", "\n", 
    "\r\n", 
    "\o7",
    '{', # "\d123",	# XXX there is no \d escape!!!
    '}',
    '$a @string %with &sigils()',
    'שלום',

    ?1, ?0,
    #?rakudo emit # Mu eq Mu is an error now
    #?niecza emit # Dunno what's wrong with this one
    #?pugs emit #
    Mu,
    #?rakudo emit # parse error
    #?niecza emit # Autoloading NYI
    #?pugs emit #
    rx:P5/foo/, rx:P5//, rx:P5/^.*$/,

    # References to scalars
    \42, \Inf, \-Inf, \NaN, \"string", \"", \?1, \?0, 

    #?pugs emit #
    \Mu,

    #?pugs emit #
    (a => 1),
    #?pugs emit #
    :b(2),

    # References to aggregates
    #?pugs emit #
    {},           # empty hash
    #?pugs emit #
    { a => 42 },  # only one elem
    #?pugs emit #
    #?rakudo emit #
    { :a(1), :b(2), :c(3) },

    # Nested things
    #?pugs emit #
    { a => [1,2,3] },  # only one elem
    #?pugs emit #
    #?rakudo emit #
    { a => [1,2,3], b => [4,5,6] },
    #?pugs emit #
    #?rakudo emit #
    [ { :a(1) }, { :b(2), :c(3) } ],

    # a Parcel
    <a b c>
);

#?pugs emit unless $?PUGS_BACKEND eq "BACKEND_PUGS" {
#?pugs emit   skip_rest "EVAL() not yet implemented in $?PUGS_BACKEND.";
#?pugs emit   exit;
#?pugs emit }

# L<S02/Names and Variables/To get a Perlish representation of any object>
# Quoting S02 (emphasis added):
#   To get a Perlish representation of any data value, use the .perl method.
#   This will put quotes around strings, square brackets around list values,
#   curlies around hash values, etc., **such that standard Perl could reparse
#   the result**.
{
    for @tests -> $obj {
        my $s = (~$obj).subst(/\n/, '␤');
        ok EVAL($obj.perl) eq $obj,
            "($s.perl()).perl returned something whose EVAL()ed stringification is unchanged";
        is WHAT(EVAL($obj.perl)).gist, $obj.WHAT.gist,
            "($s.perl()).perl returned something whose EVAL()ed .WHAT is unchanged";
    }
}

# Recursive data structures
#?rakudo skip 'recursive data structure'
{
    my $foo = { a => 42 }; $foo<b> = $foo;
    is $foo<b><b><b><a>, 42, "basic recursive hashref";

    #?pugs skip 'hanging test'
    #?niecza skip 'hanging test'
    is ~$foo.perl.EVAL, ~$foo,
        ".perl worked correctly on a recursive hashref";
}

#?rakudo skip '{...}.perl does not work'
{
    my $foo = [ 42 ];
    my $bar = { a => 23 };
    $foo[1] = $bar;
    $bar<b> = $foo;

    is $foo[1]<b>[1]<b>[0], 42, "mixed arrayref/hashref recursive structure";

    #?pugs skip 'hanging test'
    #?niecza skip 'hanging test'
    is ~$foo.perl.EVAL, ~$foo,
        ".perl worked correctly on a mixed arrayref/hashref recursive structure";
}

{
    # test a bug reported by Chewie[] - apparently this is from S03
    is(EVAL((("f","oo","bar").keys).perl), <0 1 2>, ".perl on a .keys list");
}


# RT #61918
#?niecza skip ">>>Stub code executed"
#?pugs   skip ">>>Stub code executed"
{
    class RT61918 {
        has $.inst is rw;
        has $!priv;
        has $.string = 'krach';

        method init {
            $.inst = [ rand, rand ];
            $!priv = [ rand, rand ].perl;
        }
    }

    my $t1 = RT61918.new();
    my $t1_new = $t1.perl;
    $t1.init;
    my $t1_init = $t1.perl;

    ok $t1_new ne $t1_init, 'changing object changes .perl output';

    # TODO: more tests that show EVAL($t1_init) has the same guts as $t1.
    #?pugs todo
    ok $t1_new ~~ /<< krach >>/, 'attribute value appears in .perl output';

    # RT #62002 -- validity of default .perl
    my $t2_init = EVAL($t1_init).perl;
    is $t1_init, $t2_init, '.perl on user-defined type roundtrips okay';
}

# RT #64080
{'fraction_non_alphanumeric': 0.17303225806451614, 'fraction_numerical': 0.02890322580645161, 'mean_word_length': 2.3308981521272023, 'pattern_counts': {'":': 0, '<': 31, '<?xml version=': 0, '>': 59, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6774961', 'n_tokens_mistral': 3150, 'n_tokens_neox': 2920, 'n_words': 910}