Google Git Google Git
Sign in
goma/wine/b1df392f02c8cc74078bb807bac6224ff9289791/./programs/winetest/winetest.c
blob: 3e9e6737036654886735b9f0b988801aca4b8463 [file]
/*
* Perl interpreter for running Wine tests
*
* Copyright 2001 John F Sturtz for Codeweavers
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#include <assert.h>
#include <stdio.h>
#include "windef.h"
#include "winbase.h"
#include <EXTERN.h>
#include <perl.h>
static FARPROC pGetLastError;
/*----------------------------------------------------------------------
| Function: call_wine_func |
| -------------------------------------------------------------------- |
| Purpose: Call a wine API function, passing in appropriate number |
| of args |
| |
| Parameters: proc -- function to call |
| n_args -- array of args |
| a -- array of args |
| |
| Returns: return value from API function called |
----------------------------------------------------------------------*/
static unsigned long call_wine_func
(
FARPROC proc,
int n_args,
unsigned long *a
)
{
/* Locals */
unsigned long rc;
/* Begin call_wine_func */
/*--------------------------------------------------------------
| Now we need to call the function with the appropriate number
| of arguments
|
| Anyone who can think of a better way to do this is welcome to
| come forth with it ...
--------------------------------------------------------------*/
switch (n_args)
{
case 0: rc = proc (); break;
case 1: rc = proc (a[0]); break;
case 2: rc = proc (a[0], a[1]); break;
case 3: rc = proc (a[0], a[1], a[2]); break;
case 4: rc = proc (a[0], a[1], a[2], a[3]); break;
case 5: rc = proc (a[0], a[1], a[2], a[3], a[4]); break;
case 6: rc = proc (a[0], a[1], a[2], a[3], a[4], a[5]); break;
case 7: rc = proc (a[0], a[1], a[2], a[3], a[4], a[5], a[6]); break;
case 8: rc = proc (a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7]); break;
case 9: rc = proc (a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8]); break;
case 10: rc = proc( a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8],
a[9] ); break;
case 11: rc = proc( a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8],
a[9], a[10] ); break;
case 12: rc = proc( a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8],
a[9], a[10], a[11] ); break;
case 13: rc = proc( a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8],
a[9], a[10], a[11], a[12] ); break;
case 14: rc = proc( a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8],
a[9], a[10], a[11], a[12], a[13] ); break;
case 15: rc = proc( a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8],
a[9], a[10], a[11], a[12], a[13], a[14] ); break;
case 16: rc = proc( a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8],
a[9], a[10], a[11], a[12], a[13], a[14], a[15] ); break;
default:
fprintf( stderr, "%d args not supported\n", n_args );
rc = 0;
break;
}
/*--------------------------------------------------------------
| Return value from func
--------------------------------------------------------------*/
return (rc);
}
/*----------------------------------------------------------------------
| Function: perl_call_wine
| --------------------------------------------------------------------
| Purpose: Fetch and call a wine API function from a library
|
| Parameters:
|
| proc -- function address
| n_args -- number of args
| args -- args
| last_error -- returns the last error code
| debug -- debug flag
|
| Returns: Return value from API function called
----------------------------------------------------------------------*/
unsigned long perl_call_wine
(
FARPROC proc,
int n_args,
unsigned long *args,
unsigned int *last_error,
int debug
)
{
unsigned long ret;
DWORD error, old_error;
if (debug > 1)
{
int i;
fprintf(stderr," perl_call_wine(func=%p", proc);
for (i = 0; i < n_args; i++) fprintf( stderr, ",0x%lx", args[i] );
fprintf( stderr, ")\n" );
}
/* special case to allow testing GetLastError without messing up the last error code */
if (proc == pGetLastError)
ret = call_wine_func (proc, n_args, args);
else
{
old_error = GetLastError();
SetLastError( 0xdeadbeef );
ret = call_wine_func (proc, n_args, args);
error = GetLastError();
if (error != 0xdeadbeef) *last_error = error;
else SetLastError( old_error );
}
return ret;
}
/* perl extension initialisation */
static void xs_init(pTHX)
{
extern void boot_wine(CV *cv);
newXS("wine::bootstrap", boot_wine,__FILE__);
}
/* main function */
int main( int argc, char **argv, char **envp )
{
PerlInterpreter *perl;
int status;
envp = environ; /* envp is not valid (yet) in Winelib */
pGetLastError = GetProcAddress( GetModuleHandleA("kernel32"), "GetLastError" );
assert( pGetLastError );
if (!(perl = perl_alloc ()))
{
fprintf( stderr, "Could not allocate perl interpreter\n" );
exit(1);
}
perl_construct (perl);
status = perl_parse( perl, xs_init, argc, argv, envp );
if (!status) status = perl_run(perl);
perl_destruct (perl);
perl_free (perl);
exit( status );
}