fix com, prettyprinting of GUIDs
parent
1099e2ad3a
commit
135d56fcd2
|
@ -1,7 +1,8 @@
|
||||||
USING: alien alien.c-types alien.accessors effects kernel
|
USING: alien alien.c-types alien.accessors effects kernel
|
||||||
windows.ole32 parser lexer splitting grouping sequences
|
windows.ole32 parser lexer splitting grouping sequences
|
||||||
namespaces assocs quotations generalizations accessors words
|
namespaces assocs quotations generalizations accessors words
|
||||||
macros alien.syntax fry arrays layouts math ;
|
macros alien.syntax fry arrays layouts math classes.struct
|
||||||
|
windows.kernel32 prettyprint.custom prettyprint.sections ;
|
||||||
IN: windows.com.syntax
|
IN: windows.com.syntax
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
@ -100,3 +101,5 @@ SYNTAX: COM-INTERFACE:
|
||||||
define-words-for-com-interface ;
|
define-words-for-com-interface ;
|
||||||
|
|
||||||
SYNTAX: GUID: scan string>guid parsed ;
|
SYNTAX: GUID: scan string>guid parsed ;
|
||||||
|
|
||||||
|
M: GUID pprint* guid>string "GUID: " prepend text ;
|
||||||
|
|
|
@ -48,7 +48,7 @@ unless
|
||||||
: (make-query-interface) ( interfaces -- quot )
|
: (make-query-interface) ( interfaces -- quot )
|
||||||
(query-interface-cases)
|
(query-interface-cases)
|
||||||
'[
|
'[
|
||||||
swap 16 memory>byte-array
|
swap GUID memory>struct
|
||||||
_ case
|
_ case
|
||||||
[
|
[
|
||||||
"void*" heap-size * rot <displaced-alien> com-add-ref
|
"void*" heap-size * rot <displaced-alien> com-add-ref
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
USING: kernel tools.test windows.ole32 alien.c-types ;
|
USING: kernel tools.test windows.ole32 alien.c-types
|
||||||
|
classes.struct specialized-arrays.uchar windows.kernel32 ;
|
||||||
IN: windows.ole32.tests
|
IN: windows.ole32.tests
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [
|
||||||
|
@ -19,17 +20,9 @@ IN: windows.ole32.tests
|
||||||
guid=
|
guid=
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
little-endian?
|
[
|
||||||
[ B{
|
GUID: 01234567-89ab-cdef-0123-456789abcdef}
|
||||||
HEX: 67 HEX: 45 HEX: 23 HEX: 01 HEX: ab HEX: 89 HEX: ef HEX: cd
|
] [ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid ] unit-test
|
||||||
HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
|
|
||||||
} ]
|
|
||||||
[ B{
|
|
||||||
HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
|
|
||||||
HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
|
|
||||||
} ] ?
|
|
||||||
[ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid ]
|
|
||||||
unit-test
|
|
||||||
|
|
||||||
[ "{01234567-89ab-cdef-0123-456789abcdef}" ]
|
[ "{01234567-89ab-cdef-0123-456789abcdef}" ]
|
||||||
[ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid guid>string ]
|
[ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid guid>string ]
|
||||||
|
|
|
@ -143,9 +143,9 @@ CONSTANT: GUID-STRING-LENGTH
|
||||||
: guid>string ( guid -- string )
|
: guid>string ( guid -- string )
|
||||||
[
|
[
|
||||||
[ "{" ] dip {
|
[ "{" ] dip {
|
||||||
[ Data1>> >hex "-" ]
|
[ Data1>> >hex 8 CHAR: 0 pad-head "-" ]
|
||||||
[ Data2>> >hex "-" ]
|
[ Data2>> >hex 4 CHAR: 0 pad-head "-" ]
|
||||||
[ Data3>> >hex "-" ]
|
[ Data3>> >hex 4 CHAR: 0 pad-head "-" ]
|
||||||
[
|
[
|
||||||
Data4>> [
|
Data4>> [
|
||||||
{
|
{
|
||||||
|
|
Loading…
Reference in New Issue