"{ Package: 'exept:regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#ExternalInterfaceTests
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'tests-Regression'
!

!ExternalInterfaceTests class methodsFor:'documentation'!

documentation
"
    documentation to be added.

    [author:]
        cg (cg@FUSI)

    [instance variables:]

    [class variables:]

    [see also:]

"
!

history
    "Created: / 23-04-2006 / 08:13:27 / cg"
! !

!ExternalInterfaceTests methodsFor:'procedures'!

CreateProcess: imageName commandLine: commandLine pSecurity: pSecurity tSecurity: tSecurity inheritHandles: inheritHandles creationFlags: creationFlags environment: environment currentDirectoryName: currentDirectoryName startupInfo: startupInfo processInfo: processInfo
    "Create a new process running in a separate address space. n.b., we use CreateProcessA
    (the ANSI version) rather than CreateProcessW (the UNICODE/wide version) as we want the
    daemon, vworad, to receive its command line arguments as ANSI strings not wide strings."

    <C: BOOL CreateProcessA(
            LPCTSR imageName,
            LPCTSTR commandLine,
            struct SECURITY_ATTRIBUTES *pSecurity,
            struct SECURITY_ATTRIBUTES *tSecurity,
            BOOL inheritHandles,
            DWORD creationFlags,
            LPVOID environment,
            LPTSTR currentDirectoryName,
            struct STARTUPINFO *startupInfo,
            struct PROCESS_INFORMATION *processInfo)>

"
self new
 CreateProcess: 'foo' commandLine: 'foo bla' pSecurity: nil tSecurity: nil inheritHandles: false
 creationFlags: 0 environment: nil currentDirectoryName: 'baz' startupInfo: nil processInfo: nil
"
!

TerminateProcess: hProcess exitCode: dwExitCode
        "Kill the specified process."

        self primTerminateProcess: hProcess exitCode: 1234
!

closeHandle: aHandle
        "Close an OS Handle decrementing it's use count."

        <C: int CloseHandle(HANDLE aHandle)>
!

primTerminateProcess: hProcess exitCode: dwExitCode
        "Kill the specified process."

        <C: BOOL TerminateProcess(HANDLE hProcess, DWORD dwExitCode)>
!

setCurrentDirectory: pathName
        "Set the current working directory."

        <C: BOOL _wincall SetCurrentDirectoryA(LPCTSTR pathName)>
        ^self externalAccessFailedWith: _errorCode
! !

!ExternalInterfaceTests methodsFor:'structs'!

PROCESS_INFORMATION
        "Describes a created process and its main thread."

        <C: struct PROCESS_INFORMATION {
                        HANDLE hProcess;
                        HANDLE hThread;
                        DWORD dwProcessId;
                        DWORD dwThreadId;
                }>
!

SECURITY_ATTRIBUTES
        "Describes security of associated process."

        <C: struct SECURITY_ATTRIBUTES {
                        DWORD nLength;
                        LPVOID lpSecurityDescriptor;
                        BOOL bInheritHandle;
                }>
!

STARTUPINFO
        "Describes how we want the process to be started."

        <C: struct STARTUPINFO {
                        DWORD   cb;
                        LPSTR           lpReserved;
                        LPSTR           lpDesktop;
                        LPSTR           lpTitle;
                        DWORD           dwX;
                        DWORD           dwY;
                        DWORD           dwXSize;
                        DWORD           dwYSize;
                        DWORD           dwXCountChars;
                        DWORD           dwYCountChars;
                        DWORD           dwFillAttribute;
                        DWORD           dwFlags;
                        WORD            wShowWindow;
                        WORD            cbReserved2;
                        LPBYTE          lpReserved2;
                        HANDLE  hStdInput;
                        HANDLE  hStdOutput;
                        HANDLE  hStdError;
                }>
! !

!ExternalInterfaceTests methodsFor:'tests'!

test_call_01
    |fn|

    OperatingSystem isMSWINDOWSlike ifFalse:[
        "This test makes sense only on windows"
        ^ self.
    ].

    fn := ExternalLibraryFunction
            name:'Beep' 
            module:'kernel32.dll' 
            returnType:(CType bool)
            argumentTypes:(Array with:(CType unsignedLong) with:(CType unsignedLong)).

    fn beCallTypeAPI.
    fn invokeWith:440 with:1.

    "
     self run:#test_call_01
     self new test_call_01
    "
! !

!ExternalInterfaceTests methodsFor:'types'!

BOOL
    <C: typedef long BOOL>

    "
     self new BOOL
    "
!

BYTE
    <C: typedef unsigned char BYTE>

    "
     self new BYTE
    "
!

DWORD
    <C: typedef unsigned long DWORD>

    "
       self new DWORD 
    "
!

HANDLE
    <C: typedef void * HANDLE>

    "
     self new HANDLE
    "
!

LPBYTE
    <C: typedef BYTE *LPBYTE>

    "
     self new LPBYTE
    "
!

LPCTSR
    <C: typedef void * LPCTSR>

    "
     self new LPCTSR
    "
!

LPCTSTR
    <C: typedef void * LPCTSTR>

    "
     self new LPCTSTR
    "
!

LPSIZE
    <C: typedef SIZE * LPSIZE>

    "
     self new LPSIZE
    "
!

LPSTR
    <C: typedef char * LPSTR>

    "
     self new LPSTR
    "
!

LPTSTR
    <C: typedef void * LPTSTR>

    "
     self new LPTSTR
    "
!

LPVOID
    <C: typedef void * LPVOID>

    "
     self new LPVOID
    "
!

SIZE
    <C: typedef struct {
            long cx;
            long cy;
    } SIZE>

    "
     self new SIZE
    "
!

WORD
    <C: typedef unsigned short WORD>

    "
     self new WORD
    "
!

fooType
   <C: struct foo {
        long l1;
        float f1;
   }>

    "
     self new fooType
    "
!

var1
    <C: #define var1 1234>

    "
     self new var1
    "
!

var2
    <C: #define var1 "hello">

    "
     self new var2  
    "
!

var3
    <C: #define var1 1.2345>

    "
     self new var3  
    "
! !

!ExternalInterfaceTests class methodsFor:'documentation'!

version
    ^ '$Header$'
! !