[PATCH v4 0/1] MR10449: Draft: vbscript: Implement the Erase statement.

[Francis De Brabandere (＠francisdb)]

Erase reinitializes fixed-size arrays (clearing all elements to
their default values) and deallocates dynamic arrays (setting
them back to an uninitialized state).

--
  v4: vbscript: Implement the Erase statement.
 
https://gitlab.winehq.org/wine/wine/-/merge_requests/10449

[PATCH v4 1/1] vbscript: Implement the Erase statement.

[Francis De Brabandere]

From: Francis De Brabandere <[e-mail]>

Erase reinitializes fixed-size arrays (clearing all elements to
their default values) and deallocates dynamic arrays (setting
them back to an uninitialized state).
---
 dlls/vbscript/compile.c      |  18 ++++++
 dlls/vbscript/interp.c       |  57 +++++++++++++++++
 dlls/vbscript/lex.c          |   1 +
 dlls/vbscript/parse.h        |   6 ++
 dlls/vbscript/parser.y       |  17 ++++-
 dlls/vbscript/tests/lang.vbs | 118 +++++++++++++++++++++++++++++++++++
 dlls/vbscript/vbscript.h     |   1 +
 7 files changed, 217 insertions(+), 1 deletion(-)

diff --git a/dlls/vbscript/compile.c b/dlls/vbscript/compile.c
index 8c82d849a1b..f5d74ac1e7e 100644
--- a/dlls/vbscript/compile.c
+++ b/dlls/vbscript/compile.c
@@ -1194,6 +1194,21 @@ static HRESULT compile_redim_statement(compile_ctx_t *ctx, redim_statement_t *st
     return S_OK;
 }
 
+static HRESULT compile_erase_statement(compile_ctx_t *ctx, erase_statement_t *stat)
+{
+    HRESULT hres;
+
+    hres = push_instr_bstr(ctx, OP_erase, stat->identifier);
+    if(FAILED(hres))
+        return hres;
+
+    if(!emit_catch(ctx, 0))
+        return E_OUTOFMEMORY;
+
+
+    return S_OK;
+}
+
 static HRESULT compile_const_statement(compile_ctx_t *ctx, const_statement_t *stat)
 {
     const_decl_t *decl, *next_decl = stat->decls;
@@ -1515,6 +1530,9 @@ static HRESULT compile_statement(compile_ctx_t *ctx, statement_ctx_t *stat_ctx,
         case STAT_ONERROR:
             hres = compile_onerror_statement(ctx, (onerror_statement_t*)stat);
             break;
+        case STAT_ERASE:
+            hres = compile_erase_statement(ctx, (erase_statement_t*)stat);
+            break;
         case STAT_REDIM:
             hres = compile_redim_statement(ctx, (redim_statement_t*)stat);
             break;
diff --git a/dlls/vbscript/interp.c b/dlls/vbscript/interp.c
index 6be173f75d0..2c6de430f1d 100644
--- a/dlls/vbscript/interp.c
+++ b/dlls/vbscript/interp.c
@@ -1439,6 +1439,63 @@ static HRESULT interp_redim_preserve(exec_ctx_t *ctx)
     return hres;
 }
 
+static HRESULT interp_erase(exec_ctx_t *ctx)
+{
+    const BSTR identifier = ctx->instr->arg1.bstr;
+    VARIANT *v;
+    SAFEARRAY *array;
+    ref_t ref;
+    HRESULT hres;
+
+    TRACE("%s\n", debugstr_w(identifier));
+
+    hres = lookup_identifier(ctx, identifier, VBDISP_LET, &ref);
+    if(FAILED(hres))
+        return hres;
+
+    if(ref.type != REF_VAR)
+        return MAKE_VBSERROR(VBSE_TYPE_MISMATCH);
+
+
+    v = ref.u.v;
+    if(V_VT(v) == (VT_VARIANT|VT_BYREF))
+        v = V_VARIANTREF(v);
+
+    if(!(V_VT(v) & VT_ARRAY)) {
+        WARN("Erase on non-array type %d\n", V_VT(v));
+        return MAKE_VBSERROR(VBSE_TYPE_MISMATCH);
+    }
+
+    array = V_ISBYREF(v) ? *V_ARRAYREF(v) : V_ARRAY(v);
+    if(!array)
+        return S_OK;
+
+    if(array->fFeatures & FADF_FIXEDSIZE) {
+        /* Fixed-size array: reinitialize all elements to default values. */
+        unsigned i, element_cnt = 1;
+        VARIANT *data;
+
+        for(i = 0; i < array->cDims; i++)
+            element_cnt *= array->rgsabound[i].cElements;
+
+        hres = SafeArrayAccessData(array, (void**)&data);
+        if(SUCCEEDED(hres)) {
+            for(i = 0; i < element_cnt; i++)
+                VariantClear(&data[i]);
+            SafeArrayUnaccessData(array);
+        }
+    }else {
+        /* Dynamic array: deallocate it. */
+        SafeArrayDestroy(array);
+        if(V_ISBYREF(v))
+            *V_ARRAYREF(v) = NULL;
+        else
+            V_ARRAY(v) = NULL;
+    }
+
+    return hres;
+}
+
 static HRESULT interp_step(exec_ctx_t *ctx)
 {
     const BSTR ident = ctx->instr->arg2.bstr;
diff --git a/dlls/vbscript/lex.c b/dlls/vbscript/lex.c
index b95dd011211..97b3074fd33 100644
--- a/dlls/vbscript/lex.c
+++ b/dlls/vbscript/lex.c
@@ -55,6 +55,7 @@ static const struct {
     {L"empty",     tEMPTY},
     {L"end",       tEND},
     {L"eqv",       tEQV},
+    {L"erase",     tERASE},
     {L"error",     tERROR},
     {L"exit",      tEXIT},
     {L"explicit",  tEXPLICIT},
diff --git a/dlls/vbscript/parse.h b/dlls/vbscript/parse.h
index 71fc713ea9c..8df2c77ab8a 100644
--- a/dlls/vbscript/parse.h
+++ b/dlls/vbscript/parse.h
@@ -116,6 +116,7 @@ typedef enum {
     STAT_DIM,
     STAT_DOUNTIL,
     STAT_DOWHILE,
+    STAT_ERASE,
     STAT_EXITDO,
     STAT_EXITFOR,
     STAT_EXITFUNC,
@@ -184,6 +185,11 @@ typedef struct {
     redim_decl_t *redim_decls;
 } redim_statement_t;
 
+typedef struct {
+    statement_t stat;
+    const WCHAR *identifier;
+} erase_statement_t;
+
 typedef struct _arg_decl_t {
     const WCHAR *name;
     BOOL by_ref;
diff --git a/dlls/vbscript/parser.y b/dlls/vbscript/parser.y
index ecd6cc7502f..317817fdb5c 100644
--- a/dlls/vbscript/parser.y
+++ b/dlls/vbscript/parser.y
@@ -52,6 +52,7 @@ static statement_t *new_assign_statement(parser_ctx_t*,unsigned,expression_t*,ex
 static statement_t *new_set_statement(parser_ctx_t*,unsigned,expression_t*,expression_t*);
 static statement_t *new_dim_statement(parser_ctx_t*,unsigned,dim_decl_t*);
 static statement_t *new_redim_statement(parser_ctx_t*,unsigned,BOOL,redim_decl_t*);
+static statement_t *new_erase_statement(parser_ctx_t*,unsigned,const WCHAR*);
 static statement_t *new_while_statement(parser_ctx_t*,unsigned,statement_type_t,expression_t*,statement_t*);
 static statement_t *new_forto_statement(parser_ctx_t*,unsigned,const WCHAR*,expression_t*,expression_t*,expression_t*,statement_t*);
 static statement_t *new_foreach_statement(parser_ctx_t*,unsigned,const WCHAR*,expression_t*,statement_t*);
@@ -121,7 +122,7 @@ static statement_t *link_statements(statement_t*,statement_t*);
 %token <string> tNOT tAND tOR tXOR tEQV tIMP
 %token <string> tIS tMOD
 %token <string> tCALL tSUB tFUNCTION tGET tLET tCONST
-%token <string> tDIM tREDIM tPRESERVE
+%token <string> tDIM tREDIM tPRESERVE tERASE
 %token <string> tIF tELSE tELSEIF tEND tTHEN tEXIT
 %token <string> tWHILE tWEND tDO tLOOP tUNTIL tFOR tTO tEACH tIN
 %token <string> tSELECT tCASE tWITH
@@ -217,6 +218,7 @@ SimpleStatement
                                             { $$ = new_assign_statement(ctx, @$, $1, $3); CHECK_ERROR; }
     | tDIM DimDeclList                      { $$ = new_dim_statement(ctx, @$, $2); CHECK_ERROR; }
     | tREDIM Preserve_opt ReDimDeclList     { $$ = new_redim_statement(ctx, @$, $2, $3); CHECK_ERROR; }
+    | tERASE Identifier                    { $$ = new_erase_statement(ctx, @$, $2); CHECK_ERROR; }
     | IfStatement                           { $$ = $1; }
     | tWHILE Expression StSep StatementsNl_opt tWEND
                                             { $$ = new_while_statement(ctx, @$, STAT_WHILE, $2, $4); CHECK_ERROR; }
@@ -273,6 +275,7 @@ ReDimDeclList
     : ReDimDecl                             { $$ = $1; }
     | ReDimDecl ',' ReDimDeclList           { $1->next = $3; $$ = $1; }
 
+
 DimDeclList
     : DimDecl                               { $$ = $1; }
     | DimDecl ',' DimDeclList               { $1->next = $3; $$ = $1; }
@@ -930,6 +933,18 @@ static statement_t *new_redim_statement(parser_ctx_t *ctx, unsigned loc, BOOL pr
     return &stat->stat;
 }
 
+static statement_t *new_erase_statement(parser_ctx_t *ctx, unsigned loc, const WCHAR *identifier)
+{
+    erase_statement_t *stat;
+
+    stat = new_statement(ctx, STAT_ERASE, sizeof(*stat), loc);
+    if(!stat)
+        return NULL;
+
+    stat->identifier = identifier;
+    return &stat->stat;
+}
+
 static elseif_decl_t *new_elseif_decl(parser_ctx_t *ctx, unsigned loc, expression_t *expr, statement_t *stat)
 {
     elseif_decl_t *decl;
diff --git a/dlls/vbscript/tests/lang.vbs b/dlls/vbscript/tests/lang.vbs
index 055a63047c0..e04c875b6d7 100644
--- a/dlls/vbscript/tests/lang.vbs
+++ b/dlls/vbscript/tests/lang.vbs
@@ -1948,6 +1948,124 @@ redim preserve dynarr2(5)
 ok ubound(dynarr2) = 5, "ubound(dynarr2) = " & ubound(dynarr2)
 ok dynarr2(0) = "x", "dynarr2(0) after redim preserve = " & dynarr2(0)
 
+' Erase on fixed-size array: clears elements to default values
+dim eraseFixed(3)
+eraseFixed(0) = "a"
+eraseFixed(1) = 2
+eraseFixed(2) = True
+Erase eraseFixed
+ok eraseFixed(0) = empty, "eraseFixed(0) after Erase = " & eraseFixed(0)
+ok eraseFixed(1) = empty, "eraseFixed(1) after Erase = " & eraseFixed(1)
+ok eraseFixed(2) = empty, "eraseFixed(2) after Erase = " & eraseFixed(2)
+ok ubound(eraseFixed) = 3, "ubound(eraseFixed) after Erase = " & ubound(eraseFixed)
+
+' Erase on dynamic array: deallocates the array
+dim eraseDyn()
+redim eraseDyn(3)
+eraseDyn(0) = "x"
+Erase eraseDyn
+on error resume next
+y = eraseDyn(0)
+e = err.number
+on error goto 0
+todo_wine_ok e = 9, "access after Erase dynamic: err.number = " & e
+
+' Erase with multiple arrays (separate statements)
+dim eraseMulti1(2), eraseMulti2(2)
+eraseMulti1(0) = "a"
+eraseMulti2(0) = "b"
+Erase eraseMulti1
+Erase eraseMulti2
+ok eraseMulti1(0) = empty, "eraseMulti1(0) after Erase = " & eraseMulti1(0)
+ok eraseMulti2(0) = empty, "eraseMulti2(0) after Erase = " & eraseMulti2(0)
+
+' Erase on non-array variable: should give type mismatch error
+dim eraseNotArray
+eraseNotArray = 42
+on error resume next
+Erase eraseNotArray
+ok err.number = 13, "Erase non-array: err.number = " & err.number
+err.clear
+
+' Erase on Empty variable: should give type mismatch error
+dim eraseEmpty
+Erase eraseEmpty
+ok err.number = 13, "Erase empty var: err.number = " & err.number
+err.clear
+
+' Erase on Null variable: should give type mismatch error
+dim eraseNull
+eraseNull = Null
+Erase eraseNull
+ok err.number = 13, "Erase null var: err.number = " & err.number
+err.clear
+
+' Erase on Object variable: should give type mismatch error
+dim eraseObj
+set eraseObj = new regexp
+Erase eraseObj
+ok err.number = 13, "Erase object var: err.number = " & err.number
+err.clear
+
+' Erase on Nothing variable: should give type mismatch error
+dim eraseNothing
+set eraseNothing = Nothing
+Erase eraseNothing
+ok err.number = 13, "Erase nothing var: err.number = " & err.number
+err.clear
+
+' Erase on undeclared identifier: should give type mismatch error
+Erase eraseUndeclared
+ok err.number = 13, "Erase undeclared: err.number = " & err.number
+err.clear
+on error goto 0
+
+' Erase on uninitialized dynamic array: no error
+dim eraseUninit()
+Erase eraseUninit
+
+' Erase twice on fixed-size array: no error
+dim eraseTwice(2)
+eraseTwice(0) = "x"
+Erase eraseTwice
+Erase eraseTwice
+ok eraseTwice(0) = empty, "eraseTwice(0) after double Erase = " & eraseTwice(0)
+
+' Erase twice on dynamic array: no error
+dim eraseTwiceDyn()
+redim eraseTwiceDyn(2)
+eraseTwiceDyn(0) = "y"
+Erase eraseTwiceDyn
+Erase eraseTwiceDyn
+
+' ReDim after Erase on dynamic array
+dim eraseReDim()
+redim eraseReDim(3)
+eraseReDim(0) = "before"
+Erase eraseReDim
+redim eraseReDim(5)
+ok ubound(eraseReDim) = 5, "ubound(eraseReDim) after Erase+ReDim = " & ubound(eraseReDim)
+ok eraseReDim(0) = empty, "eraseReDim(0) after Erase+ReDim = " & eraseReDim(0)
+
+' Erase on ByRef array parameter: clears the original
+sub TestEraseByRef(ByRef arr)
+    Erase arr
+end sub
+dim eraseByRefArr(2)
+eraseByRefArr(0) = "hello"
+call TestEraseByRef(eraseByRefArr)
+ok eraseByRefArr(0) = empty, "eraseByRefArr(0) after ByRef Erase = " & eraseByRefArr(0)
+ok ubound(eraseByRefArr) = 2, "ubound(eraseByRefArr) after ByRef Erase = " & ubound(eraseByRefArr)
+
+' Erase on ByVal array parameter: does not affect the original
+sub TestEraseByVal(ByVal arr)
+    Erase arr
+end sub
+dim eraseByValArr(2)
+eraseByValArr(0) = "world"
+call TestEraseByVal(eraseByValArr)
+ok eraseByValArr(0) = "world", "eraseByValArr(0) after ByVal Erase = " & eraseByValArr(0)
+
 Class ArrClass
     Dim classarr(3)
     Dim classnoarr()
diff --git a/dlls/vbscript/vbscript.h b/dlls/vbscript/vbscript.h
index ced19f86bbc..faed1869541 100644
--- a/dlls/vbscript/vbscript.h
+++ b/dlls/vbscript/vbscript.h
@@ -254,6 +254,7 @@ typedef enum {
     X(hres,           1, ARG_UINT,    0)          \
     X(errmode,        1, ARG_INT,     0)          \
     X(eqv,            1, 0,           0)          \
+    X(erase,          1, ARG_BSTR,    0)          \
     X(exp,            1, 0,           0)          \
     X(gt,             1, 0,           0)          \
     X(gteq,           1, 0,           0)          \
-- 
GitLab

https://gitlab.winehq.org/wine/wine/-/merge_requests/10449