tdf#88442 SBasic: Don't double-initialize a Global ... As New ...

"As New" variables use lazy instantiation, but that should not re-apply each
time one re-enters the module. If the object is still there, don't replace it.

Change-Id: Ic568a56b93db9bc9139d434d97a4a4deb05840df
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/112018
Tested-by: Jenkins
Reviewed-by: Mike Kaganski <mike.kaganski@collabora.com>
diff --git a/basic/CppunitTest_basic_macros.mk b/basic/CppunitTest_basic_macros.mk
index 6cce947..c2c1eb5b 100644
--- a/basic/CppunitTest_basic_macros.mk
+++ b/basic/CppunitTest_basic_macros.mk
@@ -19,6 +19,7 @@ $(eval $(call gb_CppunitTest_add_exception_objects,basic_macros, \
	basic/qa/cppunit/test_language_conditionals \
	basic/qa/cppunit/test_nested_struct \
	basic/qa/cppunit/test_vba \
	basic/qa/cppunit/test_global_as_new \
))

$(eval $(call gb_CppunitTest_use_libraries,basic_macros, \
diff --git a/basic/qa/cppunit/test_global_as_new.cxx b/basic/qa/cppunit/test_global_as_new.cxx
new file mode 100644
index 0000000..db64a97
--- /dev/null
+++ b/basic/qa/cppunit/test_global_as_new.cxx
@@ -0,0 +1,86 @@
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4; fill-column: 100 -*- */
/*
 * This file is part of the LibreOffice project.
 *
 * This Source Code Form is subject to the terms of the Mozilla Public
 * License, v. 2.0. If a copy of the MPL was not distributed with this
 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
 */

#include <basic/sbstar.hxx>
#include <basic/sbmeth.hxx>
#include <basic/basrdll.hxx>
#include <cppunit/TestSuite.h>
#include <cppunit/plugin/TestPlugIn.h>
#include <cppunit/extensions/HelperMacros.h>
#include <iostream>

namespace
{
class GlobalAsNewTest : public CppUnit::TestFixture
{
    void testMaintainsValueAcrossCalls();

    CPPUNIT_TEST_SUITE(GlobalAsNewTest);
    CPPUNIT_TEST(testMaintainsValueAcrossCalls);
    CPPUNIT_TEST_SUITE_END();

    BasicDLL lib;
    StarBASICRef interpreter;

    SbModuleRef Module()
    {
        interpreter = new StarBASIC();
        auto mod = interpreter->MakeModule("GlobalAsNew", R"BAS(
Global aDate As New "com.sun.star.util.Date"

Function GetDateAsString As String
    DIM local_Date As New "com.sun.star.util.Date"
    GetDateAsString = TRIM(STR(aDate.Year)) + "-" + TRIM(STR(local_Date.Year)) + TRIM(STR(aDate.Month)) + "-" + TRIM(STR(aDate.Day))
End Function

Function SetDate
   aDate.Month = 6
   aDate.Day   = 30
   aDate.Year  = 2019
   SetDate = GetDateAsString()
End Function

        )BAS");
        CPPUNIT_ASSERT(mod->Compile());
        CPPUNIT_ASSERT_EQUAL(StarBASIC::GetErrBasic(), ERRCODE_NONE);
        CPPUNIT_ASSERT_EQUAL(SbxBase::GetError(), ERRCODE_NONE);
        CPPUNIT_ASSERT(mod->IsCompiled());
        return mod;
    }
};

void GlobalAsNewTest::testMaintainsValueAcrossCalls()
{
    auto m = Module();
    auto GetDateAsString = m->FindMethod("GetDateAsString", SbxClassType::Method);
    CPPUNIT_ASSERT_MESSAGE("Could not Find GetDateAsString in module", GetDateAsString != nullptr);

    // There is no SbxMethod::call(), the basic code is exercised here in the copy ctor
    SbxVariableRef returned = new SbxMethod{ *GetDateAsString };
    CPPUNIT_ASSERT(returned->IsString());
    //0-00-0 is the result of reading the default-initialized date
    CPPUNIT_ASSERT_EQUAL(OUString{ "0-00-0" }, returned->GetOUString());

    auto SetDate = m->FindMethod("SetDate", SbxClassType::Method);
    CPPUNIT_ASSERT_MESSAGE("Could not Find SetDate in module", SetDate != nullptr);
    returned = new SbxMethod{ *SetDate };
    CPPUNIT_ASSERT(returned->IsString());
    OUString set_val("2019-06-30");
    CPPUNIT_ASSERT_EQUAL(set_val, returned->GetOUString());

    returned = new SbxMethod{ *GetDateAsString };
    CPPUNIT_ASSERT(returned->IsString());
    //tdf#88442 The global should have maintained its state!
    CPPUNIT_ASSERT_EQUAL(set_val, returned->GetOUString());
}

// Put the test suite in the registry
CPPUNIT_TEST_SUITE_REGISTRATION(GlobalAsNewTest);

} // namespace
diff --git a/basic/source/comp/dim.cxx b/basic/source/comp/dim.cxx
index 20396cd..cf14d1c 100644
--- a/basic/source/comp/dim.cxx
+++ b/basic/source/comp/dim.cxx
@@ -446,12 +446,39 @@ void SbiParser::DefVar( SbiOpcode eOp, bool bStatic )
            {
                SbiExpression aExpr( this, *pDef );
                aExpr.Gen();

                /* tdf#88442
                 * Don't initialize a
                 *      Global X as New SomeObjectType
                 * if it has already been initialized.
                 * This approach relies on JUMPT evaluating Object->NULL as being 'false'
                 * But the effect of this code is similar to inserting
                 *  If IsNull(YourGlobal)
                 *      Set YourGlobal = ' new obj
                 *  End If ' If IsNull(YourGlobal)
                 * Only for globals. For locals that check is skipped as it's unnecessary
                 */
                sal_uInt32 come_from = 0;
                if ( pDef->GetScope() == SbGLOBAL )
                {
                    come_from = aGen.Gen( SbiOpcode::JUMPT_, 0 );
                    aGen.Gen( SbiOpcode::FIND_, pDef->GetId(), pDef->GetTypeId() );
                }

                SbiOpcode eOp_ = pDef->IsNew() ? SbiOpcode::CREATE_ : SbiOpcode::TCREATE_;
                aGen.Gen( eOp_, pDef->GetId(), pDef->GetTypeId() );
                if ( bVBASupportOn )
                    aGen.Gen( SbiOpcode::VBASET_ );
                else
                    aGen.Gen( SbiOpcode::SET_ );

                if ( come_from )
                {
                    // See other tdf#88442 comment above where come_from is
                        // initialized. This is effectively 'inserting' the
                        // End If ' If IsNull(YourGlobal)
                    aGen.BackChain( come_from );
                }
            }
        }
        else
diff --git a/basic/source/inc/runtime.hxx b/basic/source/inc/runtime.hxx
index 1169820..73e5683 100644
--- a/basic/source/inc/runtime.hxx
+++ b/basic/source/inc/runtime.hxx
@@ -288,6 +288,7 @@ class SbiRuntime

    // #56204 swap out DIM-functionality into help method (step0.cxx)
    void DimImpl(const SbxVariableRef& refVar);
    bool EvaluateTopOfStackAsBool();

    static bool implIsClass( SbxObject const * pObj, const OUString& aClass );

diff --git a/basic/source/runtime/runtime.cxx b/basic/source/runtime/runtime.cxx
index 9de5da6..d1dcd3d 100644
--- a/basic/source/runtime/runtime.cxx
+++ b/basic/source/runtime/runtime.cxx
@@ -2975,24 +2975,46 @@ void SbiRuntime::StepJUMP( sal_uInt32 nOp1 )
    pCode = pImg->GetCode() + nOp1;
}

bool SbiRuntime::EvaluateTopOfStackAsBool()
{
    SbxVariableRef tos = PopVar();
    // In a test e.g. If Null then
        // will evaluate Null will act as if False
    if ( bVBAEnabled && tos->IsNull() )
    {
        return false;
    }
    if ( tos->IsObject() )
    {
        //GetBool applied to an Object attempts to dereference and evaluate
            //the underlying value as Bool. Here, we're checking rather that
            //it is not null
        return tos->GetObject();
    }
    else
    {
        return tos->GetBool();
    }
}

// evaluate TOS, conditional jump (+target)

void SbiRuntime::StepJUMPT( sal_uInt32 nOp1 )
{
    SbxVariableRef p = PopVar();
    if( p->GetBool() )
    if ( EvaluateTopOfStackAsBool() )
    {
        StepJUMP( nOp1 );
    }
}

// evaluate TOS, conditional jump (+target)

void SbiRuntime::StepJUMPF( sal_uInt32 nOp1 )
{
    SbxVariableRef p = PopVar();
    // In a test e.g. If Null then
        // will evaluate Null will act as if False
    if( ( bVBAEnabled && p->IsNull() ) || !p->GetBool() )
    if ( !EvaluateTopOfStackAsBool() )
    {
        StepJUMP( nOp1 );
    }
}

// evaluate TOS, jump into JUMP-table (+MaxVal)