Ticket #19395: erlang-r13b.diff

File erlang-r13b.diff, 52.3 KB (added by nottwo (Trannie Carter), 15 years ago)

  • dports/lang/erlang/Portfile 

    diff --git a/dports/lang/erlang/Portfile b/dports/lang/erlang/Portfile
index ed3309c..6224850 100644
    a b  
    1 # $Id$
     1# $Id: Portfile 44939 2009-01-04 23:22:47Z bfulgham@macports.org $
    22
    33PortSystem 1.0
    44name            erlang
    5 version         R12B-5
    6 revision        1
     5version         R13B
    76categories      lang erlang
    87maintainers     bfulgham@macports.org
    98platforms       darwin
    … … distfiles otp_src_${version}${extract.suffix} \ 
    3231                otp_doc_man_${version}${extract.suffix}                \
    3332                otp_doc_html_${version}${extract.suffix}
    3433
    35 checksums       otp_src_R12B-5.tar.gz \
    36                     md5     3751ea3fea669d2b25c67eeb883734bb \
    37                     sha1    6c45509acf70d35d5def2cbefd86ada093c1ac3a \
    38                     rmd160  7265ae8ebd045ec5b977148a7c9b995eb7ef2d2d \
    39                 otp_doc_man_R12B-5.tar.gz \
    40                     md5     6231cb172847040395cc34b20781aa3b \
    41                     sha1    ae7036bd2afc9d1fca97f0de2eca84f56656def8 \
    42                     rmd160  e28d555d0a86fc69e0ee091864828c8eaa58d2be \
    43                 otp_doc_html_R12B-5.tar.gz \
    44                     md5     fb0c5454bbd865e881b6712295f6d41f \
    45                     sha1    0bd369d02051e01bac58c9b8665bd3538e116f51 \
    46                     rmd160  b460906043171b27735332ec90c45e38d888869a
     34checksums       otp_src_R13B.tar.gz \
     35                    md5     6d8c256468a198458b9f08ba6aa1a384 \
     36                    sha1    a69611923c48861aef157e7b4a06689d339571ff \
     37                    rmd160  625bf1b2c9051218dc6a4f3c89eaea50367fa112 \
     38                otp_doc_man_R13B.tar.gz \
     39                    md5     9265ebf3b1041be6ae18e323b0933601 \
     40                    sha1    9a390f4e670db7b6596200031d4e0dbb6e96578d \
     41                    rmd160  ea0341750880a30359979d0e6aefcb2a7e1cecb5 \
     42                otp_doc_html_R13B.tar.gz \
     43                    md5     a14b1111550ce2bce65090de5cf3b0ff \
     44                    sha1    d479dc6f865ae0cd59a9085de20698fae9d71b67 \
     45                    rmd160  632b54c5b4a2261d61377c171a9ca7e71176bd69
    4746
    4847extract.only    otp_src_${version}${extract.suffix}
    4948
    … … pre-patch { file rename ${workpath}/otp_src_${version} ${workpath}/${name} 
    5150
    5251# http://www.erlang.org/pipermail/erlang-bugs/2008-October/001023.html
    5352# http://www.erlang.org/pipermail/erlang-bugs/2008-October/001024.html
    54 # http://support.process-one.net/browse/EUNIT-13
    5553patchfiles      patch-toolbar.erl \
    5654                patch-erts_emulator_Makefile.in \
    5755                patch-lib_ssl_c_src_esock_openssl.c \
    … … patchfiles patch-toolbar.erl \ 
    5957                patch-lib_ssl_c_src_Makefile.in \
    6058                patch-decode_big.c.diff \
    6159                patch-decode_fun.c.diff \
    62                 patch-eunit_xml.diff
     60                patch-erts_configure.diff
    6361
    6462configure.args  --prefix=${destroot}${prefix}   \
    6563                --enable-kernel-poll            \
    66                 --disable-smp-support           \
     64                --enable-threads                \
     65                --enable-dynamic-ssl-lib        \
     66                --enable-smp-support            \
    6767                --enable-hipe
    6868
    69 variant smp     {
    70         configure.args-delete   --disable-smp-support
    71 }
    72 
    7369variant ssl     {
    7470        configure.args-append    --with-ssl=${prefix}
    7571        configure.ldflags-append -lz
    … … variant ssl { 
    7874}
    7975
    8076variant no-hipe {
    81         # Currently produces bus errors in 10.5.3 due to changes in
    82         # signal handling
    8377        configure.args-delete   --enable-hipe
    8478}
    8579
    8680
    87 platform i386 {
    88    pre-configure {
    89       file copy ${filespath}/mach_override.h ${workpath}/${name}-${version}/erts/emulator/hipe
    90       file copy ${filespath}/mach_override.c ${workpath}/${name}-${version}/erts/emulator/hipe
    91    }
    92 }
    93 
    94 
    9581
    96 depends_build   port:gawk
     82depends_build   port:gawk \
     83                port:wxWidgets
    9784depends_run     port:tk
    9885
    9986post-destroot   {
    10087        system "tar -C ${destroot}${prefix}/lib/erlang -zxvf ${distpath}/otp_doc_html_${version}${extract.suffix}"
    10188        system "tar -C ${destroot}${prefix}/lib/erlang -zxvf ${distpath}/otp_doc_man_${version}${extract.suffix}"
    10289 
    103         set erts_dir   erts-5.6.5
     90        set erts_dir   erts-5.7.1
    10491
    10592        reinplace s|${destroot}|| ${destroot}${prefix}/lib/erlang/bin/erl
    10693        reinplace s|${destroot}|| ${destroot}${prefix}/lib/erlang/bin/start

  • deleted file dports/lang/erlang/files/mach_override.c 

    diff --git a/dports/lang/erlang/files/mach_override.c b/dports/lang/erlang/files/mach_override.c
deleted file mode 100644
index 06f9b74..0000000
    + -  
    1 /*******************************************************************************
    2         mach_override.c
    3                 Copyright (c) 2003-2005 Jonathan 'Wolf' Rentzsch: <http://rentzsch.com>
    4                 Some rights reserved: <http://creativecommons.org/licenses/by/2.0/>
    5 
    6         ***************************************************************************/
    7 
    8 #include "mach_override.h"
    9 
    10 #include <mach-o/dyld.h>
    11 #include <mach/mach_host.h>
    12 #include <mach/mach_init.h>
    13 #include <mach/vm_map.h>
    14 #include <sys/mman.h>
    15 
    16 #include <CoreServices/CoreServices.h>
    17 
    18 /**************************
    19 *       
    20 *       Constants
    21 *       
    22 **************************/
    23 #pragma mark    -
    24 #pragma mark    (Constants)
    25 
    26 #if defined(__ppc__) || defined(__POWERPC__)
    27 
    28 long kIslandTemplate[] = {
    29         0x9001FFFC,     //      stw             r0,-4(SP)
    30         0x3C00DEAD,     //      lis             r0,0xDEAD
    31         0x6000BEEF,     //      ori             r0,r0,0xBEEF
    32         0x7C0903A6,     //      mtctr   r0
    33         0x8001FFFC,     //      lwz             r0,-4(SP)
    34         0x60000000,     //      nop             ; optionally replaced
    35         0x4E800420      //      bctr
    36 };
    37 
    38 #define kAddressHi                      3
    39 #define kAddressLo                      5
    40 #define kInstructionHi          10
    41 #define kInstructionLo          11
    42 
    43 #elif defined(__i386__)
    44 
    45 #define kOriginalInstructionsSize 16
    46 
    47 char kIslandTemplate[] = {
    48         // kOriginalInstructionsSize nop instructions so that we
    49         // should have enough space to host original instructions
    50         0x90, 0x90, 0x90, 0x90, 0x90, 0x90, 0x90, 0x90,
    51         0x90, 0x90, 0x90, 0x90, 0x90, 0x90, 0x90, 0x90,
    52         // Now the real jump instruction
    53         0xE9, 0xEF, 0xBE, 0xAD, 0xDE
    54 };
    55 
    56 #define kInstructions   0
    57 #define kJumpAddress    kInstructions + kOriginalInstructionsSize + 1
    58 #endif
    59 
    60 
    61 #define kAllocateHigh           1
    62 #define kAllocateNormal         0
    63 
    64 /**************************
    65 *       
    66 *       Data Types
    67 *       
    68 **************************/
    69 #pragma mark    -
    70 #pragma mark    (Data Types)
    71 
    72 typedef struct  {
    73         char    instructions[sizeof(kIslandTemplate)];
    74         int             allocatedHigh;
    75 }       BranchIsland;
    76 
    77 /**************************
    78 *       
    79 *       Funky Protos
    80 *       
    81 **************************/
    82 #pragma mark    -
    83 #pragma mark    (Funky Protos)
    84 
    85         mach_error_t
    86 allocateBranchIsland(
    87                 BranchIsland    **island,
    88                 int                             allocateHigh );
    89 
    90         mach_error_t
    91 freeBranchIsland(
    92                 BranchIsland    *island );
    93 
    94 #if defined(__ppc__) || defined(__POWERPC__)
    95         mach_error_t
    96 setBranchIslandTarget(
    97                 BranchIsland    *island,
    98                 const void              *branchTo,
    99                 long                    instruction );
    100 #endif
    101 
    102 #if defined(__i386__)
    103 mach_error_t
    104 setBranchIslandTarget_i386(
    105                                                    BranchIsland *island,
    106                                                    const void           *branchTo,
    107                                                    char*                        instructions );
    108 void
    109 atomic_mov64(
    110                 uint64_t *targetAddress,
    111                 uint64_t value );
    112 
    113         static Boolean
    114 eatKnownInstructions(
    115         unsigned char   *code,
    116         uint64_t                *newInstruction,
    117         int                             *howManyEaten,
    118         char                    *originalInstructions );
    119 #endif
    120 
    121 /*******************************************************************************
    122 *       
    123 *       Interface
    124 *       
    125 *******************************************************************************/
    126 #pragma mark    -
    127 #pragma mark    (Interface)
    128 
    129         mach_error_t
    130 mach_override(
    131                 char *originalFunctionSymbolName,
    132                 const char *originalFunctionLibraryNameHint,
    133                 const void *overrideFunctionAddress,
    134                 void **originalFunctionReentryIsland )
    135 {
    136         assert( originalFunctionSymbolName );
    137         assert( strlen( originalFunctionSymbolName ) );
    138         assert( overrideFunctionAddress );
    139        
    140         //      Lookup the original function's code pointer.
    141         long    *originalFunctionPtr;
    142         if( originalFunctionLibraryNameHint )
    143                 _dyld_lookup_and_bind_with_hint(
    144                         originalFunctionSymbolName,
    145                         originalFunctionLibraryNameHint,
    146                         (void*) &originalFunctionPtr,
    147                         NULL );
    148         else
    149                 _dyld_lookup_and_bind(
    150                         originalFunctionSymbolName,
    151                         (void*) &originalFunctionPtr,
    152                         NULL );
    153        
    154         return mach_override_ptr( originalFunctionPtr, overrideFunctionAddress,
    155                 originalFunctionReentryIsland );
    156 }
    157 
    158     mach_error_t
    159 mach_override_ptr(
    160         void *originalFunctionAddress,
    161     const void *overrideFunctionAddress,
    162     void **originalFunctionReentryIsland )
    163 {
    164         assert( originalFunctionAddress );
    165         assert( overrideFunctionAddress );
    166        
    167         long    *originalFunctionPtr = (long*) originalFunctionAddress;
    168         mach_error_t    err = err_none;
    169        
    170 #if defined(__ppc__) || defined(__POWERPC__)
    171         //      Ensure first instruction isn't 'mfctr'.
    172         #define kMFCTRMask                      0xfc1fffff
    173         #define kMFCTRInstruction       0x7c0903a6
    174        
    175         long    originalInstruction = *originalFunctionPtr;
    176         if( !err && ((originalInstruction & kMFCTRMask) == kMFCTRInstruction) )
    177                 err = err_cannot_override;
    178 #elif defined (__i386__)
    179         int eatenCount = 0;
    180         char originalInstructions[kOriginalInstructionsSize];
    181         uint64_t jumpRelativeInstruction = 0; // JMP
    182 
    183         Boolean overridePossible = eatKnownInstructions ((unsigned char *)originalFunctionPtr,
    184                                                                                 &jumpRelativeInstruction, &eatenCount, originalInstructions);
    185         if (eatenCount > kOriginalInstructionsSize) {
    186                 //printf ("Too many instructions eaten\n");
    187                 overridePossible = false;
    188         }
    189         if (!overridePossible) err = err_cannot_override;
    190 #endif
    191        
    192         //      Make the original function implementation writable.
    193         if( !err ) {
    194                 err = vm_protect( mach_task_self(),
    195                                 (vm_address_t) originalFunctionPtr,
    196                                 sizeof(long), false, (VM_PROT_ALL | VM_PROT_COPY) );
    197                 if( err )
    198                         err = vm_protect( mach_task_self(),
    199                                         (vm_address_t) originalFunctionPtr, sizeof(long), false,
    200                                         (VM_PROT_DEFAULT | VM_PROT_COPY) );
    201         }
    202        
    203         //      Allocate and target the escape island to the overriding function.
    204         BranchIsland    *escapeIsland = NULL;
    205         if( !err )     
    206                 err = allocateBranchIsland( &escapeIsland, kAllocateHigh );
    207        
    208 #if defined(__ppc__) || defined(__POWERPC__)
    209         if( !err )
    210                 err = setBranchIslandTarget( escapeIsland, overrideFunctionAddress, 0 );
    211 
    212         //      Build the branch absolute instruction to the escape island.
    213         long    branchAbsoluteInstruction = 0; // Set to 0 just to silence warning.
    214         if( !err ) {
    215                 long escapeIslandAddress = ((long) escapeIsland) & 0x3FFFFFF;
    216                 branchAbsoluteInstruction = 0x48000002 | escapeIslandAddress;
    217         }
    218 #elif defined (__i386__)
    219         if( !err )
    220                 err = setBranchIslandTarget_i386( escapeIsland, overrideFunctionAddress, 0 );
    221  
    222         // Build the jump relative instruction to the escape island
    223         if (!err) {
    224                 int32_t addressOffset = ((int32_t)escapeIsland - (int32_t)originalFunctionPtr - 5);
    225                 addressOffset = OSSwapInt32(addressOffset);
    226                
    227                 jumpRelativeInstruction |= 0xE900000000000000LL;
    228                 jumpRelativeInstruction |= ((uint64_t)addressOffset & 0xffffffff) << 24;
    229                 jumpRelativeInstruction = OSSwapInt64(jumpRelativeInstruction);         
    230         }
    231 #endif
    232        
    233         //      Optionally allocate & return the reentry island.
    234         BranchIsland    *reentryIsland = NULL;
    235         if( !err && originalFunctionReentryIsland ) {
    236                 err = allocateBranchIsland( &reentryIsland, kAllocateNormal );
    237                 if( !err )
    238                         *originalFunctionReentryIsland = reentryIsland;
    239         }
    240        
    241 #if defined(__ppc__) || defined(__POWERPC__)   
    242         //      Atomically:
    243         //      o If the reentry island was allocated:
    244         //              o Insert the original instruction into the reentry island.
    245         //              o Target the reentry island at the 2nd instruction of the
    246         //                original function.
    247         //      o Replace the original instruction with the branch absolute.
    248         if( !err ) {
    249                 int escapeIslandEngaged = false;
    250                 do {
    251                         if( reentryIsland )
    252                                 err = setBranchIslandTarget( reentryIsland,
    253                                                 (void*) (originalFunctionPtr+1), originalInstruction );
    254                         if( !err ) {
    255                                 escapeIslandEngaged = CompareAndSwap( originalInstruction,
    256                                                                                 branchAbsoluteInstruction,
    257                                                                                 (UInt32*)originalFunctionPtr );
    258                                 if( !escapeIslandEngaged ) {
    259                                         //      Someone replaced the instruction out from under us,
    260                                         //      re-read the instruction, make sure it's still not
    261                                         //      'mfctr' and try again.
    262                                         originalInstruction = *originalFunctionPtr;
    263                                         if( (originalInstruction & kMFCTRMask) == kMFCTRInstruction)
    264                                                 err = err_cannot_override;
    265                                 }
    266                         }
    267                 } while( !err && !escapeIslandEngaged );
    268         }
    269 #elif defined (__i386__)
    270         // Atomically:
    271         //      o If the reentry island was allocated:
    272         //              o Insert the original instructions into the reentry island.
    273         //              o Target the reentry island at the first non-replaced
    274         //        instruction of the original function.
    275         //      o Replace the original first instructions with the jump relative.
    276         //
    277         // Note that on i386, we do not support someone else changing the code under our feet
    278         if ( !err ) {
    279                 if( reentryIsland )
    280                         err = setBranchIslandTarget_i386( reentryIsland,
    281                                                                                  (void*) ((char *)originalFunctionPtr+eatenCount), originalInstructions );
    282                 if ( !err )
    283                         atomic_mov64((uint64_t *)originalFunctionPtr, jumpRelativeInstruction);
    284         }
    285 #endif
    286        
    287         //      Clean up on error.
    288         if( err ) {
    289                 if( reentryIsland )
    290                         freeBranchIsland( reentryIsland );
    291                 if( escapeIsland )
    292                         freeBranchIsland( escapeIsland );
    293         }
    294        
    295         return err;
    296 }
    297 
    298 /*******************************************************************************
    299 *       
    300 *       Implementation
    301 *       
    302 *******************************************************************************/
    303 #pragma mark    -
    304 #pragma mark    (Implementation)
    305 
    306 /***************************************************************************//**
    307         Implementation: Allocates memory for a branch island.
    308        
    309         @param  island                  <-      The allocated island.
    310         @param  allocateHigh    ->      Whether to allocate the island at the end of the
    311                                                                 address space (for use with the branch absolute
    312                                                                 instruction).
    313         @result                                 <-      mach_error_t
    314 
    315         ***************************************************************************/
    316 
    317         mach_error_t
    318 allocateBranchIsland(
    319                 BranchIsland    **island,
    320                 int                             allocateHigh )
    321 {
    322         assert( island );
    323        
    324         mach_error_t    err = err_none;
    325        
    326         if( allocateHigh ) {
    327                 vm_size_t pageSize;
    328                 err = host_page_size( mach_host_self(), &pageSize );
    329                 if( !err ) {
    330                         assert( sizeof( BranchIsland ) <= pageSize );
    331                         vm_address_t first = 0xfeffffff;
    332                         vm_address_t last = 0xfe000000 + pageSize;
    333                         vm_address_t page = first;
    334                         int allocated = 0;
    335                         vm_map_t task_self = mach_task_self();
    336                        
    337                         while( !err && !allocated && page != last ) {
    338                                 err = vm_allocate( task_self, &page, pageSize, 0 );
    339                                 if( err == err_none )
    340                                         allocated = 1;
    341                                 else if( err == KERN_NO_SPACE ) {
    342                                         page += pageSize;
    343                                         err = err_none;
    344                                 }
    345                         }
    346                         if( allocated )
    347                                 *island = (void*) page;
    348                         else if( !allocated && !err )
    349                                 err = KERN_NO_SPACE;
    350                 }
    351         } else {
    352                 void *block = malloc( sizeof( BranchIsland ) );
    353                 if( block )
    354                         *island = block;
    355                 else
    356                         err = KERN_NO_SPACE;
    357         }
    358         if( !err )
    359                 (**island).allocatedHigh = allocateHigh;
    360        
    361         return err;
    362 }
    363 
    364 /***************************************************************************//**
    365         Implementation: Deallocates memory for a branch island.
    366        
    367         @param  island  ->      The island to deallocate.
    368         @result                 <-      mach_error_t
    369 
    370         ***************************************************************************/
    371 
    372         mach_error_t
    373 freeBranchIsland(
    374                 BranchIsland    *island )
    375 {
    376         assert( island );
    377         assert( (*(long*)&island->instructions[0]) == kIslandTemplate[0] );
    378         assert( island->allocatedHigh );
    379        
    380         mach_error_t    err = err_none;
    381        
    382         if( island->allocatedHigh ) {
    383                 vm_size_t pageSize;
    384                 err = host_page_size( mach_host_self(), &pageSize );
    385                 if( !err ) {
    386                         assert( sizeof( BranchIsland ) <= pageSize );
    387                         err = vm_deallocate(
    388                                         mach_task_self(),
    389                                         (vm_address_t) island, pageSize );
    390                 }
    391         } else {
    392                 free( island );
    393         }
    394        
    395         return err;
    396 }
    397 
    398 /***************************************************************************//**
    399         Implementation: Sets the branch island's target, with an optional
    400         instruction.
    401        
    402         @param  island          ->      The branch island to insert target into.
    403         @param  branchTo        ->      The address of the target.
    404         @param  instruction     ->      Optional instruction to execute prior to branch. Set
    405                                                         to zero for nop.
    406         @result                         <-      mach_error_t
    407 
    408         ***************************************************************************/
    409 #if defined(__ppc__) || defined(__POWERPC__)
    410         mach_error_t
    411 setBranchIslandTarget(
    412                 BranchIsland    *island,
    413                 const void              *branchTo,
    414                 long                    instruction )
    415 {
    416         //      Copy over the template code.
    417     bcopy( kIslandTemplate, island->instructions, sizeof( kIslandTemplate ) );
    418    
    419     //  Fill in the address.
    420     ((short*)island->instructions)[kAddressLo] = ((long) branchTo) & 0x0000FFFF;
    421     ((short*)island->instructions)[kAddressHi]
    422         = (((long) branchTo) >> 16) & 0x0000FFFF;
    423    
    424     //  Fill in the (optional) instuction.
    425     if( instruction != 0 ) {
    426         ((short*)island->instructions)[kInstructionLo]
    427                 = instruction & 0x0000FFFF;
    428         ((short*)island->instructions)[kInstructionHi]
    429                 = (instruction >> 16) & 0x0000FFFF;
    430     }
    431    
    432     //MakeDataExecutable( island->instructions, sizeof( kIslandTemplate ) );
    433         msync( island->instructions, sizeof( kIslandTemplate ), MS_INVALIDATE );
    434    
    435     return err_none;
    436 }
    437 #endif
    438 
    439 #if defined(__i386__)
    440         mach_error_t
    441 setBranchIslandTarget_i386(
    442         BranchIsland    *island,
    443         const void              *branchTo,
    444         char*                   instructions )
    445 {
    446 
    447         //      Copy over the template code.
    448     bcopy( kIslandTemplate, island->instructions, sizeof( kIslandTemplate ) );
    449    
    450         // copy original instructions
    451         if (instructions) {
    452                 bcopy (instructions, island->instructions + kInstructions, kOriginalInstructionsSize);
    453         }
    454        
    455     //  Fill in the address.
    456         int32_t addressOffset = (char *)branchTo - (island->instructions + kJumpAddress + 4);
    457         *((int32_t *)(island->instructions + kJumpAddress)) = addressOffset;
    458        
    459     //MakeDataExecutable( island->instructions, sizeof( kIslandTemplate ) );
    460         msync( island->instructions, sizeof( kIslandTemplate ), MS_INVALIDATE );
    461 
    462     return err_none;
    463 }
    464 #endif
    465 
    466 
    467 #if defined (__i386__)
    468 // simplistic instruction matching
    469 typedef struct {
    470         unsigned int length; // max 15
    471         unsigned char mask[15]; // sequence of bytes in memory order
    472         unsigned char constraint[15]; // sequence of bytes in memory order
    473 }       AsmInstructionMatch;
    474 
    475 static AsmInstructionMatch possibleInstructions[] = {
    476         { 0x1, {0xFF}, {0x90} },                                                        // nop
    477         { 0x1, {0xFF}, {0x55} },                                                        // push %esp
    478         { 0x2, {0xFF, 0xFF}, {0x89, 0xE5} },                            // mov %esp,%ebp
    479         { 0x1, {0xFF}, {0x53} },                                                        // push %ebx
    480         { 0x3, {0xFF, 0xFF, 0x00}, {0x83, 0xEC, 0x00} },        // sub 0x??, %esp
    481         { 0x1, {0xFF}, {0x57} },                                                        // push %edi
    482         { 0x1, {0xFF}, {0x56} },                                                        // push %esi
    483         { 0x0 }
    484 };
    485 
    486 static Boolean codeMatchesInstruction(unsigned char *code, AsmInstructionMatch* instruction)
    487 {
    488         Boolean match = true;
    489        
    490         int i;
    491         for (i=0; i<instruction->length; i++) {
    492                 unsigned char mask = instruction->mask[i];
    493                 unsigned char constraint = instruction->constraint[i];
    494                 unsigned char codeValue = code[i];
    495                 match = ((codeValue & mask) == constraint);
    496                 if (!match) break;
    497         }
    498        
    499         return match;
    500 }
    501 
    502         static Boolean
    503 eatKnownInstructions(
    504         unsigned char *code,
    505         uint64_t* newInstruction,
    506         int* howManyEaten,
    507         char* originalInstructions )
    508 {
    509         Boolean allInstructionsKnown = true;
    510         int totalEaten = 0;
    511         unsigned char* ptr = code;
    512         int remainsToEat = 5; // a JMP instruction takes 5 bytes
    513        
    514         if (howManyEaten) *howManyEaten = 0;
    515         while (remainsToEat > 0) {
    516                 Boolean curInstructionKnown = false;
    517                
    518                 // See if instruction matches one  we know
    519                 AsmInstructionMatch* curInstr = possibleInstructions;
    520                 do {
    521                         if (curInstructionKnown = codeMatchesInstruction(ptr, curInstr)) break;
    522                         curInstr++;
    523                 } while (curInstr->length > 0);
    524                
    525                 // if all instruction matches failed, we don't know current instruction then, stop here
    526                 if (!curInstructionKnown) {
    527                         allInstructionsKnown = false;
    528                         break;
    529                 }
    530                
    531                 // At this point, we've matched curInstr
    532                 int eaten = curInstr->length;
    533                 ptr += eaten;
    534                 remainsToEat -= eaten;
    535                 totalEaten += eaten;
    536         }
    537 
    538 
    539         if (howManyEaten) *howManyEaten = totalEaten;
    540 
    541         if (originalInstructions) {
    542                 Boolean enoughSpaceForOriginalInstructions = (totalEaten < kOriginalInstructionsSize);
    543                
    544                 if (enoughSpaceForOriginalInstructions) {
    545                         memset(originalInstructions, 0x90 /* NOP */, kOriginalInstructionsSize); // fill instructions with NOP
    546                         bcopy(code, originalInstructions, totalEaten);
    547                 } else {
    548                         // printf ("Not enough space in island to store original instructions. Adapt the island definition and kOriginalInstructionsSize\n");
    549                         return false;
    550                 }
    551         }
    552        
    553         if (allInstructionsKnown) {
    554                 // save last 3 bytes of first 64bits of codre we'll replace
    555                 uint64_t currentFirst64BitsOfCode = *((uint64_t *)code);
    556                 currentFirst64BitsOfCode = OSSwapInt64(currentFirst64BitsOfCode); // back to memory representation
    557                 currentFirst64BitsOfCode &= 0x0000000000FFFFFFLL;
    558                
    559                 // keep only last 3 instructions bytes, first 5 will be replaced by JMP instr
    560                 *newInstruction &= 0xFFFFFFFFFF000000LL; // clear last 3 bytes
    561                 *newInstruction |= (currentFirst64BitsOfCode & 0x0000000000FFFFFFLL); // set last 3 bytes
    562         }
    563 
    564         return allInstructionsKnown;
    565 }
    566 
    567 asm(           
    568                         ".text;"
    569                         ".align 2, 0x90;"
    570                         ".globl _atomic_mov64;"
    571                         "_atomic_mov64:;"
    572                         "       pushl %ebp;"
    573                         "       movl %esp, %ebp;"
    574                         "       pushl %esi;"
    575                         "       pushl %ebx;"
    576                         "       pushl %ecx;"
    577                         "       pushl %eax;"
    578                         "       pushl %edx;"
    579        
    580                         // atomic push of value to an address
    581                         // we use cmpxchg8b, which compares content of an address with
    582                         // edx:eax. If they are equal, it atomically puts 64bit value
    583                         // ecx:ebx in address.
    584                         // We thus put contents of address in edx:eax to force ecx:ebx
    585                         // in address
    586                         "       mov             8(%ebp), %esi;"  // esi contains target address
    587                         "       mov             12(%ebp), %ebx;"
    588                         "       mov             16(%ebp), %ecx;" // ecx:ebx now contains value to put in target address
    589                         "       mov             (%esi), %eax;"
    590                         "       mov             4(%esi), %edx;"  // edx:eax now contains value currently contained in target address
    591                         "       lock; cmpxchg8b (%esi);" // atomic move.
    592                        
    593                         // restore registers
    594                         "       popl %edx;"
    595                         "       popl %eax;"
    596                         "       popl %ecx;"
    597                         "       popl %ebx;"
    598                         "       popl %esi;"
    599                         "       popl %ebp;"
    600                         "       ret"
    601 );
    602 
    603 #endif

  • deleted file dports/lang/erlang/files/mach_override.h 

    diff --git a/dports/lang/erlang/files/mach_override.h b/dports/lang/erlang/files/mach_override.h
deleted file mode 100644
index c07a9af..0000000
    + -  
    1 /*******************************************************************************
    2         mach_override.h
    3                 Copyright (c) 2003-2005 Jonathan 'Wolf' Rentzsch: <http://rentzsch.com>
    4                 Some rights reserved: <http://creativecommons.org/licenses/by/2.0/>
    5 
    6         ***************************************************************************/
    7 
    8 /***************************************************************************//**
    9         @mainpage       mach_override
    10         @author         Jonathan 'Wolf' Rentzsch: <http://rentzsch.com>
    11        
    12         This package, coded in C to the Mach API, allows you to override ("patch")
    13         program- and system-supplied functions at runtime. You can fully replace
    14         functions with your implementations, or merely head- or tail-patch the
    15         original implementations.
    16        
    17         Use it by #include'ing mach_override.h from your .c, .m or .mm file(s).
    18        
    19         @todo   Discontinue use of Carbon's MakeDataExecutable() and
    20                         CompareAndSwap() calls and start using the Mach equivalents, if they
    21                         exist. If they don't, write them and roll them in. That way, this
    22                         code will be pure Mach, which will make it easier to use everywhere.
    23                         Update: MakeDataExecutable() has been replaced by
    24                         msync(MS_INVALIDATE). There is an OSCompareAndSwap in libkern, but
    25                         I'm currently unsure if I can link against it. May have to roll in
    26                         my own version...
    27         @todo   Stop using an entire 4K high-allocated VM page per 28-byte escape
    28                         branch island. Done right, this will dramatically speed up escape
    29                         island allocations when they number over 250. Then again, if you're
    30                         overriding more than 250 functions, maybe speed isn't your main
    31                         concern...
    32         @todo   Add detection of: b, bl, bla, bc, bcl, bcla, bcctrl, bclrl
    33                         first-instructions. Initially, we should refuse to override
    34                         functions beginning with these instructions. Eventually, we should
    35                         dynamically rewrite them to make them position-independent.
    36         @todo   Write mach_unoverride(), which would remove an override placed on a
    37                         function. Must be multiple-override aware, which means an almost
    38                         complete rewrite under the covers, because the target address can't
    39                         be spread across two load instructions like it is now since it will
    40                         need to be atomically updatable.
    41         @todo   Add non-rentry variants of overrides to test_mach_override.
    42 
    43         ***************************************************************************/
    44 
    45 #ifndef         _mach_override_
    46 #define         _mach_override_
    47 
    48 #include <sys/types.h>
    49 #include <mach/error.h>
    50 
    51 #ifdef  __cplusplus
    52         extern  "C"     {
    53 #endif
    54 
    55 /**
    56         Returned if the function to be overrided begins with a 'mfctr' instruction.
    57 */
    58 #define err_cannot_override     (err_local|1)
    59 
    60 /***************************************************************************//**
    61         Dynamically overrides the function implementation referenced by
    62         originalFunctionSymbolName with the implentation pointed to by
    63         overrideFunctionAddress. Optionally returns a pointer to a "reentry island"
    64         which, if jumped to, will resume the original implementation.
    65        
    66         @param  originalFunctionSymbolName              ->      Required symbol name of the
    67                                                                                                 function to override (with
    68                                                                                                 overrideFunctionAddress).
    69                                                                                                 Remember, C function name
    70                                                                                                 symbols are prepended with an
    71                                                                                                 underscore.
    72         @param  originalFunctionLibraryNameHint ->      Optional name of the library
    73                                                                                                 which contains
    74                                                                                                 originalFunctionSymbolName. Can
    75                                                                                                 be NULL, but this may result in
    76                                                                                                 the wrong function being
    77                                                                                                 overridden and/or a crash.
    78         @param  overrideFunctionAddress                 ->      Required address to the
    79                                                                                                 overriding function.
    80         @param  originalFunctionReentryIsland   <-      Optional pointer to pointer to
    81                                                                                                 the reentry island. Can be NULL.
    82         @result                                                                 <-      err_cannot_override if the
    83                                                                                                 original function's
    84                                                                                                 implementation begins with the
    85                                                                                                 'mfctr' instruction.
    86 
    87         ***************************************************************************/
    88          
    89     mach_error_t
    90 mach_override(
    91     char *originalFunctionSymbolName,
    92     const char *originalFunctionLibraryNameHint,
    93     const void *overrideFunctionAddress,
    94     void **originalFunctionReentryIsland );
    95 
    96 /************************************************************************************//**
    97         Dynamically overrides the function implementation referenced by
    98         originalFunctionAddress with the implentation pointed to by overrideFunctionAddress.
    99         Optionally returns a pointer to a "reentry island" which, if jumped to, will resume
    100         the original implementation.
    101        
    102         @param  originalFunctionAddress                 ->      Required address of the function to
    103                                                                                                 override (with overrideFunctionAddress).
    104         @param  overrideFunctionAddress                 ->      Required address to the overriding
    105                                                                                                 function.
    106         @param  originalFunctionReentryIsland   <-      Optional pointer to pointer to the
    107                                                                                                 reentry island. Can be NULL.
    108         @result                                                                 <-      err_cannot_override if the original
    109                                                                                                 function's implementation begins with
    110                                                                                                 the 'mfctr' instruction.
    111 
    112         ************************************************************************************/
    113 
    114     mach_error_t
    115 mach_override_ptr(
    116         void *originalFunctionAddress,
    117     const void *overrideFunctionAddress,
    118     void **originalFunctionReentryIsland );
    119  
    120 #ifdef  __cplusplus
    121         }
    122 #endif
    123 #endif  //      _mach_override_
    124  No newline at end of file

  • deleted file dports/lang/erlang/files/patch-eunit_xml.diff 

    diff --git a/dports/lang/erlang/files/patch-eunit_xml.diff b/dports/lang/erlang/files/patch-eunit_xml.diff
deleted file mode 100644
index 471dbfd..0000000
    + -  
    1 Index: lib/eunit/src/eunit_xml.erl
    2 ===================================================================
    3 --- lib/eunit/src/eunit_xml.erl (revision 0)
    4 +++ lib/eunit/src/eunit_xml.erl (revision 0)
    5 @@ -0,0 +1,496 @@
    6 +%% This library is free software; you can redistribute it and/or modify
    7 +%% it under the terms of the GNU Lesser General Public License as
    8 +%% published by the Free Software Foundation; either version 2 of the
    9 +%% License, or (at your option) any later version.
    10 +%%
    11 +%% This library is distributed in the hope that it will be useful, but
    12 +%% WITHOUT ANY WARRANTY; without even the implied warranty of
    13 +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
    14 +%% Lesser General Public License for more details.
    15 +%%
    16 +%% You should have received a copy of the GNU Lesser General Public
    17 +%% License along with this library; if not, write to the Free Software
    18 +%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
    19 +%% USA
    20 +%%
    21 +%% $Id$
    22 +%%
    23 +%% @author Paul Guyot <paulguyot@ieee.org>
    24 +%% @copyright 2008 Paul Guyot
    25 +%% @private
    26 +%% @see eunit
    27 +%% @doc XML reports for EUnit
    28 +
    29 +-module(eunit_xml).
    30 +
    31 +-include("eunit.hrl").
    32 +-include("eunit_internal.hrl").
    33 +
    34 +-export([start/3]).
    35 +
    36 +%% ============================================================================
    37 +%% MACROS
    38 +%% ============================================================================
    39 +-define(INDENT, <<"  ">>).
    40 +-define(NEWLINE, <<"\n">>).
    41 +
    42 +%% ============================================================================
    43 +%% TYPES
    44 +%% ============================================================================
    45 +-type(chars() :: [char() | any()]). % chars()
    46 +-type(item_name() :: {
    47 +    Module :: atom(),
    48 +    Function :: atom(),
    49 +    Line :: integer() } | {
    50 +    Module :: atom(),
    51 +    Function :: atom() }).
    52 +-type(tree_entry() :: {
    53 +    Kind :: group | item,
    54 +    Id :: [integer()],
    55 +    Description :: string(),
    56 +    item_name() | [any()]}). % tree_entry()
    57 +
    58 +%% ============================================================================
    59 +%% RECORDS
    60 +%% ============================================================================
    61 +-record(testcase,
    62 +    {
    63 +    name :: chars(),
    64 +    description :: chars(),
    65 +    result :: ok | {failed, tuple()} | {aborted, tuple()} | {skipped, tuple()},
    66 +    time :: integer(),
    67 +    output :: chars()
    68 +    }).
    69 +-record(testsuite,
    70 +    {
    71 +    name = [] :: chars(),
    72 +    time = 0 :: integer(),
    73 +    output = [] :: chars(),
    74 +    succeeded = 0 :: integer(),
    75 +    failed = 0 :: integer(),
    76 +    aborted = 0 :: integer(),
    77 +    skipped = 0 :: integer(),
    78 +    testcases = [] :: [#testcase{}]
    79 +    }).
    80 +
    81 +-spec(start/3::([any()], [any()], string())->pid()).
    82 +start(List, Options, XmlDir) ->
    83 +    spawn(fun() -> init(List, Options, XmlDir) end).
    84 +
    85 +init(List, _Options, XmlDir) ->
    86 +    TestSuites = dict:new(),
    87 +    loop(TestSuites, List, XmlDir).
    88 +
    89 +loop(TestSuites, List, XmlDir) ->
    90 +    receive
    91 +        {status, Id, Status} ->
    92 +            NewTestSuites = process_status(TestSuites, List, Id, Status),
    93 +            loop(NewTestSuites, List, XmlDir);
    94 +        {start, _Reference} ->
    95 +            loop(TestSuites, List, XmlDir);
    96 +        {stop, _Reference, _Pid} ->
    97 +            write_reports(TestSuites, XmlDir);
    98 +        Unknown ->
    99 +            io:format("Unknown message: ~p~n", [Unknown]),
    100 +            loop(TestSuites, List, XmlDir)
    101 +    end.
    102 +
    103 +%% ----------------------------------------------------------------------------
    104 +%% Process a status message.
    105 +%% ----------------------------------------------------------------------------
    106 +process_status(TestSuites, _List, _Id, {progress, 'begin', _Result}) ->
    107 +    TestSuites;
    108 +process_status(TestSuites, _List, [], {progress, 'end', _Result}) ->
    109 +    TestSuites;
    110 +process_status(TestSuites, List, [GroupId] = Id, {progress, 'end', {Count, Time, Output}}) when is_integer(Count) ->
    111 +    TestSuite = case dict:find(GroupId, TestSuites) of
    112 +        {ok, Value} -> Value;
    113 +        error -> #testsuite{}
    114 +    end,
    115 +    Name = case entry(List, Id) of
    116 +        {value, {group, Id, Description, _Items}} ->
    117 +            Description;
    118 +        _ -> ["Unknown-", integer_to_list(GroupId)]
    119 +    end,
    120 +    NewTestSuite = TestSuite#testsuite{
    121 +        name = Name,
    122 +        time = Time,
    123 +        output = Output},
    124 +    dict:store(GroupId, NewTestSuite, TestSuites);
    125 +process_status(TestSuites, _List, _Id, {progress, 'end', {Count, _Time, _Output}}) when is_integer(Count)->
    126 +    TestSuites;
    127 +process_status(TestSuites, List, [GroupId | _Tail] = Id, {progress, 'end', {ok, Time, Output}}) ->
    128 +    case entry(List, Id) of
    129 +        {value, {item, Id, Description, NameTuple}} ->
    130 +            TestSuite = case dict:find(GroupId, TestSuites) of
    131 +                {ok, Value} -> Value;
    132 +                error -> #testsuite{}
    133 +            end,
    134 +            Name = format_name(NameTuple),
    135 +            TestCase = #testcase{
    136 +                    name = Name,
    137 +                    description = Description,
    138 +                    result = ok,
    139 +                    time = Time,
    140 +                    output = Output},
    141 +            NewTestSuite = TestSuite#testsuite{
    142 +                succeeded = TestSuite#testsuite.succeeded + 1,
    143 +                testcases = [TestCase | TestSuite#testsuite.testcases]},
    144 +            dict:store(GroupId, NewTestSuite, TestSuites);
    145 +        _ -> TestSuites
    146 +    end;
    147 +process_status(
    148 +        TestSuites, List, [GroupId | _Tail] = Id,
    149 +        {progress, 'end', {{error, {error, {AssertionException, _Details}, _Trace} = Exception}, Time, Output}})
    150 +            when
    151 +                AssertionException == assertion_failed;
    152 +                AssertionException == assertMatch_failed;
    153 +                AssertionException == assertEqual_failed;
    154 +                AssertionException == assertException_failed;
    155 +                AssertionException == assertCmd_failed;
    156 +                AssertionException == assertCmdOutput_failed ->
    157 +    case entry(List, Id) of
    158 +        {value, {item, Id, Description, NameTuple}} ->
    159 +            TestSuite = case dict:find(GroupId, TestSuites) of
    160 +                {ok, Value} -> Value;
    161 +                error -> #testsuite{}
    162 +            end,
    163 +            Name = format_name(NameTuple),
    164 +            TestCase = #testcase{
    165 +                    name = Name,
    166 +                    description = Description,
    167 +                    result = {failed, Exception},
    168 +                    time = Time,
    169 +                    output = Output},
    170 +            NewTestSuite = TestSuite#testsuite{
    171 +                failed = TestSuite#testsuite.failed + 1,
    172 +                testcases = [TestCase | TestSuite#testsuite.testcases]},
    173 +            dict:store(GroupId, NewTestSuite, TestSuites);
    174 +        _ -> TestSuites
    175 +    end;
    176 +process_status(TestSuites, List, [GroupId | _Tail] = Id, {progress, 'end', {{error, Exception}, Time, Output}}) ->
    177 +    case entry(List, Id) of
    178 +        {value, {item, Id, Description, NameTuple}} ->
    179 +            TestSuite = case dict:find(GroupId, TestSuites) of
    180 +                {ok, Value} -> Value;
    181 +                error -> #testsuite{}
    182 +            end,
    183 +            Name = format_name(NameTuple),
    184 +            TestCase = #testcase{
    185 +                    name = Name,
    186 +                    description = Description,
    187 +                    result = {aborted, Exception},
    188 +                    time = Time,
    189 +                    output = Output},
    190 +            NewTestSuite = TestSuite#testsuite{
    191 +                aborted = TestSuite#testsuite.aborted + 1,
    192 +                testcases = [TestCase | TestSuite#testsuite.testcases]},
    193 +            dict:store(GroupId, NewTestSuite, TestSuites);
    194 +        _ -> TestSuites
    195 +    end;
    196 +process_status(TestSuites, _List, _Id, {cancel, undefined}) -> TestSuites;
    197 +process_status(TestSuites, List, [GroupId, _Tail] = Id, {cancel, Reason}) ->
    198 +    TestSuite = case dict:find(GroupId, TestSuites) of
    199 +        {ok, Value} -> Value;
    200 +        error -> #testsuite{}
    201 +    end,
    202 +    dict:store(GroupId, process_cancel(TestSuite, List, Id, Reason), TestSuites);
    203 +process_status(TestSuites, _List, _Id, Status) ->
    204 +    io:format("Unknown status = ~p~n", [Status]),
    205 +    TestSuites.
    206 +
    207 +%% ----------------------------------------------------------------------------
    208 +%% Process a cancel status.
    209 +%% ----------------------------------------------------------------------------
    210 +process_cancel(TestSuite, List, Id, Reason) ->
    211 +    case entry(List, Id) of
    212 +        {value, {item, Id, _Description, _NameTuple} = Item} ->
    213 +            process_cancel_items(TestSuite, [Item], [], Reason);
    214 +        {value, {group, Id, _Description, Items}} ->
    215 +            process_cancel_items(TestSuite, Items, [], Reason);
    216 +        _ -> TestSuite
    217 +    end.
    218 +
    219 +%% ----------------------------------------------------------------------------
    220 +%% Process the tests that were skipped because of an error.
    221 +%%
    222 +-spec(process_cancel_items/4 :: (#testsuite{}, Items :: [tree_entry()], Acc :: [[tree_entry()]], Reason :: tuple()) -> #testsuite{}).
    223 +%% ----------------------------------------------------------------------------
    224 +process_cancel_items(TestSuite, [], [], _Reason) -> TestSuite;
    225 +process_cancel_items(TestSuite, [], [Acc | Tail], Reason) ->
    226 +    process_cancel_items(TestSuite, Acc, Tail, Reason);
    227 +process_cancel_items(TestSuite, [{item, _Id, Description, NameTuple} | Tail], Acc, Reason) ->
    228 +    Name = format_name(NameTuple),
    229 +    TestCase = #testcase{
    230 +        name = Name,
    231 +        description = Description,
    232 +        result = {skipped, Reason},
    233 +        time = 0,
    234 +        output = []},
    235 +    NewTestSuite = TestSuite#testsuite{
    236 +        skipped = TestSuite#testsuite.skipped + 1,
    237 +        testcases = [TestCase | TestSuite#testsuite.testcases]},
    238 +    process_cancel_items(NewTestSuite, Tail, Acc, Reason);
    239 +process_cancel_items(TestSuite, [{group, _Id, _Description, Items} | Tail], Acc, Reason) ->
    240 +    process_cancel_items(TestSuite, Items, [Tail | Acc], Reason).
    241 +
    242 +%% ----------------------------------------------------------------------------
    243 +%% Convert a test description into a test case name.
    244 +%% If the test description is a module function, use the function's name.
    245 +%% If the test description is a module function plus a line, use function.line.
    246 +%% ----------------------------------------------------------------------------
    247 +format_name({_Module, Function}) -> atom_to_list(Function);
    248 +format_name({_Module, Function, Line}) -> [atom_to_list(Function), $., integer_to_list(Line)].
    249 +
    250 +%% ----------------------------------------------------------------------------
    251 +%% Write the reports to the XML directory.
    252 +%% ----------------------------------------------------------------------------
    253 +write_reports(TestSuites, XmlDir) ->
    254 +    dict:fold(fun(_GroupId, TestSuite, Acc) -> write_report(TestSuite, XmlDir), Acc end, [], TestSuites).
    255 +
    256 +%% ----------------------------------------------------------------------------
    257 +%% Write a report to the XML directory.
    258 +%% This function opens the report file, calls write_report_to/2 and closes the file.
    259 +%% ----------------------------------------------------------------------------
    260 +write_report(#testsuite{name = Name} = TestSuite, XmlDir) ->
    261 +    Filename = filename:join(XmlDir, lists:flatten(["TEST-", escape_suitename(Name)], ".xml")),
    262 +    case file:open(Filename, [write, raw]) of
    263 +        {ok, FileDescriptor} ->
    264 +            try
    265 +                write_report_to(TestSuite, FileDescriptor)
    266 +            after
    267 +                file:close(FileDescriptor)
    268 +            end;
    269 +        {error, _Reason} = Error -> throw(Error)
    270 +    end.
    271 +
    272 +%% ----------------------------------------------------------------------------
    273 +%% Actually write a report.
    274 +%% ----------------------------------------------------------------------------
    275 +write_report_to(TestSuite, FileDescriptor) ->
    276 +    write_header(FileDescriptor),
    277 +    write_start_tag(TestSuite, FileDescriptor),
    278 +    write_testcases(TestSuite#testsuite.testcases, FileDescriptor),
    279 +    write_end_tag(FileDescriptor).
    280 +
    281 +%% ----------------------------------------------------------------------------
    282 +%% Write the XML header.
    283 +%% ----------------------------------------------------------------------------
    284 +write_header(FileDescriptor) ->
    285 +    file:write(FileDescriptor, [<<"<?xml version=\"1.0\" encoding=\"UTF-8\" ?>">>, ?NEWLINE]).
    286 +
    287 +%% ----------------------------------------------------------------------------
    288 +%% Write the testsuite start tag, with attributes describing the statistics
    289 +%% of the test suite.
    290 +%% ----------------------------------------------------------------------------
    291 +write_start_tag(
    292 +        #testsuite{
    293 +            name = Name,
    294 +            time = Time,
    295 +            succeeded = Succeeded,
    296 +            failed = Failed,
    297 +            skipped = Skipped,
    298 +            aborted = Aborted},
    299 +        FileDescriptor) ->
    300 +    Total = Succeeded + Failed + Skipped + Aborted,
    301 +    StartTag = [
    302 +        <<"<testsuite tests=\"">>, integer_to_list(Total),
    303 +        <<"\" failures=\"">>, integer_to_list(Failed),
    304 +        <<"\" errors=\"">>, integer_to_list(Aborted),
    305 +        <<"\" skipped=\"">>, integer_to_list(Skipped),
    306 +        <<"\" time=\"">>, format_time(Time),
    307 +        <<"\" name=\"">>, escape_attr(Name),
    308 +        <<"\">">>, ?NEWLINE],       
    309 +    file:write(FileDescriptor, StartTag).
    310 +
    311 +%% ----------------------------------------------------------------------------
    312 +%% Recursive function to write the test cases.
    313 +%% ----------------------------------------------------------------------------
    314 +write_testcases([], _FileDescriptor) -> void;
    315 +write_testcases([TestCase| Tail], FileDescriptor) ->
    316 +    write_testcase(TestCase, FileDescriptor),
    317 +    write_testcases(Tail, FileDescriptor).
    318 +
    319 +%% ----------------------------------------------------------------------------
    320 +%% Write the testsuite end tag.
    321 +%% ----------------------------------------------------------------------------
    322 +write_end_tag(FileDescriptor) ->
    323 +    file:write(FileDescriptor, [<<"</testsuite>">>, ?NEWLINE]).
    324 +
    325 +%% ----------------------------------------------------------------------------
    326 +%% Write a test case, as a testcase tag.
    327 +%% If the test case was successful and if there was no output, we write an empty
    328 +%% tag.
    329 +%% ----------------------------------------------------------------------------
    330 +write_testcase(
    331 +        #testcase{
    332 +            name = Name,
    333 +            description = Description,
    334 +            result = Result,
    335 +            time = Time,
    336 +            output = Output},
    337 +        FileDescriptor) ->
    338 +    DescriptionAttr = case Description of
    339 +        [] -> [];
    340 +        _ -> [<<" description=\"">>, escape_attr(Description), <<"\"">>]
    341 +    end,
    342 +    StartTag = [
    343 +        ?INDENT, <<"<testcase time=\"">>, format_time(Time),
    344 +        <<"\" name=\"">>, escape_attr(Name), <<"\"">>,
    345 +        DescriptionAttr],
    346 +    ContentAndEndTag = case {Result, Output} of
    347 +        {ok, []} -> [<<"/>">>, ?NEWLINE];
    348 +        _ -> [<<">">>, ?NEWLINE, format_testcase_result(Result), format_testcase_output(Output), ?INDENT, <<"</testcase>">>, ?NEWLINE]
    349 +    end,
    350 +    file:write(FileDescriptor, [StartTag, ContentAndEndTag]).
    351 +
    352 +%% ----------------------------------------------------------------------------
    353 +%% Format the result of the test.
    354 +%% Failed tests are represented with a failure tag.
    355 +%% Aborted tests are represented with an error tag.
    356 +%% Skipped tests are represented with a skipped tag.
    357 +%% ----------------------------------------------------------------------------
    358 +format_testcase_result(ok) -> [];
    359 +format_testcase_result({failed, {error, {Type, _}, _} = Exception}) when is_atom(Type) ->
    360 +    [?INDENT, ?INDENT, <<"<failure type=\"">>, escape_attr(atom_to_list(Type)), <<"\">">>, ?NEWLINE,
    361 +    <<"::">>, escape_text(eunit_lib:format_exception(Exception)),
    362 +    ?INDENT, ?INDENT, <<"</failure>">>, ?NEWLINE];
    363 +format_testcase_result({failed, Term}) ->
    364 +    [?INDENT, ?INDENT, <<"<failure type=\"unknown\">">>, ?NEWLINE,
    365 +    escape_text(io_lib:write(Term)),
    366 +    ?INDENT, ?INDENT, <<"</failure>">>, ?NEWLINE];
    367 +format_testcase_result({aborted, {Class, _Term, _Trace} = Exception}) when is_atom(Class) ->
    368 +    [?INDENT, ?INDENT, <<"<error type=\"">>, escape_attr(atom_to_list(Class)), <<"\">">>, ?NEWLINE,
    369 +    <<"::">>, escape_text(eunit_lib:format_exception(Exception)),
    370 +    ?INDENT, ?INDENT, <<"</error>">>, ?NEWLINE];
    371 +format_testcase_result({aborted, Term}) ->
    372 +    [?INDENT, ?INDENT, <<"<error type=\"unknown\">">>, ?NEWLINE,
    373 +    escape_text(io_lib:write(Term)),
    374 +    ?INDENT, ?INDENT, <<"</error>">>, ?NEWLINE];
    375 +format_testcase_result({skipped, {abort, Error}}) when is_tuple(Error) ->
    376 +    [?INDENT, ?INDENT, <<"<skipped type=\"">>, escape_attr(atom_to_list(element(1, Error))), <<"\">">>, ?NEWLINE,
    377 +    escape_text(eunit_lib:format_error(Error)),
    378 +    ?INDENT, ?INDENT, <<"</skipped>">>, ?NEWLINE];
    379 +format_testcase_result({skipped, {Type, Term}}) when is_atom(Type) ->
    380 +    [?INDENT, ?INDENT, <<"<skipped type=\"">>, escape_attr(atom_to_list(Type)), <<"\">">>, ?NEWLINE,
    381 +    escape_text(io_lib:write(Term)),
    382 +    ?INDENT, ?INDENT, <<"</skipped>">>, ?NEWLINE];
    383 +format_testcase_result({skipped, Term}) ->
    384 +    [?INDENT, ?INDENT, <<"<skipped type=\"unknown\">">>, ?NEWLINE,
    385 +    escape_text(io_lib:write(Term)),
    386 +    ?INDENT, ?INDENT, <<"</skipped>">>, ?NEWLINE].
    387 +
    388 +%% ----------------------------------------------------------------------------
    389 +%% Format the output of a test case in xml.
    390 +%% Empty output is simply the empty string.
    391 +%% Other output is inside a <system-out> xml tag.
    392 +%% ----------------------------------------------------------------------------
    393 +format_testcase_output([]) -> [];
    394 +format_testcase_output(Output) ->
    395 +    [?INDENT, ?INDENT, <<"<system-out>">>, escape_text(Output), ?NEWLINE, ?INDENT, ?INDENT, <<"</system-out>">>, ?NEWLINE].
    396 +
    397 +%% ----------------------------------------------------------------------------
    398 +%% Return the time in the SECS.MILLISECS format.
    399 +%% ----------------------------------------------------------------------------
    400 +format_time(Time) ->
    401 +    format_time_s(lists:reverse(integer_to_list(Time))).
    402 +format_time_s([Digit]) -> ["0.00", Digit];
    403 +format_time_s([Digit1, Digit2]) -> ["0.0", Digit2, Digit1];
    404 +format_time_s([Digit1, Digit2, Digit3]) -> ["0.", Digit3, Digit2, Digit1];
    405 +format_time_s([Digit1, Digit2, Digit3 | Tail]) -> [lists:reverse(Tail), $., Digit3, Digit2, Digit1].
    406 +
    407 +%% ----------------------------------------------------------------------------
    408 +%% Escape a suite's name to generate the filename.
    409 +%% Remark: we might overwrite another testsuite's file.
    410 +%% ----------------------------------------------------------------------------
    411 +escape_suitename([Head | _T] = List) when is_list(Head) ->
    412 +    escape_suitename(lists:flatten(List));
    413 +escape_suitename("module '" ++ String) ->
    414 +    escape_suitename(String);
    415 +escape_suitename(String) ->
    416 +    escape_suitename(String, []).
    417 +
    418 +escape_suitename([], Acc) -> lists:reverse(Acc);
    419 +escape_suitename([$  | Tail], Acc) -> escape_suitename(Tail, [$_ | Acc]);
    420 +escape_suitename([$' | Tail], Acc) -> escape_suitename(Tail, Acc);
    421 +escape_suitename([$/ | Tail], Acc) -> escape_suitename(Tail, [$: | Acc]);
    422 +escape_suitename([$\\ | Tail], Acc) -> escape_suitename(Tail, [$: | Acc]);
    423 +escape_suitename([Char | Tail], Acc) when Char < $! -> escape_suitename(Tail, Acc);
    424 +escape_suitename([Char | Tail], Acc) when Char > $~ -> escape_suitename(Tail, Acc);
    425 +escape_suitename([Char | Tail], Acc) -> escape_suitename(Tail, [Char | Acc]).
    426 +
    427 +%% ----------------------------------------------------------------------------
    428 +%% Escape text for XML text nodes.
    429 +%% Replace < with &lt;, > with &gt; and & with &amp;
    430 +%% ----------------------------------------------------------------------------
    431 +escape_text(Text) -> escape_xml(lists:flatten(Text), [], false).
    432 +
    433 +%% ----------------------------------------------------------------------------
    434 +%% Escape text for XML attribute nodes.
    435 +%% Replace < with &lt;, > with &gt; and & with &amp;
    436 +%% ----------------------------------------------------------------------------
    437 +escape_attr(Text) -> escape_xml(lists:flatten(Text), [], true).
    438 +
    439 +escape_xml([], Acc, _ForAttr) -> lists:reverse(Acc);
    440 +escape_xml([$< | Tail], Acc, ForAttr) -> escape_xml(Tail, [$;, $t, $l, $& | Acc], ForAttr);
    441 +escape_xml([$> | Tail], Acc, ForAttr) -> escape_xml(Tail, [$;, $t, $g, $& | Acc], ForAttr);
    442 +escape_xml([$& | Tail], Acc, ForAttr) -> escape_xml(Tail, [$;, $p, $m, $a, $& | Acc], ForAttr);
    443 +escape_xml([$" | Tail], Acc, true) -> escape_xml(Tail, [$;, $t, $o, $u, $q, $& | Acc], true);
    444 +escape_xml([Char | Tail], Acc, ForAttr) when is_integer(Char) -> escape_xml(Tail, [Char | Acc], ForAttr).
    445 +
    446 +%% ----------------------------------------------------------------------------
    447 +%% Determine if the second list begins with the first list.
    448 +%% Return true if it does, false if it doesn't.
    449 +%% ----------------------------------------------------------------------------
    450 +begins_with([], _L2) -> true;
    451 +begins_with([H|T1], [H|T2]) -> begins_with(T1, T2);
    452 +begins_with(_, _) -> false.
    453 +
    454 +%% ----------------------------------------------------------------------------
    455 +%% Return the entry in the tree for a given ID.
    456 +%% Return {value, Entry} if the entry was found or
    457 +%% not_found if it wasn't.
    458 +-spec(entry/2 :: (List :: [tree_entry()], Id :: [integer()]) -> {value, tree_entry()} | not_found).
    459 +%% ----------------------------------------------------------------------------
    460 +entry([{_Kind, Id, _Description, _Data} = Entry | _Tail], Id) -> {value, Entry};
    461 +entry([{group, [H|_] = Id, _Description, Subnodes} | Tail], [H|_] = NodeId) ->
    462 +    case begins_with(Id, NodeId) of
    463 +        true -> entry(Subnodes, NodeId);
    464 +        false -> entry(Tail, NodeId)
    465 +    end;
    466 +entry([_Node | Tail], NodeId) -> entry(Tail, NodeId);
    467 +entry([], _NodeId) -> not_found.
    468 +
    469 +-ifdef(TEST).
    470 +
    471 +format_time_test_() ->
    472 +    [
    473 +    ?_assertEqual("0.000", lists:flatten(format_time(0))),
    474 +    ?_assertEqual("0.001", lists:flatten(format_time(1))),
    475 +    ?_assertEqual("0.042", lists:flatten(format_time(42))),
    476 +    ?_assertEqual("0.123", lists:flatten(format_time(123))),
    477 +    ?_assertEqual("1.000", lists:flatten(format_time(1000))),
    478 +    ?_assertEqual("1.001", lists:flatten(format_time(1001))),
    479 +    ?_assertEqual("1.042", lists:flatten(format_time(1042))),
    480 +    ?_assertEqual("20.042", lists:flatten(format_time(20042)))
    481 +    ].
    482 +
    483 +escape_suitename_test_() ->
    484 +    [
    485 +    ?_assertEqual("sqlite_test", escape_suitename("module 'sqlite_test'")),
    486 +    ?_assertEqual("Unknown-2", escape_suitename(["Unknown-", "2"]))
    487 +    ].
    488 +
    489 +escape_test_() ->
    490 +    [
    491 +    ?_assertEqual("bla bla bla", escape_text("bla bla bla")),
    492 +    ?_assertEqual("1 &lt; 2 -&gt; true", escape_text("1 < 2 -> true")),
    493 +    ?_assertEqual("1 &amp; 2 -&gt; 0", escape_text("1 & 2 -> 0")),
    494 +    ?_assertEqual("and then it said \"Hello, Dave!\"", escape_text("and then it said \"Hello, Dave!\"")),
    495 +    ?_assertEqual("bla bla bla", escape_attr("bla bla bla")),
    496 +    ?_assertEqual("1 &lt; 2 -&gt; true", escape_attr("1 < 2 -> true")),
    497 +    ?_assertEqual("1 &amp; 2 -&gt; 0", escape_attr("1 & 2 -> 0")),
    498 +    ?_assertEqual("and then it said &quot;Hello, Dave!&quot;", escape_attr("and then it said \"Hello, Dave!\""))
    499 +    ].
    500 +
    501 +-endif.  % TEST
    502 Index: lib/eunit/src/eunit.erl
    503 ===================================================================
    504 --- lib/eunit/src/eunit.erl.orig        2008-11-04 11:52:12.000000000 +0100
    505 +++ lib/eunit/src/eunit.erl     2008-11-06 07:24:28.000000000 +0100
    506 @@ -148,7 +148,7 @@
    507      try eunit_data:list(Tests) of
    508         List ->
    509             Listeners = [eunit_tty:start(List, Options)
    510 -                        | listeners(Options)],
    511 +                        | listeners(List, Options)],
    512             Serial = eunit_serial:start(Listeners),
    513             case eunit_server:start_test(Server, Serial, Tests, Options) of
    514                 {ok, Reference} -> test_run(Reference, Listeners);
    515 @@ -197,10 +197,12 @@
    516      Dummy = spawn(fun devnull/0),
    517      eunit_server:start_test(Server, Dummy, T, Options).
    518  
    519 -listeners(Options) ->
    520 +listeners(List, Options) ->
    521      case proplists:get_value(event_log, Options) of
    522         undefined ->
    523             [];
    524 +       {xml, XmlDirectory} ->
    525 +           [eunit_xml:start(List, Options, XmlDirectory)];
    526         LogFile ->
    527             [spawn(fun () -> event_logger(LogFile) end)]
    528      end.
    529 Index: lib/eunit/src/Makefile
    530 ===================================================================
    531 --- lib/eunit/src/Makefile.orig 2008-11-04 11:52:12.000000000 +0100
    532 +++ lib/eunit/src/Makefile      2008-11-06 07:23:09.000000000 +0100
    533 @@ -37,7 +37,8 @@
    534         eunit_test.erl \
    535         eunit_lib.erl \
    536         eunit_data.erl \
    537 -       eunit_tty.erl
    538 +       eunit_tty.erl \
    539 +       eunit_xml.erl
    540  
    541  OBJECTS=$(SOURCES:%.erl=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET)
    542