vbscript: Implement PRNG functions.

Wine-Bug: https://bugs.winehq.org/show_bug.cgi?id=53676
Signed-off-by: Nikolay Sivov <nsivov@codeweavers.com>

dlls/vbscript/global.c

@@ -439,6 +439,20 @@ static HRESULT to_double(VARIANT *v, double *ret)
     return S_OK;
 }
 
+static HRESULT to_float(VARIANT *v, float *ret)
+{
+    VARIANT dst;
+    HRESULT hres;
+
+    V_VT(&dst) = VT_EMPTY;
+    hres = VariantChangeType(&dst, v, 0, VT_R4);
+    if(FAILED(hres))
+        return hres;
+
+    *ret = V_R4(&dst);
+    return S_OK;
+}
+
 static HRESULT to_string(VARIANT *v, BSTR *ret)
 {
     VARIANT dst;
@@ -1075,16 +1089,70 @@ static HRESULT Global_Sqr(BuiltinDisp *This, VARIANT *arg, unsigned args_cnt, VA
         return return_double(res, sqrt(d));
 }
 
+static unsigned int get_next_rnd(int value)
+{
+    return (value * 0x43fd43fd + 0xc39ec3) & 0xffffff;
+}
+
 static HRESULT Global_Randomize(BuiltinDisp *This, VARIANT *arg, unsigned args_cnt, VARIANT *res)
 {
-    FIXME("\n");
-    return E_NOTIMPL;
+    union
+    {
+        double d;
+        unsigned int i[2];
+    } dtoi;
+    unsigned int seed;
+    HRESULT hres;
+
+    assert(args_cnt == 0 || args_cnt == 1);
+    if (args_cnt == 1) {
+        hres = to_double(arg, &dtoi.d);
+        if (FAILED(hres))
+            return hres;
+    }
+    else
+        dtoi.d = GetTickCount() * 0.001;
+
+    seed = dtoi.i[1];
+    seed ^= (seed >> 16);
+    seed = ((seed & 0xffff) << 8) | (This->ctx->script_obj->rnd & 0xff);
+    This->ctx->script_obj->rnd = seed;
+
+    return res ? DISP_E_TYPEMISMATCH : S_OK;
 }
 
 static HRESULT Global_Rnd(BuiltinDisp *This, VARIANT *arg, unsigned args_cnt, VARIANT *res)
 {
-    FIXME("\n");
-    return E_NOTIMPL;
+    static const float modulus = 16777216.0f;
+    unsigned int value;
+    HRESULT hres;
+    float f;
+
+    assert(args_cnt == 0 || args_cnt == 1);
+
+    value = This->ctx->script_obj->rnd;
+    if (args_cnt == 1)
+    {
+        hres = to_float(arg, &f);
+        if (FAILED(hres))
+            return hres;
+
+        if (f < 0.0f)
+        {
+            value = *(unsigned int *)&f;
+            This->ctx->script_obj->rnd = value = get_next_rnd(value + (value >> 24));
+        }
+        else if (f == 0.0f)
+            value = This->ctx->script_obj->rnd;
+        else
+            This->ctx->script_obj->rnd = value = get_next_rnd(value);
+    }
+    else
+    {
+        This->ctx->script_obj->rnd = value = get_next_rnd(value);
+    }
+
+    return return_float(res, (float)value / modulus);
 }
 
 static HRESULT Global_Timer(BuiltinDisp *This, VARIANT *arg, unsigned args_cnt, VARIANT *res)
@@ -3092,12 +3160,12 @@ static const builtin_prop_t global_props[] = {
     {L"MsgBox",                    Global_MsgBox, 0, 1, 5},
     {L"Now",                       Global_Now, 0, 0},
     {L"Oct",                       Global_Oct, 0, 1},
-    {L"Randomize",                 Global_Randomize, 0, 1},
+    {L"Randomize",                 Global_Randomize, 0, 0, 1},
     {L"Replace",                   Global_Replace, 0, 3, 6},
     {L"RGB",                       Global_RGB, 0, 3},
     {L"Right",                     Global_Right, 0, 2},
     {L"RightB",                    Global_RightB, 0, 2},
-    {L"Rnd",                       Global_Rnd, 0, 1},
+    {L"Rnd",                       Global_Rnd, 0, 0, 1},
     {L"Round",                     Global_Round, 0, 1, 2},
     {L"RTrim",                     Global_RTrim, 0, 1},
     {L"ScriptEngine",              Global_ScriptEngine, 0, 0},

dlls/vbscript/tests/api.vbs

@@ -2221,4 +2221,46 @@ call testTimeSerial(10, 60, 2, 11, 0, 2, DateSerial(1899, 12, 30))
 call testTimeSerial(10, 0, 60, 10, 1, 0, DateSerial(1899, 12, 30))
 call testTimeSerialError()
 
+sub testRnd(arg, expresult)
+    dim x
+    x = Rnd(arg)
+    call ok(x = expresult, "result = " & x & " expected " & expresult)
+    call ok(getVT(x) = "VT_R4*", "getVT = " & getVT(x))
+end sub
+
+' Initial seed value
+call testRnd(0, 327680 / 16777216)
+call testRnd(0, 327680 / 16777216)
+' Negative argument is a seed, does not use current RNG state
+call ok(Rnd(-2) = Rnd(-2), "Expected same result")
+call ok(Rnd(-1) <> Rnd(-2), "Expected differing result")
+
+sub testRandomizeError()
+    on error resume next
+    dim x
+    call Err.clear()
+    x = Randomize(0)
+    call ok(Err.number = 13, "Err.number = " & Err.number)
+    call ok(getVT(x) = "VT_EMPTY*", "getVT = " & getVT(x))
+end sub
+
+' Randomize uses current RNG value, so it's reset using Rnd(-1)
+sub testRandomize()
+    dim x, y
+
+    Rnd(-1)
+    Randomize(123)
+    x = Rnd()
+    Randomize(123)
+    y = Rnd()
+    call ok(x <> y, "Expected differing result")
+    Rnd(-1)
+    Randomize(123)
+    y = Rnd()
+    call ok(x = y, "Expected same result")
+end sub
+
+call testRandomize()
+call testRandomizeError()
+
 Call reportSuccess()

dlls/vbscript/vbdisp.c

@@ -1516,6 +1516,7 @@ HRESULT create_script_disp(script_ctx_t *ctx, ScriptDisp **ret)
     script_disp->ref = 1;
     script_disp->ctx = ctx;
     heap_pool_init(&script_disp->heap);
+    script_disp->rnd = 0x50000;
 
     *ret = script_disp;
     return S_OK;

dlls/vbscript/vbscript.h

@@ -136,6 +136,8 @@ typedef struct {
 
     script_ctx_t *ctx;
     heap_pool_t heap;
+
+    unsigned int rnd;
 } ScriptDisp;
 
 typedef struct _builtin_prop_t builtin_prop_t;