vbscript: Added GC implementation.

dlls/vbscript/tests/run.c

@@ -884,6 +884,8 @@ static HRESULT parse_script(DWORD flags, BSTR script_str)
 
     hres = IActiveScriptParse64_ParseScriptText(parser, script_str, NULL, NULL, NULL, 0, 0, 0, NULL, NULL);
 
+    IActiveScript_Close(engine);
+
     IDispatch_Release(script_disp);
     IActiveScript_Release(engine);
     IUnknown_Release(parser);
@@ -907,6 +909,61 @@ static void parse_script_a(const char *src)
     parse_script_af(SCRIPTITEM_GLOBALMEMBERS, src);
 }
 
+static void test_gc(void)
+{
+    IActiveScriptParse *parser;
+    IActiveScript *engine;
+    BSTR src;
+    HRESULT hres;
+
+    strict_dispid_check = FALSE;
+
+    engine = create_script();
+    if(!engine)
+        return;
+
+    hres = IActiveScript_QueryInterface(engine, &IID_IActiveScriptParse, (void**)&parser);
+    ok(hres == S_OK, "Could not get IActiveScriptParse: %08x\n", hres);
+
+    hres = IActiveScriptParse64_InitNew(parser);
+    ok(hres == S_OK, "InitNew failed: %08x\n", hres);
+
+    hres = IActiveScript_SetScriptSite(engine, &ActiveScriptSite);
+    ok(hres == S_OK, "SetScriptSite failed: %08x\n", hres);
+
+    hres = IActiveScript_AddNamedItem(engine, testW,
+            SCRIPTITEM_ISVISIBLE|SCRIPTITEM_ISSOURCE|SCRIPTITEM_GLOBALMEMBERS);
+    ok(hres == S_OK, "AddNamedItem failed: %08x\n", hres);
+
+    hres = IActiveScript_SetScriptState(engine, SCRIPTSTATE_STARTED);
+    ok(hres == S_OK, "SetScriptState(SCRIPTSTATE_STARTED) failed: %08x\n", hres);
+
+    src = a2bstr(
+            "class C\n"
+            "    Public ref\n"
+            "    Public Sub Class_Terminate\n"
+            "        Call reportSuccess()\n"
+            "    End Sub\n"
+            "End Class\n"
+            "Dim x\n"
+            "set x = new C\n"
+            "set x.ref = x\n"
+            "set x = nothing\n");
+
+    hres = IActiveScriptParse64_ParseScriptText(parser, src, NULL, NULL, NULL, 0, 0, 0, NULL, NULL);
+    ok(hres == S_OK, "ParseScriptText failed: %08x\n", hres);
+    SysFreeString(src);
+
+    SET_EXPECT(global_success_d);
+    SET_EXPECT(global_success_i);
+    IActiveScript_Close(engine);
+    CHECK_CALLED(global_success_d);
+    CHECK_CALLED(global_success_i);
+
+    IActiveScript_Release(engine);
+    IUnknown_Release(parser);
+}
+
 static BSTR get_script_from_file(const char *filename)
 {
     DWORD size, len;
@@ -1041,6 +1098,8 @@ static void run_tests(void)
     CHECK_CALLED(testobj_propput_i);
 
     run_from_res("lang.vbs");
+
+    test_gc();
 }
 
 static BOOL check_vbscript(void)

dlls/vbscript/vbdisp.c

@@ -144,6 +144,9 @@ static void clean_props(vbdisp_t *This)
 {
     unsigned i;
 
+    if(!This->desc)
+        return;
+
     for(i=0; i < This->desc->prop_cnt; i++)
         VariantClear(This->props+i);
 }
@@ -197,6 +200,7 @@ static ULONG WINAPI DispatchEx_Release(IDispatchEx *iface)
         run_terminator(This);
     if(!ref) {
         clean_props(This);
+        list_remove(&This->entry);
         heap_free(This);
     }
 
@@ -247,6 +251,9 @@ static HRESULT WINAPI DispatchEx_GetDispID(IDispatchEx *iface, BSTR bstrName, DW
 
     TRACE("(%p)->(%s %x %p)\n", This, debugstr_w(bstrName), grfdex, pid);
 
+    if(!This->desc)
+        return E_UNEXPECTED;
+
     if(grfdex & ~(fdexNameEnsure|fdexNameCaseInsensitive)) {
         FIXME("unsupported flags %x\n", grfdex);
         return E_NOTIMPL;
@@ -262,6 +269,9 @@ static HRESULT WINAPI DispatchEx_InvokeEx(IDispatchEx *iface, DISPID id, LCID lc
 
     TRACE("(%p)->(%x %x %x %p %p %p %p)\n", This, id, lcid, wFlags, pdp, pvarRes, pei, pspCaller);
 
+    if(!This->desc)
+        return E_UNEXPECTED;
+
     if(pvarRes)
         V_VT(pvarRes) = VT_EMPTY;
 
@@ -408,10 +418,24 @@ HRESULT create_vbdisp(const class_desc_t *desc, vbdisp_t **ret)
         }
     }
 
+    list_add_tail(&desc->ctx->objects, &vbdisp->entry);
     *ret = vbdisp;
     return S_OK;
 }
 
+void collect_objects(script_ctx_t *ctx)
+{
+    vbdisp_t *iter, *iter2;
+
+    LIST_FOR_EACH_ENTRY_SAFE(iter, iter2, &ctx->objects, vbdisp_t, entry)
+        run_terminator(iter);
+
+    LIST_FOR_EACH_ENTRY_SAFE(iter, iter2, &ctx->objects, vbdisp_t, entry) {
+        clean_props(iter);
+        iter->desc = NULL;
+    }
+}
+
 HRESULT init_global(script_ctx_t *ctx)
 {
     ctx->script_desc.ctx = ctx;

dlls/vbscript/vbscript.c

@@ -112,6 +112,8 @@ static HRESULT set_ctx_site(VBScript *This)
 
 static void destroy_script(script_ctx_t *ctx)
 {
+    collect_objects(ctx);
+
     while(!list_empty(&ctx->code_list))
         release_vbscode(LIST_ENTRY(list_head(&ctx->code_list), vbscode_t, entry));
 
@@ -509,6 +511,7 @@ static HRESULT WINAPI VBScriptParse_InitNew(IActiveScriptParse *iface)
     if(!ctx)
         return E_OUTOFMEMORY;
 
+    list_init(&ctx->objects);
     list_init(&ctx->code_list);
     list_init(&ctx->named_items);
 

dlls/vbscript/vbscript.h

@@ -90,6 +90,7 @@ typedef struct {
 
     LONG ref;
     BOOL terminator_ran;
+    struct list entry;
 
     const class_desc_t *desc;
     VARIANT props[1];
@@ -99,6 +100,7 @@ HRESULT create_vbdisp(const class_desc_t*,vbdisp_t**);
 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*);
+void collect_objects(script_ctx_t*);
 
 static inline unsigned arg_cnt(const DISPPARAMS *dp)
 {
@@ -129,6 +131,7 @@ struct _script_ctx_t {
     function_t *global_funcs;
     class_desc_t *classes;
 
+    struct list objects;
     struct list code_list;
     struct list named_items;
 };