01/01: [VBSCRIPT_WINETEST] Sync with Wine 3.0. CORE-14225

[Amine Khaldi]

https://git.reactos.org/?p=reactos.git;a=commitdiff;h=942c426525dde73327d5c…

commit 942c426525dde73327d5c46ccdd101f0d29892f2
Author:     Amine Khaldi <amine.khaldi(a)reactos.org>
AuthorDate: Sat Jan 20 13:40:57 2018 +0100
Commit:     Amine Khaldi <amine.khaldi(a)reactos.org>
CommitDate: Sat Jan 20 13:40:57 2018 +0100

    [VBSCRIPT_WINETEST] Sync with Wine 3.0. CORE-14225
---
 modules/rostests/winetests/vbscript/api.vbs     |  29 ++++-
 modules/rostests/winetests/vbscript/createobj.c |   4 +
 modules/rostests/winetests/vbscript/error.vbs   |  12 +--
 modules/rostests/winetests/vbscript/lang.vbs    | 135 +++++++++++++++++++++++-
 modules/rostests/winetests/vbscript/run.c       |  67 ++++++++----
 5 files changed, 219 insertions(+), 28 deletions(-)

diff --git a/modules/rostests/winetests/vbscript/api.vbs
b/modules/rostests/winetests/vbscript/api.vbs
index f6b6f69420..8ebbfb6c5c 100644
--- a/modules/rostests/winetests/vbscript/api.vbs
+++ b/modules/rostests/winetests/vbscript/api.vbs
@@ -212,6 +212,31 @@ arr(0) = 2
 arr(1) = 3
 Call ok(not isNumeric(arr), "isNumeric(arr) is not true?")
 
+Call ok(getVT(Array()) = "VT_ARRAY|VT_VARIANT", "getVT(Array()) = "
& getVT(Array()))
+x = Array("a1", 2, "a3")
+Call ok(getVT(x) = "VT_ARRAY|VT_VARIANT*", "getVT(array) = " &
getVT(x))
+Call ok(getVT(x(0)) = "VT_BSTR*", "getVT(array(0)) = " &
getVT(x(0)))
+Call ok(x(0) = "a1", "array(0) = " & x(0))
+Call ok(getVT(x(1)) = "VT_I2*", "getVT(array(1)) = " &
getVT(x(1)))
+Call ok(x(1) = 2, "array(1) = " & x(1))
+Call ok(getVT(x(2)) = "VT_BSTR*", "getVT(array(2)) = " &
getVT(x(2)))
+Call ok(x(2) = "a3", "array(2) = " & x(2))
+
+Dim new_array
+new_array = x
+x(0) = "new value"
+Call ok(new_array(0) = "a1", "new_array(0) = " & new_array(0))
+
+Call ok(getVT(UBound(x)) = "VT_I4", "getVT(UBound(x)) = " &
getVT(UBound(x)))
+Call ok(UBound(x) = 2, "UBound(x) = " & UBound(x))
+Call ok(getVT(UBound(x, 1)) = "VT_I4", "getVT(UBound(x, 1)) = " &
getVT(UBound(x, 1)))
+Call ok(UBound(x, 1) = 2, "UBound(x) = " & UBound(x, 1))
+
+Dim arr2(2, 4)
+Call ok(UBound(arr2) = 2, "UBound(x) = " & UBound(x))
+Call ok(UBound(arr2, 1) = 2, "UBound(x) = " & UBound(x))
+Call ok(UBound(arr2, 2) = 4, "UBound(x) = " & UBound(x))
+
 Dim newObject
 Set newObject = New ValClass
 newObject.myval = 1
@@ -579,7 +604,6 @@ if isEnglishLang then
     Call ok(WeekDayName(1, false) = "Sunday", "WeekDayName(1, false) =
" & WeekDayName(1, false))
     Call ok(WeekDayName(1, true) = "Sun", "WeekDayName(1, true) = "
& WeekDayName(1, true))
     Call ok(WeekDayName(1, 10) = "Sun", "WeekDayName(1, 10) = " &
WeekDayName(1, 10))
-    Call ok(WeekDayName(1, true, 0) = "Sun", "WeekDayName(1, true, 0) =
" & WeekDayName(1, true, 0))
     Call ok(WeekDayName(1, true, 2) = "Mon", "WeekDayName(1, true, 2) =
" & WeekDayName(1, true, 2))
     Call ok(WeekDayName(1, true, 2.5) = "Mon", "WeekDayName(1, true, 2.5)
= " & WeekDayName(1, true, 2.5))
     Call ok(WeekDayName(1, true, 1.5) = "Mon", "WeekDayName(1, true, 1.5)
= " & WeekDayName(1, true, 1.5))
@@ -594,6 +618,9 @@ if isEnglishLang then
     Call ok(MonthName(12, true) = "Dec", "MonthName(12, true) = "
& MonthName(12, true))
 end if
 
+Call ok(WeekDayName(1, true, 0) = WeekDayName(1, true, firstDayOfWeek), _
+        "WeekDayName(1, true, 0) = " & WeekDayName(1, true, 0))
+
 Call ok(getVT(Now()) = "VT_DATE", "getVT(Now()) = " &
getVT(Now()))
 
 Call ok(vbOKOnly = 0, "vbOKOnly = " & vbOKOnly)
diff --git a/modules/rostests/winetests/vbscript/createobj.c
b/modules/rostests/winetests/vbscript/createobj.c
index 71829600b8..4ff0ea7952 100644
--- a/modules/rostests/winetests/vbscript/createobj.c
+++ b/modules/rostests/winetests/vbscript/createobj.c
@@ -58,6 +58,8 @@
 
 extern const CLSID CLSID_VBScript;
 
+#define VB_E_ACCESS_DENIED      0x800a0046
+
 #define DEFINE_EXPECT(func) \
     static BOOL expect_ ## func = FALSE, called_ ## func = FALSE
 
@@ -996,6 +998,8 @@ static void test_GetObject(void)
     SET_EXPECT(SetSite);
     SET_EXPECT(reportSuccess);
     hres = parse_script_ae(parser, "Call GetObject(\"clsid:"
TESTOBJINST_CLSID "\").reportSuccess()");
+    if(broken(hres == VB_E_ACCESS_DENIED)) /* 64-bit win8 fails on the first try */
+        hres = parse_script_ae(parser, "Call GetObject(\"clsid:"
TESTOBJINST_CLSID "\").reportSuccess()");
     if(hres == HRESULT_FROM_WIN32(ERROR_MOD_NOT_FOUND)) { /* Workaround for broken win2k
*/
         win_skip("got unexpected error %08x\n", hres);
         CLEAR_CALLED(QI_IObjectWithSite);
diff --git a/modules/rostests/winetests/vbscript/error.vbs
b/modules/rostests/winetests/vbscript/error.vbs
index 3bf03dfae4..78314c3569 100644
--- a/modules/rostests/winetests/vbscript/error.vbs
+++ b/modules/rostests/winetests/vbscript/error.vbs
@@ -190,7 +190,7 @@ sub testThrow
     next
     call ok(x = 2, "x = " & x)
     call ok(y = 1, "y = " & y)
-    'todo_wine call ok(Err.Number = VB_E_OBJNOTCOLLECTION, "Err.Number = "
& Err.Number)
+    call todo_wine_ok(Err.Number = VB_E_OBJNOTCOLLECTION, "Err.Number = " &
Err.Number)
 
     Err.clear()
     y = 0
@@ -202,19 +202,19 @@ sub testThrow
     next
     call ok(y = 1, "y = " & y)
     call ok(x = 6, "x = " & x)
-    'todo_wine call ok(Err.Number = VB_E_FORLOOPNOTINITIALIZED, "Err.Number =
" & Err.Number)
+    call todo_wine_ok(Err.Number = VB_E_FORLOOPNOTINITIALIZED, "Err.Number = "
& Err.Number)
 
     Err.clear()
     y = 0
     x = 6
     for x = 100 to throwInt(E_TESTERROR)
         call ok(Err.Number = E_TESTERROR, "Err.Number = " & Err.Number)
-        'todo_wine call ok(x = 6, "x = " & x)
+        call todo_wine_ok(x = 6, "x = " & x)
         y = y+1
     next
     call ok(y = 1, "y = " & y)
-    'todo_wine call ok(x = 6, "x = " & x)
-    'todo_wine call ok(Err.Number = VB_E_FORLOOPNOTINITIALIZED, "Err.Number =
" & Err.Number)
+    call todo_wine_ok(x = 6, "x = " & x)
+    call todo_wine_ok(Err.Number = VB_E_FORLOOPNOTINITIALIZED, "Err.Number = "
& Err.Number)
 
     select case throwInt(E_TESTERROR)
     case true
@@ -308,7 +308,7 @@ sub testForEachError()
         y = true
     next
     call ok(y, "for each not executed")
-    'todo_wine call ok(Err.Number = VB_E_OBJNOTCOLLECTION, "Err.Number = "
& Err.Number)
+    call todo_wine_ok(Err.Number = VB_E_OBJNOTCOLLECTION, "Err.Number = " &
Err.Number)
 end sub
 
 call testForEachError()
diff --git a/modules/rostests/winetests/vbscript/lang.vbs
b/modules/rostests/winetests/vbscript/lang.vbs
index 23402cd893..2af77bdfcc 100644
--- a/modules/rostests/winetests/vbscript/lang.vbs
+++ b/modules/rostests/winetests/vbscript/lang.vbs
@@ -16,7 +16,7 @@
 ' Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
 '
 
-Option Explicit
+OPTION EXPLICIT  : : DIM W
 
 dim x, y, z
 Dim obj
@@ -53,6 +53,9 @@ Call ok(false = 0, "false <> 0")
 Call ok(&hff = 255, "&hff <> 255")
 Call ok(&Hff = 255, "&Hff <> 255")
 
+W = 5
+Call ok(W = 5, "W = " & W & " expected " & 5)
+
 x = "xx"
 Call ok(x = "xx", "x = " & x & " expected
""xx""")
 
@@ -330,6 +333,13 @@ WHILE x < 3 : x = x + 1
 Wend
 Call ok(x = 3, "x not equal to 3")
 
+z = 2
+while z > -4 :
+
+
+z = z -2
+wend
+
 x = false
 y = false
 do while not (x and y)
@@ -353,6 +363,12 @@ Do While x < 2 : x = x + 1
 Loop
 Call ok(x = 2, "x not equal to 2")
 
+x = 0
+Do While x >= -2 :
+x = x - 1
+Loop
+Call ok(x = -3, "x not equal to -3")
+
 x = false
 y = false
 do until x and y
@@ -376,6 +392,14 @@ Do: :: x = x + 2
 Loop Until x = 4
 Call ok(x = 4, "x not equal to 4")
 
+x = 5
+Do: :
+
+: x = x * 2
+Loop Until x = 40
+Call ok(x = 40, "x not equal to 40")
+
+
 x = false
 do
     if x then exit do
@@ -495,6 +519,12 @@ for x = 1 to 100
     Call ok(false, "exit for not escaped the loop?")
 next
 
+for x = 1 to 5 :
+:
+:   :exit for
+    Call ok(false, "exit for not escaped the loop?")
+next
+
 do while true
     for x = 1 to 100
         exit do
@@ -507,6 +537,14 @@ while null
     call ok(false, "while null evaluated")
 wend
 
+Call collectionObj.reset()
+y = 0
+for each x in collectionObj :
+
+   :y = y + 3
+next
+Call ok(y = 9, "y = " & y)
+
 Call collectionObj.reset()
 y = 0
 x = 10
@@ -611,6 +649,21 @@ select case 2: case 5,6,7: Call ok(false, "unexpected
case")
 end select
 Call ok(x, "wrong case")
 
+x = False
+select case 1  :
+
+    :case 3, 4 :
+
+
+    case 5
+:
+        Call ok(false, "unexpected case") :
+    Case Else:
+
+        x = True
+end select
+Call ok(x, "wrong case")
+
 if false then
 Sub testsub
     x = true
@@ -699,6 +752,11 @@ Private Sub TestPrivateSub
 End Sub
 Call TestPrivateSub
 
+Public Sub TestSeparatorSub : :
+:
+End Sub
+Call TestSeparatorSub
+
 if false then
 Function testfunc
     x = true
@@ -814,6 +872,12 @@ Private Function TestPrivateFunc
 End Function
 Call TestPrivateFunc
 
+Public Function TestSepFunc(ByVal a) : :
+: TestSepFunc = a
+End Function
+Call ok(TestSepFunc(1) = 1, "Function did not return 1")
+
+
 ' Stop has an effect only in debugging mode
 Stop
 
@@ -1074,6 +1138,30 @@ Class Property2
     End Sub
 End Class
 
+Class SeparatorTest : : Dim varTest1
+:
+    Private Sub Class_Initialize : varTest1 = 1
+    End Sub ::
+
+    Property Get Test1() :
+        Test1 = varTest1
+    End Property ::
+: :
+    Property Let Test1(a) :
+        varTest1 = a
+    End Property :
+
+    Public Function AddToTest1(ByVal a)  :: :
+        varTest1 = varTest1 + a
+        AddToTest1 = varTest1
+    End Function :    End Class : ::   Set obj = New SeparatorTest
+
+Call ok(obj.Test1 = 1, "obj.Test1 is not 1")
+obj.Test1 = 6
+Call ok(obj.Test1 = 6, "obj.Test1 is not 6")
+obj.AddToTest1(5)
+Call ok(obj.Test1 = 11, "obj.Test1 is not 11")
+
 ' Array tests
 
 Call ok(getVT(arr) = "VT_EMPTY*", "getVT(arr) = " & getVT(arr))
@@ -1107,6 +1195,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))
@@ -1200,6 +1290,49 @@ Call testarrarg(1, "VT_I2*")
 Call testarrarg(false, "VT_BOOL*")
 Call testarrarg(Empty, "VT_EMPTY*")
 
+Sub modifyarr(arr)
+    'Following test crashes on wine
+    'Call ok(arr(0) = "not modified", "arr(0) = " & arr(0))
+    arr(0) = "modified"
+End Sub
+
+arr(0) = "not modified"
+Call modifyarr(arr)
+Call ok(arr(0) = "modified", "arr(0) = " & arr(0))
+
+arr(0) = "not modified"
+modifyarr(arr)
+Call todo_wine_ok(arr(0) = "not modified", "arr(0) = " & arr(0))
+
+for x = 0 to UBound(arr)
+    arr(x) = x
+next
+y = 0
+for each x in arr
+    Call ok(x = y, "x = " & x & ", expected " & y)
+    Call ok(arr(y) = y, "arr(" & y & ") = " & arr(y))
+    arr(y) = 1
+    x = 1
+    y = y+1
+next
+Call ok(y = 4, "y = " & y & " after array enumeration")
+
+for x=0 to UBound(arr2, 1)
+    for y=0 to UBound(arr2, 2)
+        arr2(x, y) = x + y*(UBound(arr2, 1)+1)
+    next
+next
+y = 0
+for each x in arr2
+    Call ok(x = y, "x = " & x & ", expected " & y)
+    y = y+1
+next
+Call ok(y = 20, "y = " & y & " after array enumeration")
+
+for each x in noarr
+    Call ok(false, "Empty array contains: " & x)
+next
+
 ' It's allowed to declare non-builtin RegExp class...
 class RegExp
      public property get Global()
diff --git a/modules/rostests/winetests/vbscript/run.c
b/modules/rostests/winetests/vbscript/run.c
index 8821b796db..382cffca97 100644
--- a/modules/rostests/winetests/vbscript/run.c
+++ b/modules/rostests/winetests/vbscript/run.c
@@ -129,6 +129,8 @@ DEFINE_EXPECT(OnScriptError);
 #define DISPID_GLOBAL_TESTOPTIONALARG 1017
 #define DISPID_GLOBAL_LETOBJ        1018
 #define DISPID_GLOBAL_SETOBJ        1019
+#define DISPID_GLOBAL_TODO_WINE_OK  1020
+#define DISPID_GLOBAL_WEEKSTARTDAY  1021
 
 #define DISPID_TESTOBJ_PROPGET      2000
 #define DISPID_TESTOBJ_PROPPUT      2001
@@ -142,6 +144,7 @@ static const WCHAR testW[] =
{'t','e','s','t',0};
 static const WCHAR emptyW[] = {0};
 
 static BOOL strict_dispid_check, is_english, allow_ui;
+static int first_day_of_week;
 static const char *test_name = "(null)";
 static int test_counter;
 static SCRIPTUICHANDLING uic_handling = SCRIPTUICHANDLING_NOUIERROR;
@@ -210,27 +213,22 @@ static const char *vt2a(VARIANT *v)
     }
 }
 
-/* Returns true if the user interface is in English. Note that this does not
- * presume of the formatting of dates, numbers, etc.
+/* Sets is_english to true if the user interface is in English. Note that this
+ * does not presume the formatting of dates, numbers, etc.
+ * Sets first_day_of_week to 1 if Sunday, 2 if Monday, and so on.
  */
-static BOOL is_lang_english(void)
+static void detect_locale(void)
 {
-    static HMODULE hkernel32 = NULL;
-    static LANGID (WINAPI *pGetThreadUILanguage)(void) = NULL;
-    static LANGID (WINAPI *pGetUserDefaultUILanguage)(void) = NULL;
+    HMODULE kernel32 = GetModuleHandleA("kernel32.dll");
+    LANGID (WINAPI *pGetThreadUILanguage)(void) = (void*)GetProcAddress(kernel32,
"GetThreadUILanguage");
 
-    if (!hkernel32)
-    {
-        hkernel32 = GetModuleHandleA("kernel32.dll");
-        pGetThreadUILanguage = (void*)GetProcAddress(hkernel32,
"GetThreadUILanguage");
-        pGetUserDefaultUILanguage = (void*)GetProcAddress(hkernel32,
"GetUserDefaultUILanguage");
-    }
-    if (pGetThreadUILanguage && PRIMARYLANGID(pGetThreadUILanguage()) !=
LANG_ENGLISH)
-        return FALSE;
-    if (pGetUserDefaultUILanguage && PRIMARYLANGID(pGetUserDefaultUILanguage())
!= LANG_ENGLISH)
-        return FALSE;
+    is_english = ((!pGetThreadUILanguage || PRIMARYLANGID(pGetThreadUILanguage()) ==
LANG_ENGLISH) &&
+                  PRIMARYLANGID(GetUserDefaultUILanguage()) == LANG_ENGLISH &&
+                  PRIMARYLANGID(GetUserDefaultLangID()) == LANG_ENGLISH);
 
-    return PRIMARYLANGID(GetUserDefaultLangID()) == LANG_ENGLISH;
+    GetLocaleInfoA(LOCALE_USER_DEFAULT, LOCALE_IFIRSTDAYOFWEEK | LOCALE_RETURN_NUMBER,
+                   (void*)&first_day_of_week, sizeof(first_day_of_week));
+    first_day_of_week = 1 + (first_day_of_week + 1) % 7;
 }
 
 static HRESULT WINAPI ServiceProvider_QueryInterface(IServiceProvider *iface, REFIID
riid, void **ppv)
@@ -990,6 +988,11 @@ static HRESULT WINAPI Global_GetDispID(IDispatchEx *iface, BSTR
bstrName, DWORD
         *pid = DISPID_GLOBAL_OK;
         return S_OK;
     }
+    if(!strcmp_wa(bstrName, "todo_wine_ok")) {
+        test_grfdex(grfdex, fdexNameCaseInsensitive);
+        *pid = DISPID_GLOBAL_TODO_WINE_OK;
+        return S_OK;
+    }
     if(!strcmp_wa(bstrName, "trace")) {
         test_grfdex(grfdex, fdexNameCaseInsensitive);
         *pid = DISPID_GLOBAL_TRACE;
@@ -1011,6 +1014,11 @@ static HRESULT WINAPI Global_GetDispID(IDispatchEx *iface, BSTR
bstrName, DWORD
         *pid = DISPID_GLOBAL_ISENGLANG;
         return S_OK;
     }
+    if(!strcmp_wa(bstrName, "firstDayOfWeek")) {
+        test_grfdex(grfdex, fdexNameCaseInsensitive);
+        *pid = DISPID_GLOBAL_WEEKSTARTDAY;
+        return S_OK;
+    }
     if(!strcmp_wa(bstrName, "testObj")) {
         test_grfdex(grfdex, fdexNameCaseInsensitive);
         *pid = DISPID_GLOBAL_TESTOBJ;
@@ -1099,6 +1107,7 @@ static HRESULT WINAPI Global_InvokeEx(IDispatchEx *iface, DISPID id,
LCID lcid,
         VARIANT *pvarRes, EXCEPINFO *pei, IServiceProvider *pspCaller)
 {
     switch(id) {
+    case DISPID_GLOBAL_TODO_WINE_OK:
     case DISPID_GLOBAL_OK: {
         VARIANT *b;
 
@@ -1122,7 +1131,8 @@ static HRESULT WINAPI Global_InvokeEx(IDispatchEx *iface, DISPID id,
LCID lcid,
 
         ok(V_VT(b) == VT_BOOL, "V_VT(b) = %d\n", V_VT(b));
 
-        ok(V_BOOL(b), "%s: %s\n", test_name,
wine_dbgstr_w(V_BSTR(pdp->rgvarg)));
+        todo_wine_if(id == DISPID_GLOBAL_TODO_WINE_OK)
+            ok(V_BOOL(b), "%s: %s\n", test_name,
wine_dbgstr_w(V_BSTR(pdp->rgvarg)));
         return S_OK;
     }
 
@@ -1182,6 +1192,11 @@ static HRESULT WINAPI Global_InvokeEx(IDispatchEx *iface, DISPID
id, LCID lcid,
         V_BOOL(pvarRes) = is_english ? VARIANT_TRUE : VARIANT_FALSE;
         return S_OK;
 
+    case DISPID_GLOBAL_WEEKSTARTDAY:
+        V_VT(pvarRes) = VT_I4;
+        V_I4(pvarRes) = first_day_of_week;
+        return S_OK;
+
     case DISPID_GLOBAL_VBVAR:
         CHECK_EXPECT(global_vbvar_i);
 
@@ -1633,8 +1648,20 @@ static HRESULT WINAPI
ActiveScriptSite_OnStateChange(IActiveScriptSite *iface, S
 static HRESULT WINAPI ActiveScriptSite_OnScriptError(IActiveScriptSite *iface,
IActiveScriptError *pscripterror)
 {
     HRESULT hr = onerror_hres;
-    CHECK_EXPECT(OnScriptError);
 
+    if(!expect_OnScriptError) {
+        EXCEPINFO info;
+        ULONG line;
+        HRESULT hres;
+
+        hres = IActiveScriptError_GetSourcePosition(pscripterror, NULL, &line,
NULL);
+        if(SUCCEEDED(hres))
+            hres = IActiveScriptError_GetExceptionInfo(pscripterror, &info);
+        if(SUCCEEDED(hres))
+            trace("Error in line %u: %s\n", line+1,
wine_dbgstr_w(info.bstrDescription));
+    }
+
+    CHECK_EXPECT(OnScriptError);
     onerror_hres = E_NOTIMPL;
 
     return hr;
@@ -2342,7 +2369,7 @@ START_TEST(run)
     int argc;
     char **argv;
 
-    is_english = is_lang_english();
+    detect_locale();
     if(!is_english)
         skip("Skipping some tests in non-English locale\n");