"{ Encoding: utf8 }"
"{ 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:'structs'!
PROCESS_INFORMATION
"Describes a created process and its main thread."
<C: struct PROCESS_INFORMATION {
HANDLE hProcess;
HANDLE hThread;
DWORD dwProcessId;
DWORD dwThreadId;
}>
! !
!ExternalInterfaceTests methodsFor:'structs'!
SECURITY_ATTRIBUTES
"Describes security of associated process."
<C: struct SECURITY_ATTRIBUTES {
DWORD nLength;
LPVOID lpSecurityDescriptor;
BOOL bInheritHandle;
}>
! !
!ExternalInterfaceTests methodsFor:'structs'!
STARTUPINFOA
"Describes how we want the process to be started."
<C: struct STARTUPINFOA {
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:'types'!
BOOL
<C: typedef long BOOL>
"
self new BOOL
"
! !
!ExternalInterfaceTests methodsFor:'types'!
BYTE
<C: typedef unsigned char BYTE>
"
self new BYTE
"
! !
!ExternalInterfaceTests methodsFor:'types'!
DWORD
<C: typedef unsigned long DWORD>
"
self new DWORD
"
! !
!ExternalInterfaceTests methodsFor:'types'!
HANDLE
<C: typedef void * HANDLE>
"
self new HANDLE
"
! !
!ExternalInterfaceTests methodsFor:'types'!
LPBYTE
<C: typedef BYTE *LPBYTE>
"
self new LPBYTE
"
! !
!ExternalInterfaceTests methodsFor:'types'!
LPCTSR
<C: typedef void * LPCTSR>
"
self new LPCTSR
"
! !
!ExternalInterfaceTests methodsFor:'types'!
LPCTSTR
<C: typedef void * LPCTSTR>
"
self new LPCTSTR
"
! !
!ExternalInterfaceTests methodsFor:'types'!
LPSIZE
<C: typedef SIZE * LPSIZE>
"
self new LPSIZE
"
! !
!ExternalInterfaceTests methodsFor:'types'!
LPSTR
<C: typedef char * LPSTR>
"
self new LPSTR
"
! !
!ExternalInterfaceTests methodsFor:'types'!
LPTSTR
<C: typedef void * LPTSTR>
"
self new LPTSTR
"
! !
!ExternalInterfaceTests methodsFor:'types'!
LPVOID
<C: typedef void * LPVOID>
"
self new LPVOID
"
! !
!ExternalInterfaceTests methodsFor:'types'!
SIZE
<C: typedef struct {
long cx;
long cy;
} SIZE>
"
self new SIZE
"
! !
!ExternalInterfaceTests methodsFor:'types'!
WORD
<C: typedef unsigned short WORD>
"
self new WORD
"
! !
!ExternalInterfaceTests methodsFor:'types'!
fooType
<C: struct foo {
long l1;
float f1;
}>
"
self new fooType
"
! !
!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(
LPCSTR imageName,
LPSTR commandLine,
struct SECURITY_ATTRIBUTES *pSecurity,
struct SECURITY_ATTRIBUTES *tSecurity,
BOOL inheritHandles,
DWORD creationFlags,
LPVOID environment,
LPCSTR currentDirectoryName,
struct STARTUPINFOA *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(LPCSTR pathName)>
"/ ^self externalAccessFailedWith: _errorCode
"Modified: / 04-03-2019 / 11:15:34 / Claus Gittinger"
! !
!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'
callType:'api'
returnType:(CType bool)
argumentTypes:(Array with:(CType unsignedLong) with:(CType unsignedLong)).
fn invokeWith:440 with:1.
"
self run:#test_call_01
self new test_call_01
"
!
test_call_02
|fn|
fn := ExternalLibraryFunction
name:'printf'
module:'libc'
returnType:(CType void)
argumentTypes:(Array with:(CType charPointer)
with:(CType int)).
fn invokeWith:c'hello world %d\n' with:1.
"
self run:#test_call_02
self new test_call_02
"
"Created: / 04-03-2019 / 11:12:23 / Claus Gittinger"
!
test_call_03
|fn nsApp|
OperatingSystem isOSXlike ifFalse:[
"This test makes sense only on OSX"
^ self
].
nsApp := ObjCClass named:'NSApplication'.
fn := ExternalLibraryFunction
name:'sharedApplication'
module:nil
callType:'objc'
returnType:(CType void)
argumentTypes:#().
fn invokeObjCOn:nsApp.
"
self run:#test_call_03
self new test_call_03
"
"Created: / 04-03-2019 / 11:41:02 / Claus Gittinger"
! !
!ExternalInterfaceTests methodsFor:'types'!
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$'
!
version_CVS
^ '$Header$'
! !