git.oblomov.eu Git - wine/blob - programs/winetest/winetest.c

   1 /*
   2  * Perl interpreter for running Wine tests
   3  *
   4  * Copyright 2001 John F Sturtz for Codeweavers
   5  *
   6  * This library is free software; you can redistribute it and/or
   7  * modify it under the terms of the GNU Lesser General Public
   8  * License as published by the Free Software Foundation; either
   9  * version 2.1 of the License, or (at your option) any later version.
  10  *
  11  * This library is distributed in the hope that it will be useful,
  12  * but 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  USA
  19  */
  20
  21 #include <assert.h>
  22 #include <stdio.h>
  23
  24 #include "windef.h"
  25 #include "winbase.h"
  26
  27 #include <EXTERN.h>
  28 #include <perl.h>
  29
  30 static FARPROC pGetLastError;
  31
  32 /*----------------------------------------------------------------------
  33 | Function:    call_wine_func                                          |
  34 | -------------------------------------------------------------------- |
  35 | Purpose:     Call a wine API function, passing in appropriate number |
  36 |              of args                                                 |
  37 |                                                                      |
  38 | Parameters:  proc   -- function to call                              |
  39 |              n_args -- array of args                                 |
  40 |              a      -- array of args                                 |
  41 |                                                                      |
  42 | Returns:     return value from API function called                   |
  43 ----------------------------------------------------------------------*/
  44 static unsigned long call_wine_func
  45 (
  46     FARPROC        proc,
  47     int            n_args,
  48     unsigned long  *a
  49 )
  50 {
  51     /* Locals */
  52     unsigned long  rc;
  53
  54 /* Begin call_wine_func */
  55
  56     /*--------------------------------------------------------------
  57     | Now we need to call the function with the appropriate number
  58     | of arguments
  59     |
  60     | Anyone who can think of a better way to do this is welcome to
  61     | come forth with it ...
  62     --------------------------------------------------------------*/
  63     switch (n_args)
  64     {
  65
  66         case 0:  rc = proc (); break;
  67         case 1:  rc = proc (a[0]); break;
  68         case 2:  rc = proc (a[0], a[1]); break;
  69         case 3:  rc = proc (a[0], a[1], a[2]); break;
  70         case 4:  rc = proc (a[0], a[1], a[2], a[3]); break;
  71         case 5:  rc = proc (a[0], a[1], a[2], a[3], a[4]); break;
  72         case 6:  rc = proc (a[0], a[1], a[2], a[3], a[4], a[5]); break;
  73         case 7:  rc = proc (a[0], a[1], a[2], a[3], a[4], a[5], a[6]); break;
  74         case 8:  rc = proc (a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7]); break;
  75         case 9:  rc = proc (a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8]); break;
  76         case 10: rc = proc( a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8],
  77                             a[9] ); break;
  78         case 11: rc = proc( a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8],
  79                             a[9], a[10] ); break;
  80         case 12: rc = proc( a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8],
  81                             a[9], a[10], a[11] ); break;
  82         case 13: rc = proc( a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8],
  83                             a[9], a[10], a[11], a[12] ); break;
  84         case 14: rc = proc( a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8],
  85                             a[9], a[10], a[11], a[12], a[13] ); break;
  86         case 15: rc = proc( a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8],
  87                             a[9], a[10], a[11], a[12], a[13], a[14] ); break;
  88         case 16: rc = proc( a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8],
  89                             a[9], a[10], a[11], a[12], a[13], a[14], a[15] ); break;
  90         default:
  91             fprintf( stderr, "%d args not supported\n", n_args );
  92             rc = 0;
  93             break;
  94     }
  95
  96     /*--------------------------------------------------------------
  97     | Return value from func
  98     --------------------------------------------------------------*/
  99     return (rc);
 100 }
 101
 102
 103 /*----------------------------------------------------------------------
 104 | Function:    perl_call_wine
 105 | --------------------------------------------------------------------
 106 | Purpose:     Fetch and call a wine API function from a library
 107 |
 108 | Parameters:
 109 |
 110 |     proc       -- function address
 111 |     n_args     -- number of args
 112 |     args       -- args
 113 |     last_error -- returns the last error code
 114 |     debug      -- debug flag
 115 |
 116 | Returns:     Return value from API function called
 117 ----------------------------------------------------------------------*/
 118 unsigned long perl_call_wine
 119 (
 120     FARPROC        proc,
 121     int            n_args,
 122     unsigned long  *args,
 123     unsigned int   *last_error,
 124     int            debug
 125 )
 126 {
 127     unsigned long ret;
 128     DWORD error, old_error;
 129
 130     if (debug > 1)
 131     {
 132         int i;
 133         fprintf(stderr,"    perl_call_wine(func=%p", proc);
 134         for (i = 0; i < n_args; i++) fprintf( stderr, ",0x%lx", args[i] );
 135         fprintf( stderr, ")\n" );
 136     }
 137
 138     /* special case to allow testing GetLastError without messing up the last error code */
 139     if (proc == pGetLastError)
 140         ret = call_wine_func (proc, n_args, args);
 141     else
 142     {
 143         old_error = GetLastError();
 144         SetLastError( 0xdeadbeef );
 145         ret = call_wine_func (proc, n_args, args);
 146         error = GetLastError();
 147         if (error != 0xdeadbeef) *last_error = error;
 148         else SetLastError( old_error );
 149     }
 150     return ret;
 151 }
 152
 153
 154 /* perl extension initialisation */
 155 static void xs_init(void)
 156 {
 157     extern void boot_wine(CV *cv);
 158     newXS("wine::bootstrap", boot_wine,__FILE__);
 159 }
 160
 161 /* main function */
 162 int main( int argc, char **argv, char **envp )
 163 {
 164     PerlInterpreter *perl;
 165     int status;
 166
 167     envp = environ;  /* envp is not valid (yet) in Winelib */
 168
 169     pGetLastError = GetProcAddress( GetModuleHandleA("kernel32"), "GetLastError" );
 170     assert( pGetLastError );
 171
 172     if (!(perl = perl_alloc ()))
 173     {
 174         fprintf( stderr, "Could not allocate perl interpreter\n" );
 175         exit(1);
 176     }
 177     perl_construct (perl);
 178     status = perl_parse( perl, xs_init, argc, argv, envp );
 179     if (!status) status = perl_run(perl);
 180     perl_destruct (perl);
 181     perl_free (perl);
 182     exit( status );
 183 }