changeset 2038:ec2c7a22df0d

Fix off-by-one error in less-safe FFI wrapper generation
author Adam Chlipala <adam@chlipala.net>
date Sun, 13 Jul 2014 06:14:23 -0400
parents cf453f48d28b
children 3d10ae22abd6
files src/corify.sml tests/lessSafeFfi.ur
diffstat 2 files changed, 11 insertions(+), 5 deletions(-) [+]
line wrap: on
line diff
--- a/src/corify.sml	Fri Jul 04 09:41:32 2014 -0400
+++ b/src/corify.sml	Sun Jul 13 06:14:23 2014 -0400
@@ -1203,8 +1203,13 @@
                     L'.TFun (dom, ran) => (L'.TFun (dom, addLastBit ran), #2 t)
                   | _ => (L'.TFun ((L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc), t), loc)
 
-            val e = (L'.EFfiApp (m, x, makeArgs (numArgs t' - 1, t', [])), loc)
-            val (e, tTrans) = if isTransactional t' then
+            val isTrans = isTransactional t'
+            val e = (L'.EFfiApp (m, x, makeArgs (numArgs t' -
+                                               (if isTrans then
+                                                    0
+                                                else
+                                                    1), t', [])), loc)
+            val (e, tTrans) = if isTrans then
                                   ((L'.EAbs ("_", (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc), getRan t', e), loc), addLastBit t')
                               else
                                   (e, t')
@@ -1216,7 +1221,7 @@
                   | Source.ServerOnly => Settings.addServerOnly name
                   | Source.JsFunc s => Settings.addJsFunc (name, s)) modes;
 
-            if isTransactional t' andalso not (Settings.isBenignEffectful name) then
+            if isTrans andalso not (Settings.isBenignEffectful name) then
                 Settings.addEffectful name
             else
                 ();
--- a/tests/lessSafeFfi.ur	Fri Jul 04 09:41:32 2014 -0400
+++ b/tests/lessSafeFfi.ur	Sun Jul 13 06:14:23 2014 -0400
@@ -1,15 +1,16 @@
 ffi foo : int -> int
 ffi bar serverOnly benignEffectful : int -> transaction unit
 ffi baz : transaction int
+ffi adder : int -> int -> int
 
-ffi bup jsFunc "jsbup" : int -> transaction unit
+ffi bup jsFunc "alert" : string -> transaction unit
 
 fun other () : transaction page =
     (*bar 17;
     q <- baz;*)
     return <xml><body>
       (*{[foo 42]}, {[q]}*)
-      <button onclick={fn _ => bup 32}/>
+      <button onclick={fn _ => bup "asdf"}/>
     </body></xml>
 
 fun main () = return <xml><body>