#FEATURE by cg
authorClaus Gittinger <cg@exept.de>
Mon, 04 Mar 2019 11:16:51 +0100
changeset 2091 752e665a5a7f
parent 2090 94c3f840c088
child 2092 5784e2503949
#FEATURE by cg class: RegressionTests::ExternalInterfaceTests class definition added:27 methods class: RegressionTests::ExternalInterfaceTests class added: #documentation #history #version
RegressionTests__ExternalInterfaceTests.st
--- a/RegressionTests__ExternalInterfaceTests.st	Mon Mar 04 11:07:33 2019 +0100
+++ b/RegressionTests__ExternalInterfaceTests.st	Mon Mar 04 11:16:51 2019 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "{ Package: 'stx:goodies/regression' }"
 
 "{ NameSpace: RegressionTests }"
@@ -31,6 +33,204 @@
     "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
@@ -76,60 +276,15 @@
 !
 
 setCurrentDirectory: pathName
-	"Set the current working directory."
+        "Set the current working directory."
 
-	<C: BOOL _wincall
-	    SetCurrentDirectoryA(LPCSTR pathName)>
-	^self externalAccessFailedWith: _errorCode
+        <C: BOOL _wincall
+            SetCurrentDirectoryA(LPCSTR pathName)>
+        "/ ^self externalAccessFailedWith: _errorCode
+
+    "Modified: / 04-03-2019 / 11:15:34 / Claus Gittinger"
 ! !
 
-!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;
-		}>
-!
-
-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:'tests'!
 
@@ -154,128 +309,30 @@
      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"
 ! !
 
 !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>
 
@@ -305,3 +362,4 @@
 version
     ^ '$Header$'
 ! !
+