vbscript: Added compiler/runtime support for property getters/letters.

dlls/vbscript/compile.c

@@ -813,16 +813,42 @@ static BOOL lookup_class_name(compile_ctx_t *ctx, const WCHAR *name)
 
 static HRESULT create_class_funcprop(compile_ctx_t *ctx, function_decl_t *func_decl, vbdisp_funcprop_desc_t *desc)
 {
+    vbdisp_invoke_type_t invoke_type;
+    function_decl_t *funcprop_decl;
+    HRESULT hres;
+
     desc->name = compiler_alloc_string(ctx->code, func_decl->name);
     if(!desc->name)
         return E_OUTOFMEMORY;
 
-    assert(!desc->entries[0]);
+    for(funcprop_decl = func_decl; funcprop_decl; funcprop_decl = funcprop_decl->next_prop_func) {
+        switch(funcprop_decl->type) {
+        case FUNC_FUNCTION:
+        case FUNC_SUB:
+        case FUNC_PROPGET:
+            invoke_type = VBDISP_CALLGET;
+            break;
+        case FUNC_PROPLET:
+            invoke_type = VBDISP_LET;
+            break;
+        case FUNC_PROPSET:
+            invoke_type = VBDISP_SET;
+            break;
+        default:
+            assert(0);
+        }
 
-    if(func_decl->is_public)
+        assert(!desc->entries[invoke_type]);
+
+        if(funcprop_decl->is_public)
             desc->is_public = TRUE;
 
-    return create_function(ctx, func_decl, desc->entries);
+        hres = create_function(ctx, funcprop_decl, desc->entries+invoke_type);
+        if(FAILED(hres))
+            return hres;
+    }
+
+    return S_OK;
 }
 
 static BOOL lookup_class_funcs(class_desc_t *class_desc, const WCHAR *name)

dlls/vbscript/interp.c

@@ -92,7 +92,8 @@ static HRESULT lookup_identifier(exec_ctx_t *ctx, BSTR name, vbdisp_invoke_type_
     DISPID id;
     HRESULT hres;
 
-    if(invoke_type == VBDISP_LET && ctx->func->type == FUNC_FUNCTION && !strcmpiW(name, ctx->func->name)) {
+    if(invoke_type == VBDISP_LET && (ctx->func->type == FUNC_FUNCTION || ctx->func->type == FUNC_PROPGET)
+            && !strcmpiW(name, ctx->func->name)) {
         ref->type = REF_VAR;
         ref->u.v = &ctx->ret_val;
         return S_OK;
@@ -114,7 +115,7 @@ static HRESULT lookup_identifier(exec_ctx_t *ctx, BSTR name, vbdisp_invoke_type_
         }
     }
 
-    hres = disp_get_id(ctx->this_obj, name, TRUE, &id);
+    hres = disp_get_id(ctx->this_obj, name, invoke_type, TRUE, &id);
     if(SUCCEEDED(hres)) {
         ref->type = REF_DISP;
         ref->u.d.disp = ctx->this_obj;
@@ -135,7 +136,7 @@ static HRESULT lookup_identifier(exec_ctx_t *ctx, BSTR name, vbdisp_invoke_type_
 
     LIST_FOR_EACH_ENTRY(item, &ctx->script->named_items, named_item_t, entry) {
         if((item->flags & SCRIPTITEM_GLOBALMEMBERS) && item->disp != ctx->this_obj) {
-            hres = disp_get_id(item->disp, name, FALSE, &id);
+            hres = disp_get_id(item->disp, name, invoke_type, FALSE, &id);
             if(SUCCEEDED(hres)) {
                 ref->type = REF_DISP;
                 ref->u.d.disp = item->disp;
@@ -356,7 +357,7 @@ static HRESULT do_mcall(exec_ctx_t *ctx, VARIANT *res)
 
     vbstack_to_dp(ctx, arg_cnt, &dp);
 
-    hres = disp_get_id(obj, identifier, FALSE, &id);
+    hres = disp_get_id(obj, identifier, VBDISP_CALLGET, FALSE, &id);
     if(SUCCEEDED(hres))
         hres = disp_call(ctx->script, obj, id, &dp, res);
     IDispatch_Release(obj);
@@ -489,7 +490,7 @@ static HRESULT interp_assign_member(exec_ctx_t *ctx)
         return hres;
     }
 
-    hres = disp_get_id(obj, identifier, FALSE, &id);
+    hres = disp_get_id(obj, identifier, VBDISP_LET, FALSE, &id);
     if(SUCCEEDED(hres))
         hres = disp_propput(ctx->script, obj, id, val.v);
 
@@ -1204,7 +1205,7 @@ HRESULT exec_script(script_ctx_t *ctx, function_t *func, IDispatch *this_obj, DI
     }
 
     assert(!exec.top);
-    if(func->type != FUNC_FUNCTION)
+    if(func->type != FUNC_FUNCTION && func->type != FUNC_PROPGET)
         assert(V_VT(&exec.ret_val) == VT_EMPTY);
 
     if(SUCCEEDED(hres) && res) {

dlls/vbscript/tests/lang.vbs

@@ -449,4 +449,12 @@ obj.publicProp() = 3
 Call obj.setPrivateProp(6)
 Call ok(obj.getPrivateProp = 6, "obj.getPrivateProp = " & obj.getPrivateProp)
 
+Dim funcCalled
+funcCalled = ""
+Call ok(obj.gsProp = 6, "obj.gsProp = " & obj.gsProp)
+Call ok(funcCalled = "gsProp get", "funcCalled = " & funcCalled)
+obj.gsProp = 3
+Call ok(funcCalled = "gsProp let", "funcCalled = " & funcCalled)
+Call ok(obj.getPrivateProp = 3, "obj.getPrivateProp = " & obj.getPrivateProp)
+
 reportSuccess()

dlls/vbscript/vbdisp.c

@@ -27,15 +27,21 @@ static inline BOOL is_func_id(vbdisp_t *This, DISPID id)
     return id < This->desc->func_cnt;
 }
 
-static BOOL get_func_id(vbdisp_t *This, const WCHAR *name, BOOL search_private, DISPID *id)
+static BOOL get_func_id(vbdisp_t *This, const WCHAR *name, vbdisp_invoke_type_t invoke_type, BOOL search_private, DISPID *id)
 {
     unsigned i;
 
-    for(i = 0; i < This->desc->func_cnt; i++) {
+    for(i = invoke_type == VBDISP_ANY ? 0 : 1; i < This->desc->func_cnt; i++) {
+        if(invoke_type == VBDISP_ANY) {
             if(!search_private && !This->desc->funcs[i].is_public)
                 continue;
-        if(!This->desc->funcs[i].name) /* default value may not exist */
+            if(!i && !This->desc->funcs[0].name) /* default value may not exist */
                 continue;
+        }else {
+            if(!This->desc->funcs[i].entries[invoke_type]
+                || (!search_private && !This->desc->funcs[i].entries[invoke_type]->is_public))
+                continue;
+        }
 
         if(!strcmpiW(This->desc->funcs[i].name, name)) {
             *id = i;
@@ -46,11 +52,11 @@ static BOOL get_func_id(vbdisp_t *This, const WCHAR *name, BOOL search_private,
     return FALSE;
 }
 
-HRESULT vbdisp_get_id(vbdisp_t *This, BSTR name, BOOL search_private, DISPID *id)
+HRESULT vbdisp_get_id(vbdisp_t *This, BSTR name, vbdisp_invoke_type_t invoke_type, BOOL search_private, DISPID *id)
 {
     unsigned i;
 
-    if(get_func_id(This, name, search_private, id))
+    if(get_func_id(This, name, invoke_type, search_private, id))
         return S_OK;
 
     for(i=0; i < This->desc->prop_cnt; i++) {
@@ -225,7 +231,7 @@ static HRESULT WINAPI DispatchEx_GetDispID(IDispatchEx *iface, BSTR bstrName, DW
         return E_NOTIMPL;
     }
 
-    return vbdisp_get_id(This, bstrName, FALSE, pid);
+    return vbdisp_get_id(This, bstrName, VBDISP_ANY, FALSE, pid);
 }
 
 static HRESULT WINAPI DispatchEx_InvokeEx(IDispatchEx *iface, DISPID id, LCID lcid, WORD wFlags, DISPPARAMS *pdp,
@@ -254,6 +260,30 @@ static HRESULT WINAPI DispatchEx_InvokeEx(IDispatchEx *iface, DISPID id, LCID lc
             }
 
             return exec_script(This->desc->ctx, func, (IDispatch*)&This->IDispatchEx_iface, pdp, pvarRes);
+        case DISPATCH_PROPERTYPUT: {
+            VARIANT *put_val;
+            DISPPARAMS dp = {NULL, NULL, 1, 0};
+
+            if(arg_cnt(pdp)) {
+                FIXME("arguments not implemented\n");
+                return E_NOTIMPL;
+            }
+
+            put_val = get_propput_arg(pdp);
+            if(!put_val) {
+                WARN("no value to set\n");
+                return DISP_E_PARAMNOTOPTIONAL;
+            }
+
+            dp.rgvarg = put_val;
+            func = This->desc->funcs[id].entries[V_VT(put_val) == VT_DISPATCH ? VBDISP_SET : VBDISP_LET];
+            if(!func) {
+                FIXME("no letter/setter\n");
+                return DISP_E_MEMBERNOTFOUND;
+            }
+
+            return exec_script(This->desc->ctx, func, (IDispatch*)&This->IDispatchEx_iface, &dp, NULL);
+        }
         default:
             FIXME("flags %x\n", wFlags);
             return DISP_E_MEMBERNOTFOUND;
@@ -355,7 +385,7 @@ HRESULT init_global(script_ctx_t *ctx)
     return create_vbdisp(&ctx->script_desc, &ctx->script_obj);
 }
 
-HRESULT disp_get_id(IDispatch *disp, BSTR name, BOOL search_private, DISPID *id)
+HRESULT disp_get_id(IDispatch *disp, BSTR name, vbdisp_invoke_type_t invoke_type, BOOL search_private, DISPID *id)
 {
     IDispatchEx *dispex;
     vbdisp_t *vbdisp;
@@ -363,7 +393,7 @@ HRESULT disp_get_id(IDispatch *disp, BSTR name, BOOL search_private, DISPID *id)
 
     vbdisp = unsafe_impl_from_IDispatch(disp);
     if(vbdisp)
-        return vbdisp_get_id(vbdisp, name, search_private, id);
+        return vbdisp_get_id(vbdisp, name, invoke_type, search_private, id);
 
     hres = IDispatch_QueryInterface(disp, &IID_IDispatchEx, (void**)&dispex);
     if(FAILED(hres)) {

dlls/vbscript/vbscript.h

@@ -93,7 +93,7 @@ typedef struct {
 } vbdisp_t;
 
 HRESULT create_vbdisp(const class_desc_t*,vbdisp_t**);
-HRESULT disp_get_id(IDispatch*,BSTR,BOOL,DISPID*);
+HRESULT disp_get_id(IDispatch*,BSTR,vbdisp_invoke_type_t,BOOL,DISPID*);
 HRESULT disp_call(script_ctx_t*,IDispatch*,DISPID,DISPPARAMS*,VARIANT*);
 HRESULT disp_propput(script_ctx_t*,IDispatch*,DISPID,VARIANT*);