fix com, prettyprinting of GUIDs

db4
Doug Coleman 2009-08-29 19:18:39 -05:00
parent 1099e2ad3a
commit 135d56fcd2
4 changed files with 13 additions and 17 deletions

View File

@ -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 ;

View File

@ -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

View File

@ -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 ]

View File

@ -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>> [
{ {