RegressionTests__ExternalInterfaceTests.st
author Claus Gittinger <cg@exept.de>
Thu, 17 May 2018 23:31:05 +0200
changeset 1939 9a6e4956515f
parent 1447 2351db93aa5b
child 1500 d406a10b2965
child 2089 650f7c30736e
permissions -rw-r--r--
#BUGFIX by cg class: RegressionTests::CacheDictionaryTest added: #testSizes

"{ Package: 'stx:goodies/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$'
! !