tdf#149622: also clear return value before calling method from SbxObject::Call

Moves the custom cleanup logic to overridden SbxMethod::Clear, to simplify
the cleanup code and make sure it restores empty Variant correctly.

Change-Id: I01fa0529acd9ac787ffcda60fd6836ade4afdcb1
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/136108
Tested-by: Jenkins
Reviewed-by: Mike Kaganski <mike.kaganski@collabora.com>

5 files changed, 98 insertions, 7 deletions

diff --git a/basic/qa/basic_coverage/test_tdf149622.bas b/basic/qa/basic_coverage/test_tdf149622.bas
new file mode 100644
index 000000000000..5c4738c068b2
--- /dev/null
+++ b/basic/qa/basic_coverage/test_tdf149622.bas
@@ -0,0 +1,48 @@
+'
+' 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/.
+'
+
+Option Explicit
+
+Function doUnitTest() As String
+    TestUtil.TestInit
+    verify_tdf149622()
+    doUnitTest = TestUtil.GetResult()
+End Function
+
+Sub verify_tdf149622()
+    On Error GoTo errorHandler
+
+    ' Testing fixed-type return value (Handler_handleEvent(...) As Boolean)
+    Dim oHandler
+    oHandler = CreateUnoListener("Handler_", "com.sun.star.awt.XEventHandler")
+    TestUtil.AssertEqualStrict(oHandler.handleEvent(0), True, "oHandler.handleEvent(0)")
+    ' Before the fix for tdf#149622, this returned the previous return value
+    TestUtil.AssertEqualStrict(oHandler.handleEvent(1), False, "oHandler.handleEvent(1)")
+
+    ' Testing Variant return value (Transfer_getData)
+    Dim oTransferable, aId0(0) As Byte, aId1(1) As Byte
+    oTransferable = CreateUnoListener("Transfer_", "com.sun.star.datatransfer.XSystemTransferable")
+    TestUtil.AssertEqualStrict(oTransferable.getData(aId0), True, "oTransferable.getData(aId0)")
+    ' Before the fix for tdf#149622, this returned the previous return value
+    TestUtil.AssertEqualStrict(oTransferable.getData(aId1), Empty, "oTransferable.getData(aId1)")
+
+    Exit Sub
+
+errorHandler:
+    TestUtil.ReportErrorHandler("verify_tdf149622", Err, Error$, Erl)
+End Sub
+
+Function Handler_handleEvent(Event) As Boolean
+    If Event = 0 Then Handler_handleEvent = True
+    ' Do not define return value explicitly in Else case
+End Function
+
+Function Transfer_getData(aProcessId())
+    If UBound(aProcessId) - LBound(aProcessId) = 0 Then Transfer_getData = True ' only for 1-element array
+    ' Do not define return value explicitly in Else case
+End Function
diff --git a/basic/qa/cppunit/_test_asserts.bas b/basic/qa/cppunit/_test_asserts.bas
index 51442a0590a6..68865755bdcd 100644
--- a/basic/qa/cppunit/_test_asserts.bas
+++ b/basic/qa/cppunit/_test_asserts.bas
@@ -34,8 +34,8 @@ Sub Assert(Assertion As Boolean, Optional testId As String, Optional testComment
         If Not IsMissing(testId) Then
             testMsg = " " + testId
         End If
-        If Not IsMissing(testComment) And Not (testComment = "") Then
-            testMsg = testMsg + " (" + testComment + ")"
+        If Not IsMissing(testComment) Then
+            If Not (testComment = "") Then testMsg = testMsg + " (" + testComment + ")"
         End If
 
         result = result & Chr$(10) & " Failed:" & testMsg
@@ -52,6 +52,12 @@ Sub AssertEqual(actual As Variant, expected As Variant, testName As String)
     End If
 End Sub
 
+' Same as AssertEqual, but also checks actual and expected types
+Sub AssertEqualStrict(actual As Variant, expected As Variant, testName As String)
+    AssertEqual(actual, expected, testName)
+    AssertEqual(TypeName(actual), TypeName(expected), testName & " type mismatch:")
+End Sub
+
 Sub AssertEqualApprox(actual, expected, epsilon, testName As String)
     If Abs(expected - actual) <= epsilon Then
         passCount = passCount + 1
diff --git a/basic/qa/cppunit/_test_asserts.vb b/basic/qa/cppunit/_test_asserts.vb
index 0f1d0d88610f..2130ce02f454 100644
--- a/basic/qa/cppunit/_test_asserts.vb
+++ b/basic/qa/cppunit/_test_asserts.vb
@@ -35,8 +35,8 @@ Sub Assert(Assertion As Boolean, Optional testId As String, Optional testComment
         If Not IsMissing(testId) Then
             testMsg = " " + testId
         End If
-        If Not IsMissing(testComment) And Not (testComment = "") Then
-            testMsg = testMsg + " (" + testComment + ")"
+        If Not IsMissing(testComment) Then
+            If Not (testComment = "") Then testMsg = testMsg + " (" + testComment + ")"
         End If
 
         result = result & Chr$(10) & " Failed:" & testMsg
@@ -53,6 +53,12 @@ Sub AssertEqual(actual As Variant, expected As Variant, testName As String)
     End If
 End Sub
 
+' Same as AssertEqual, but also checks actual and expected types
+Sub AssertEqualStrict(actual As Variant, expected As Variant, testName As String)
+    AssertEqual actual, expected, testName
+    AssertEqual TypeName(actual), TypeName(expected), testName & " type mismatch:"
+End Sub
+
 Sub AssertEqualApprox(actual, expected, epsilon, testName As String)
     If Abs(expected - actual) <= epsilon Then
         passCount = passCount + 1
diff --git a/basic/source/classes/sbxmod.cxx b/basic/source/classes/sbxmod.cxx
index af2b4b2c9c5d..e36312756d5f 100644
--- a/basic/source/classes/sbxmod.cxx
+++ b/basic/source/classes/sbxmod.cxx
@@ -2064,10 +2064,7 @@ ErrCode SbMethod::Call( SbxValue* pRet, SbxVariable* pCaller )
         StarBASIC::Error( ERRCODE_BASIC_BAD_PROP_VALUE );
 
     // tdf#143582 - clear return value of the method before calling it
-    const SbxFlagBits nSavFlags = GetFlags();
-    SetFlag(SbxFlagBits::ReadWrite | SbxFlagBits::NoBroadcast);
     Clear();
-    SetFlags(nSavFlags);
 
     Get( aVals );
     if ( pRet )
diff --git a/basic/source/sbx/sbxobj.cxx b/basic/source/sbx/sbxobj.cxx
index 7f3560a62003..a6cbeaba5ca7 100644
--- a/basic/source/sbx/sbxobj.cxx
+++ b/basic/source/sbx/sbxobj.cxx
@@ -29,6 +29,7 @@
 #include <basic/sbxmeth.hxx>
 #include <sbxprop.hxx>
 #include <svl/SfxBroadcaster.hxx>
+#include "sbxdec.hxx"
 #include "sbxres.hxx"
 
 
@@ -262,6 +263,9 @@ bool SbxObject::Call( const OUString& rName, SbxArray* pParam )
     SbxVariable* pMeth = FindQualified( rName, SbxClassType::DontCare);
     if( dynamic_cast<const SbxMethod*>( pMeth) )
     {
+        // tdf#149622 - clear return value of the method before calling it
+        pMeth->Clear();
+
         // FindQualified() might have struck already!
         if( pParam )
         {
@@ -850,6 +854,36 @@ SbxClassType SbxMethod::GetClass() const
     return SbxClassType::Method;
 }
 
+void SbxMethod::Clear()
+{
+    // Release referenced data, and reset data type to the function return type
+    // Implementation similar to SbxValue::SetType
+    // tdf#143582: Don't take "read-only" flag into account, allow clearing method return value
+    switch (aData.eType)
+    {
+        case SbxSTRING:
+            delete aData.pOUString;
+            break;
+        case SbxOBJECT:
+            if (aData.pObj)
+            {
+                if (aData.pObj != this)
+                {
+                    bool bParentProp = (GetUserData() & 0xFFFF) == 5345; // See sbxvalue.cxx
+                    if (!bParentProp)
+                        aData.pObj->ReleaseRef();
+                }
+            }
+            break;
+        case SbxDECIMAL:
+            releaseDecimalPtr(aData.pDecimal);
+            break;
+        default:
+            break;
+    }
+    aData.clear(IsFixed() ? aData.eType : SbxEMPTY);
+}
+
 SbxProperty::SbxProperty( const OUString& r, SbxDataType t )
     : SbxVariable( t )
 {