"{ 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$'

! !