<commit_before>! (c)<NAME> bsd license
USING: accessors alien alien.c-types alien.data alien.syntax
assocs byte-arrays classes classes.private classes.struct
classes.struct.prettyprint.private classes.tuple
classes.tuple.parser classes.tuple.private combinators
compiler.tree.debugger compiler.units definitions delegate
destructors eval generic generic.single io.encodings.utf8
io.streams.string kernel layouts lexer libc literals math
mirrors namespaces parser prettyprint prettyprint.config see
sequences specialized-arrays specialized-arrays.private
system tools.test vocabs ;
FROM: math => float ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: char
SPECIALIZED-ARRAY: int
SPECIALIZED-ARRAY: ushort
IN: classes.struct.tests

SYMBOL: struct-test-empty

[ [ struct-test-empty { } define-struct-class ] with-compilation-unit ]
[ struct-must-have-slots? ] must-fail-with

STRUCT: struct-test-foo
    { x char }
    { y int initial: 123 }
    { z bool } ;

STRUCT: struct-test-bar
    { w ushort initial: 0xffff }
    { foo struct-test-foo } ;

{ 12 } [ struct-test-foo heap-size ] unit-test
{ 12 } [ struct-test-foo <struct> byte-length ] unit-test
{ 16 } [ struct-test-bar heap-size ] unit-test
{ 123 } [ struct-test-foo <struct> y>> ] unit-test
{ 123 } [ struct-test-bar <struct> foo>> y>> ] unit-test

{ 1 2 3 t } [
    1   2 3 t struct-test-foo <struct-boa>   struct-test-bar <struct-boa>
    {
        [ w>> ]
        [ foo>> x>> ]
        [ foo>> y>> ]
        [ foo>> z>> ]
    } cleave
] unit-test

{ 7654 } [ S{ struct-test-foo f 98 7654 f } y>> ] unit-test
{ 7654 } [ S{ struct-test-foo { y 7654 } } y>> ] unit-test

{ {
    { "underlying" B{ 98 0 0 98 127 0 0 127 0 0 0 0 } }
    { { "x" char } 98            }
    { { "y" int  } 0x7F00007F }
    { { "z" bool } f             }
} } [
    B{ 98 0 0 98 127 0 0 127 0 0 0 0 } struct-test-foo memory>struct
    make-mirror >alist
] unit-test

{ { { "underlying" f } } } [
    f struct-test-foo memory>struct
    make-mirror >alist
] unit-test

{ 55 t } [ S{ struct-test-foo { x 55 } } make-mirror { "x" "char" } ?of ] unit-test
{ 55 t } [ S{ struct-test-foo { y 55 } } make-mirror { "y" "int"  } ?of ] unit-test
{ t  t } [ S{ struct-test-foo { z t  } } make-mirror { "z" "bool" } ?of ] unit-test
{ f  t } [ S{ struct-test-foo { z f  } } make-mirror { "z" "bool" } ?of ] unit-test
{ { "nonexist" "bool" } f } [ S{ struct-test-foo } make-mirror { "nonexist" "bool" } ?of ] unit-test
{ "nonexist" f } [ S{ struct-test-foo } make-mirror "nonexist" ?of ] unit-test
{ f  t } [ f struct-test-foo memory>struct make-mirror "underlying" ?of ] unit-test

{ S{ struct-test-foo { x 3 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror [ 3 { "x" "char" } ] dip set-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 5 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror [ 5 { "y" "int" } ] dip set-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 2 } { z t } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror [ t { "z" "bool" } ] dip set-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror [ "nonsense" "underlying" ] dip set-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror [ "nonsense" "nonexist" ] dip set-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror [ "nonsense" { "nonexist" "int" } ] dip set-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 123 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror { "y" "int" } swap delete-at ] keep
] unit-test

{ S{ struct-test-foo { x 0 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror { "x" "char" } swap delete-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror { "nonexist" "char" } swap delete-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror "underlying" swap delete-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror "nonsense" swap delete-at ] keep
] unit-test

{ S{ struct-test-foo { x 0 } { y 123 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z t } }
    [ make-mirror clear-assoc ] keep
] unit-test

{ POSTPONE: STRUCT: }
[ struct-test-foo struct-definer-word ] unit-test

UNION-STRUCT: struct-test-float-and-bits
    { f c:float }
    { bits uint } ;

{ 1.0 } [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
{ 4 } [ struct-test-float-and-bits heap-size ] unit-test

{ 123 } [ [ struct-test-foo malloc-struct &free y>> ] with-destructors ] unit-test

{ POSTPONE: UNION-STRUCT: }
[ struct-test-float-and-bits struct-definer-word ] unit-test

STRUCT: struct-test-string-ptr
    { x c-string } ;

{ "hello world" } [
    [
        struct-test-string-ptr <struct>
        "hello world" utf8 malloc-string &free >>x
        x>>
    ] with-destructors
] unit-test

{ "S{ struct-test-foo { x 0 } { y 7654 } { z f } }" }
[
    H{ { boa-tuples? f } { c-object-pointers? f } } [
        struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer
    ] with-variables
] unit-test

{ "S@ struct-test-foo B{ 0 0 0 0 0 0 0 0 0 0 0 0 }" }
[
    H{ { c-object-pointers? t } } [
        12 <byte-array> struct-test-foo memory>struct [ pprint ] with-string-writer
    ] with-variables
] unit-test

{ "S{ struct-test-foo f 0 7654 f }" }
[
    H{ { boa-tuples? t } { c-object-pointers? f } } [
        struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer
    ] with-variables
] unit-test

{ "S@ struct-test-foo f" }
[
    H{ { c-object-pointers? f } } [
        f struct-test-foo memory>struct [ pprint ] with-string-writer
    ] with-variables
] unit-test

{ "USING: alien.c-types classes.struct ;<commit_msg>classes.struct: use unparse in tests.<commit_after>! (c)<NAME> bsd license
USING: accessors alien alien.c-types alien.data alien.syntax
assocs byte-arrays classes classes.private classes.struct
classes.struct.prettyprint.private classes.tuple
classes.tuple.parser classes.tuple.private combinators
compiler.tree.debugger compiler.units definitions delegate
destructors eval generic generic.single io.encodings.utf8
io.streams.string kernel layouts lexer libc literals math
mirrors namespaces parser prettyprint prettyprint.config see
sequences specialized-arrays specialized-arrays.private
system tools.test vocabs ;
FROM: math => float ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: char
SPECIALIZED-ARRAY: int
SPECIALIZED-ARRAY: ushort
IN: classes.struct.tests

SYMBOL: struct-test-empty

[ [ struct-test-empty { } define-struct-class ] with-compilation-unit ]
[ struct-must-have-slots? ] must-fail-with

STRUCT: struct-test-foo
    { x char }
    { y int initial: 123 }
    { z bool } ;

STRUCT: struct-test-bar
    { w ushort initial: 0xffff }
    { foo struct-test-foo } ;

{ 12 } [ struct-test-foo heap-size ] unit-test
{ 12 } [ struct-test-foo <struct> byte-length ] unit-test
{ 16 } [ struct-test-bar heap-size ] unit-test
{ 123 } [ struct-test-foo <struct> y>> ] unit-test
{ 123 } [ struct-test-bar <struct> foo>> y>> ] unit-test

{ 1 2 3 t } [
    1   2 3 t struct-test-foo <struct-boa>   struct-test-bar <struct-boa>
    {
        [ w>> ]
        [ foo>> x>> ]
        [ foo>> y>> ]
        [ foo>> z>> ]
    } cleave
] unit-test

{ 7654 } [ S{ struct-test-foo f 98 7654 f } y>> ] unit-test
{ 7654 } [ S{ struct-test-foo { y 7654 } } y>> ] unit-test

{ {
    { "underlying" B{ 98 0 0 98 127 0 0 127 0 0 0 0 } }
    { { "x" char } 98            }
    { { "y" int  } 0x7F00007F }
    { { "z" bool } f             }
} } [
    B{ 98 0 0 98 127 0 0 127 0 0 0 0 } struct-test-foo memory>struct
    make-mirror >alist
] unit-test

{ { { "underlying" f } } } [
    f struct-test-foo memory>struct
    make-mirror >alist
] unit-test

{ 55 t } [ S{ struct-test-foo { x 55 } } make-mirror { "x" "char" } ?of ] unit-test
{ 55 t } [ S{ struct-test-foo { y 55 } } make-mirror { "y" "int"  } ?of ] unit-test
{ t  t } [ S{ struct-test-foo { z t  } } make-mirror { "z" "bool" } ?of ] unit-test
{ f  t } [ S{ struct-test-foo { z f  } } make-mirror { "z" "bool" } ?of ] unit-test
{ { "nonexist" "bool" } f } [ S{ struct-test-foo } make-mirror { "nonexist" "bool" } ?of ] unit-test
{ "nonexist" f } [ S{ struct-test-foo } make-mirror "nonexist" ?of ] unit-test
{ f  t } [ f struct-test-foo memory>struct make-mirror "underlying" ?of ] unit-test

{ S{ struct-test-foo { x 3 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror [ 3 { "x" "char" } ] dip set-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 5 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror [ 5 { "y" "int" } ] dip set-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 2 } { z t } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror [ t { "z" "bool" } ] dip set-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror [ "nonsense" "underlying" ] dip set-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror [ "nonsense" "nonexist" ] dip set-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror [ "nonsense" { "nonexist" "int" } ] dip set-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 123 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror { "y" "int" } swap delete-at ] keep
] unit-test

{ S{ struct-test-foo { x 0 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror { "x" "char" } swap delete-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror { "nonexist" "char" } swap delete-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror "underlying" swap delete-at ] keep
] unit-test

{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z f } }
    [ make-mirror "nonsense" swap delete-at ] keep
] unit-test

{ S{ struct-test-foo { x 0 } { y 123 } { z f } } } [
    S{ struct-test-foo { x 1 } { y 2 } { z t } }
    [ make-mirror clear-assoc ] keep
] unit-test

{ POSTPONE: STRUCT: }
[ struct-test-foo struct-definer-word ] unit-test

UNION-STRUCT: struct-test-float-and-bits
    { f c:float }
    { bits uint } ;

{ 1.0 } [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
{ 4 } [ struct-test-float-and-bits heap-size ] unit-test

{ 123 } [ [ struct-test-foo malloc-struct &free y>> ] with-destructors ] unit-test

{ POSTPONE: UNION-STRUCT: }
[ struct-test-float-and-bits struct-definer-word ] unit-test

STRUCT: struct-test-string-ptr
    { x c-string } ;

{ "hello world" } [
    [
        struct-test-string-ptr <struct>
        "hello world" utf8 malloc-string &free >>x
        x>>
    ] with-destructors
] unit-test

{ "S{ struct-test-foo { x 0 } { y 7654 } { z f } }" }
[
    H{ { boa-tuples? f } { c-object-pointers? f } } [
        struct-test-foo <struct> 7654 >>y unparse
    ] with-variables
] unit-test

{ "S@ struct-test-foo B{ 0 0 0 0 0 0 0 0 0 0 0 0 }" }
[
    H{ { c-object-pointers? t } } [
        12 <byte-array> struct-test-foo memory>struct unparse
    ] with-variables
] unit-test

{ "S{ struct-test-foo f 0 7654 f }" }
[
    H{ { boa-tuples? t } { c-object-pointers? f } } [
        struct-test-foo <struct> 7654 >>y unparse
    ] with-variables
] unit-test

{ "S@ struct-test-foo f" }
[
    H{ { c-object-pointers? f } } [
        f struct-test-foo memory>struct unparse
    ] with-variables
] unit-test

{ "USING: alien.c-types classes.struct ;
{'fraction_non_alphanumeric': 0.17149129939827615, 'fraction_numerical': 0.030736705155309806, 'mean_word_length': 2.3249526899161936, 'pattern_counts': {'":': 0, '<': 25, '<?xml version=': 0, '>': 119, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 46, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5437325', 'n_tokens_mistral': 5205, 'n_tokens_neox': 4826, 'n_words': 1354}