Fix printing of displaced aliens over byte arrays

release
Slava Pestov 2007-11-07 19:26:39 -05:00
parent 53690f2500
commit 6dcdf6b59b
4 changed files with 15 additions and 7 deletions

View File

@ -64,3 +64,7 @@ cell 8 = [
[ 0 B{ 1 2 3 } <displaced-alien> alien-address ] unit-test-fails
[ 1 1 <displaced-alien> ] unit-test-fails
[ f ] [ 0 B{ 1 2 3 } <displaced-alien> pinned-c-ptr? ] unit-test
[ "( displaced alien )" ] [ 0 B{ 1 2 3 } <displaced-alien> unparse ] unit-test

View File

@ -18,7 +18,7 @@ PREDICATE: alien pinned-alien
underlying-alien pinned-c-ptr? ;
UNION: pinned-c-ptr
alien POSTPONE: f ;
pinned-alien POSTPONE: f ;
UNION: c-ptr
alien bit-array byte-array float-array POSTPONE: f ;

View File

@ -68,3 +68,7 @@ TYPEDEF: int* MyIntArray
TYPEDEF: uchar* MyLPBYTE
[ t ] [ "char*" c-type "MyLPBYTE" c-type eq? ] unit-test
[
0 B{ 1 2 3 4 } <displaced-alien> <void*>
] unit-test-fails

View File

@ -3,7 +3,7 @@
USING: arrays alien alien.c-types alien.structs kernel math
namespaces parser sequences words quotations math.parser
splitting effects prettyprint prettyprint.sections
prettyprint.backend assocs ;
prettyprint.backend assocs combinators ;
IN: alien.syntax
<PRIVATE
@ -53,10 +53,10 @@ PRIVATE>
parsing
M: alien pprint*
dup expired? [
drop "( alien expired )" text
] [
\ ALIEN: [ alien-address pprint* ] pprint-prefix
] if ;
{
{ [ dup expired? ] [ drop "( alien expired )" text ] }
{ [ dup pinned-c-ptr? not ] [ drop "( displaced alien )" text ] }
{ [ t ] [ \ ALIEN: [ alien-address pprint* ] pprint-prefix ] }
} cond ;
M: dll pprint* dll-path dup "DLL\" " pprint-string ;