vbscript: Reimplement array_access function.

dlls/vbscript/interp.c

@@ -481,10 +481,8 @@ static void vbstack_to_dp(exec_ctx_t *ctx, unsigned arg_cnt, BOOL is_propput, DI
 
 static HRESULT array_access(exec_ctx_t *ctx, SAFEARRAY *array, DISPPARAMS *dp, VARIANT **ret)
 {
-    unsigned cell_off = 0, dim_size = 1, i;
-    unsigned argc = arg_cnt(dp);
-    VARIANT *data;
-    LONG idx;
+    unsigned i, argc = arg_cnt(dp);
+    LONG *indices;
     HRESULT hres;
 
     if(!array) {
@@ -492,34 +490,35 @@ static HRESULT array_access(exec_ctx_t *ctx, SAFEARRAY *array, DISPPARAMS *dp, V
         return E_FAIL;
     }
 
+    hres = SafeArrayLock(array);
+    if(FAILED(hres))
+        return hres;
+
     if(array->cDims != argc) {
         FIXME("argc %d does not match cDims %d\n", dp->cArgs, array->cDims);
+        SafeArrayUnlock(array);
         return E_FAIL;
     }
 
-    for(i=0; i < argc; i++) {
-        hres = to_int(get_arg(dp, i), &idx);
-        if(FAILED(hres))
-            return hres;
+    indices = heap_alloc(sizeof(*indices) * argc);
+    if(!indices) {
+        SafeArrayUnlock(array);
+        return E_OUTOFMEMORY;
+    }
 
-        idx -= array->rgsabound[i].lLbound;
-        if(idx >= array->rgsabound[i].cElements) {
-            FIXME("out of bound element %d in dim %d of size %d\n", idx, i+1, array->rgsabound[i].cElements);
-            return E_FAIL;
+    for(i=0; i<argc; i++) {
+        hres = to_int(get_arg(dp, i), indices+i);
+        if(FAILED(hres)) {
+            heap_free(indices);
+            SafeArrayUnlock(array);
+            return hres;
         }
-
-        cell_off += idx*dim_size;
-        dim_size *= array->rgsabound[i].cElements;
     }
 
-    hres = SafeArrayAccessData(array, (void**)&data);
-    if(FAILED(hres))
-        return hres;
-
-    *ret = data+cell_off;
-
-    SafeArrayUnaccessData(array);
-    return S_OK;
+    hres = SafeArrayPtrOfIndex(array, indices, (void**)ret);
+    SafeArrayUnlock(array);
+    heap_free(indices);
+    return hres;
 }
 
 static HRESULT do_icall(exec_ctx_t *ctx, VARIANT *res)

dlls/vbscript/tests/lang.vbs

@@ -1157,6 +1157,8 @@ arr3(3,2,1) = 1
 arr3(1,2,3) = 2
 Call ok(arr3(3,2,1) = 1, "arr3(3,2,1) = " & arr3(3,2,1))
 Call ok(arr3(1,2,3) = 2, "arr3(1,2,3) = " & arr3(1,2,3))
+arr2(4,3) = 1
+Call ok(arr2(4,3) = 1, "arr2(4,3) = " & arr2(4,3))
 
 x = arr3
 Call ok(x(3,2,1) = 1, "x(3,2,1) = " & x(3,2,1))