class: RegressionTests::CompilerTests2
authorClaus Gittinger <cg@exept.de>
Tue, 18 Nov 2014 21:52:45 +0100
changeset 1246 cc5bd61b11b4
parent 1245 a00a20a29299
child 1247 ff9a4f439ff9
class: RegressionTests::CompilerTests2 added: #test_external_function_call_01a #test_external_function_call_01b #test_external_function_call_01c removed: #method_literals_array_01 #test_external_function_call_01
RegressionTests__CompilerTests2.st
--- a/RegressionTests__CompilerTests2.st	Tue Nov 18 21:49:01 2014 +0100
+++ b/RegressionTests__CompilerTests2.st	Tue Nov 18 21:52:45 2014 +0100
@@ -575,19 +575,6 @@
     "Created: / 12-04-2013 / 21:23:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
-method_literals_array_01
-    | literal |
-
-    literal := #(
-        _XXX:_:
-        YYY
-        _XXX:_:
-    ).
-    ^ literal
-
-    "Created: / 20-01-2014 / 13:39:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
 method_literals_array_01a
     | literal |
 
@@ -869,7 +856,7 @@
 
 !CompilerTests2 methodsFor:'tests - FFI'!
 
-test_external_function_call_01
+test_external_function_call_01a
     "Test for stx bug for <cdecl> specs like
 
         <cdecl: Cairo::FontFace 'cairo_get_font_face' ( Cairo::GraphicsContext ) >
@@ -898,6 +885,68 @@
 
     "Created: / 06-01-2014 / 11:29:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 20-09-2014 / 21:51:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_external_function_call_01b
+    "Test for stx bug for <cdecl> specs like
+
+        <cdecl: Cairo::FontFace 'cairo_get_font_face' ( Cairo::GraphicsContext ) >
+
+     i.e., when custom subclass of ExternalAddress is in namespace."
+    
+    | malloc  free |
+
+    malloc := 'malloc: size
+
+    <cdecl: const RegressionTests::CompilerTests2ExternalBytes "malloc" ( int ) module: ''librun''>
+    self primitive failed'.
+    free := 'free: ptr
+
+    <cdecl: const void "free" ( RegressionTests::CompilerTests2ExternalBytes ) module: ''librun''>
+    self primitive failed'.
+    #( #bc #stc ) do:[:mode | 
+        | ptr |
+
+        self compile:malloc mode:mode.
+        self compile:free mode:mode.
+        ptr := self perform:(mode , '_malloc:') asSymbol with:1.
+        self assert:ptr class == RegressionTests::CompilerTests2ExternalBytes.
+        self perform:(mode , '_free:') asSymbol with:ptr.
+    ]
+
+    "Created: / 06-01-2014 / 11:29:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 20-09-2014 / 21:51:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_external_function_call_01c
+    "Test for stx bug for <cdecl> specs like
+
+        <cdecl: Cairo::FontFace 'cairo_get_font_face' ( Cairo::GraphicsContext ) >
+
+     i.e., when custom subclass of ExternalAddress is in namespace."
+    
+    | malloc  free |
+
+    malloc := 'malloc: size
+
+    <cdecl: const RegressionTests::CompilerTests2ExternalBytes "malloc" ( int )>
+    self primitive failed'.
+    free := 'free: ptr
+
+    <cdecl: const void "free" ( RegressionTests::CompilerTests2ExternalBytes )>
+    self primitive failed'.
+    #( #bc #stc ) do:[:mode | 
+        | ptr |
+
+        self compile:malloc mode:mode.
+        self compile:free mode:mode.
+        ptr := self perform:(mode , '_malloc:') asSymbol with:1.
+        self assert:ptr class == RegressionTests::CompilerTests2ExternalBytes.
+        self perform:(mode , '_free:') asSymbol with:ptr.
+    ]
+
+    "Created: / 06-01-2014 / 11:29:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 20-09-2014 / 21:51:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !CompilerTests2 methodsFor:'tests - arg & var names'!