ab75: #i110417# add andreas's improvements and additionally don't clear previous err object data

8 files changed, 161 insertions, 97 deletions

diff --git a/basic/source/classes/errobject.cxx b/basic/source/classes/errobject.cxx
index 406d6f9b1a0b..0ec0454e2bb5 100644
--- a/basic/source/classes/errobject.cxx
+++ b/basic/source/classes/errobject.cxx
@@ -43,10 +43,9 @@ class ErrObject : public ErrObjectImpl_BASE
 {
     rtl::OUString m_sHelpFile;
     rtl::OUString m_sSource;
-        rtl::OUString m_sDescription;
+    rtl::OUString m_sDescription;
     sal_Int32 m_nNumber;
     sal_Int32 m_nHelpContext;
-        bool mbIsInError;
 
 public:
     ErrObject();
@@ -68,6 +67,10 @@ public:
     virtual void SAL_CALL Raise( const uno::Any& Number, const uno::Any& Source, const uno::Any& Description, const uno::Any& HelpFile, const uno::Any& HelpContext ) throw (uno::RuntimeException);
     // XDefaultProperty
     virtual ::rtl::OUString SAL_CALL getDefaultPropertyName(  ) throw (uno::RuntimeException);
+
+    // Helper method
+    void setData( const uno::Any& Number, const uno::Any& Source, const uno::Any& Description,
+        const uno::Any& HelpFile, const uno::Any& HelpContext ) throw (uno::RuntimeException);
 };
 
 
@@ -75,7 +78,7 @@ ErrObject::~ErrObject()
 {
 }
 
-ErrObject::ErrObject() : m_nNumber(0), m_nHelpContext(0), mbIsInError(false)
+ErrObject::ErrObject() : m_nNumber(0), m_nHelpContext(0)
 {
 }
 
@@ -88,9 +91,9 @@ ErrObject::getNumber() throw (uno::RuntimeException)
 void SAL_CALL
 ErrObject::setNumber( ::sal_Int32 _number ) throw (uno::RuntimeException)
 {
-//  m_nNumber = _number;
-    if ( !mbIsInError )
-        Raise( uno::makeAny( _number ), uno::Any(),  uno::Any(), uno::Any(), uno::Any() );
+    pINST->setErrorVB( _number, String() );
+    ::rtl::OUString _description = pINST->GetErrorMsg();
+    setData( uno::makeAny( _number ), uno::Any(), uno::makeAny( _description ), uno::Any(), uno::Any() );
 }
 
 ::sal_Int32 SAL_CALL
@@ -154,23 +157,9 @@ ErrObject::Clear(  ) throw (uno::RuntimeException)
 void SAL_CALL
 ErrObject::Raise( const uno::Any& Number, const uno::Any& Source, const uno::Any& Description, const uno::Any& HelpFile, const uno::Any& HelpContext ) throw (uno::RuntimeException)
 {
-    if ( !Number.hasValue() )
-        throw uno::RuntimeException( rtl::OUString::createFromAscii("Missing Required Paramater"), uno::Reference< uno::XInterface >() );
-        mbIsInError = true;
-        Clear();
-    Description >>= m_sDescription;
-    Source >>= m_sSource;
-    HelpFile >>= m_sHelpFile;
-    HelpContext >>= m_nHelpContext;
-    Number >>= m_nNumber;
+    setData( Number, Source, Description, HelpFile, HelpContext );
     if ( m_nNumber )
-    {
-        SbError n = StarBASIC::GetSfxFromVBError( m_nNumber );
-        if ( !n )
-            n = m_nNumber; // force orig number, probably should have a specific table of vb ( localized ) errors
-        pINST->Error( n, m_sDescription );
-    }
-        mbIsInError = false;
+        pINST->ErrorVB( m_nNumber, m_sDescription );
 }
 
 // XDefaultProperty
@@ -181,13 +170,30 @@ ErrObject::getDefaultPropertyName(  ) throw (uno::RuntimeException)
     return sDfltPropName;
 }
 
+void ErrObject::setData( const uno::Any& Number, const uno::Any& Source, const uno::Any& Description, const uno::Any& HelpFile, const uno::Any& HelpContext )
+    throw (uno::RuntimeException)
+{
+    if ( !Number.hasValue() )
+        throw uno::RuntimeException( rtl::OUString::createFromAscii("Missing Required Paramater"), uno::Reference< uno::XInterface >() );
+    Number >>= m_nNumber;
+    Description >>= m_sDescription;
+    Source >>= m_sSource;
+    HelpFile >>= m_sHelpFile;
+    HelpContext >>= m_nHelpContext;
+}
+
 // SbxErrObject
-SbxErrObject::SbxErrObject( const String& rName, const Any& rUnoObj ): SbUnoObject( rName, rUnoObj )
+SbxErrObject::SbxErrObject( const String& rName, const Any& rUnoObj )
+    : SbUnoObject( rName, rUnoObj )
+    , m_pErrObject( NULL )
 {
     OSL_TRACE("SbxErrObject::SbxErrObject ctor");
     rUnoObj >>= m_xErr;
     if ( m_xErr.is() )
+    {
         SetDfltProperty( uno::Reference< script::XDefaultProperty >( m_xErr, uno::UNO_QUERY_THROW )->getDefaultPropertyName() ) ;
+        m_pErrObject = static_cast< ErrObject* >( m_xErr.get() );
+    }
 }
 
 SbxErrObject::~SbxErrObject()
@@ -210,3 +216,10 @@ SbxErrObject::getErrObject()
     return pGlobErr;
 }
 
+void SbxErrObject::setNumberAndDescription( ::sal_Int32 _number, const ::rtl::OUString& _description )
+    throw (uno::RuntimeException)
+{
+    if( m_pErrObject != NULL )
+        m_pErrObject->setData( uno::makeAny( _number ), uno::Any(), uno::makeAny( _description ), uno::Any(), uno::Any() );
+}
+
diff --git a/basic/source/classes/sb.cxx b/basic/source/classes/sb.cxx
index b76453999212..946ecdd93d3c 100644
--- a/basic/source/classes/sb.cxx
+++ b/basic/source/classes/sb.cxx
@@ -1358,22 +1358,7 @@ BOOL StarBASIC::CError
 
     // Umsetzung des Codes fuer String-Transport in SFX-Error
     if( rMsg.Len() )
-        {
-            // very confusing, even though MakeErrorText sets up the error text
-            // seems that this is not used ( if rMsg already has content )
-            // In the case of VBA MakeErrorText also formats the error to be alittle more
-            // like vba ( adds an error number etc )
-            if ( SbiRuntime::isVBAEnabled() && ( code == SbERR_BASIC_COMPAT ) )
-            {
-                String aTmp = '\'';
-                aTmp += String::CreateFromInt32( SbxErrObject::getUnoErrObject()->getNumber() );
-                aTmp += String( RTL_CONSTASCII_USTRINGPARAM("\'\n") );
-                aTmp +=  GetSbData()->aErrMsg.Len() ? GetSbData()->aErrMsg : rMsg;
-        code = (ULONG)*new StringErrorInfo( code, aTmp );
-            }
-            else
         code = (ULONG)*new StringErrorInfo( code, String(rMsg) );
-        }
 
     SetErrorData( code, l, c1, c2 );
     GetSbData()->bCompiler = TRUE;
@@ -1403,22 +1388,22 @@ BOOL StarBASIC::RTError( SbError code, const String& rMsg, USHORT l, USHORT c1,
 
     // Umsetzung des Codes fuer String-Transport in SFX-Error
     if( rMsg.Len() )
+    {
+        // very confusing, even though MakeErrorText sets up the error text
+        // seems that this is not used ( if rMsg already has content )
+        // In the case of VBA MakeErrorText also formats the error to be alittle more
+        // like vba ( adds an error number etc )
+        if ( SbiRuntime::isVBAEnabled() && ( code == SbERR_BASIC_COMPAT ) )
         {
-            // very confusing, even though MakeErrorText sets up the error text
-            // seems that this is not used ( if rMsg already has content )
-            // In the case of VBA MakeErrorText also formats the error to be alittle more
-            // like vba ( adds an error number etc )
-            if ( SbiRuntime::isVBAEnabled() && ( code == SbERR_BASIC_COMPAT ) )
-            {
-                String aTmp = '\'';
-                aTmp += String::CreateFromInt32( SbxErrObject::getUnoErrObject()->getNumber() );
-                aTmp += String( RTL_CONSTASCII_USTRINGPARAM("\'\n") );
-                aTmp +=  GetSbData()->aErrMsg.Len() ? GetSbData()->aErrMsg : rMsg;
-        code = (ULONG)*new StringErrorInfo( code, aTmp );
-            }
-            else
-        code = (ULONG)*new StringErrorInfo( code, String(rMsg) );
+            String aTmp = '\'';
+            aTmp += String::CreateFromInt32( SbxErrObject::getUnoErrObject()->getNumber() );
+            aTmp += String( RTL_CONSTASCII_USTRINGPARAM("\'\n") );
+            aTmp +=  GetSbData()->aErrMsg.Len() ? GetSbData()->aErrMsg : rMsg;
+            code = (ULONG)*new StringErrorInfo( code, aTmp );
         }
+        else
+            code = (ULONG)*new StringErrorInfo( code, String(rMsg) );
+    }
 
     SetErrorData( code, l, c1, c2 );
     if( GetSbData()->aErrHdl.IsSet() )
diff --git a/basic/source/inc/errobject.hxx b/basic/source/inc/errobject.hxx
index 7a50d2435eb3..39e6e319caae 100644
--- a/basic/source/inc/errobject.hxx
+++ b/basic/source/inc/errobject.hxx
@@ -33,11 +33,20 @@
 
 class SbxErrObject : public SbUnoObject
 {
+    class ErrObject* m_pErrObject;
     com::sun::star::uno::Reference< ooo::vba::XErrObject > m_xErr;
+
     SbxErrObject( const String& aName_, const com::sun::star::uno::Any& aUnoObj_ );
     ~SbxErrObject();
+
+    class ErrObject* getImplErrObject( void )
+        { return m_pErrObject; }
+
 public:
     static SbxVariableRef getErrObject();
     static com::sun::star::uno::Reference< ooo::vba::XErrObject > getUnoErrObject();
+
+    void setNumberAndDescription( ::sal_Int32 _number, const ::rtl::OUString& _description )
+        throw (com::sun::star::uno::RuntimeException);
 };
 #endif
diff --git a/basic/source/inc/runtime.hxx b/basic/source/inc/runtime.hxx
index 4a3f38c51027..1d4f5ec41093 100644
--- a/basic/source/inc/runtime.hxx
+++ b/basic/source/inc/runtime.hxx
@@ -219,6 +219,8 @@ public:
 
     void Error( SbError );                      // trappable Error
     void Error( SbError, const String& rMsg );  // trappable Error mit Message
+    void ErrorVB( sal_Int32 nVBNumber, const String& rMsg );
+    void setErrorVB( sal_Int32 nVBNumber, const String& rMsg );
     void FatalError( SbError );                 // non-trappable Error
     void FatalError( SbError, const String& );  // non-trappable Error
     void Abort();                               // Abbruch mit aktuellem Fehlercode
@@ -441,10 +443,11 @@ public:
 
     SbiRuntime( SbModule*, SbMethod*, UINT32 );
    ~SbiRuntime();
-    void Error( SbError );                      // Fehler setzen, falls != 0
+    void Error( SbError, bool bVBATranslationAlreadyDone = false );     // Fehler setzen, falls != 0
     void Error( SbError, const String& );       // Fehler setzen, falls != 0
     void FatalError( SbError );                 // Fehlerbehandlung=Standard, Fehler setzen
     void FatalError( SbError, const String& );  // Fehlerbehandlung=Standard, Fehler setzen
+    static sal_Int32 translateErrorToVba( SbError nError, String& rMsg );
     void DumpPCode();
     BOOL Step();                    // Einzelschritt (ein Opcode)
     void Stop()            { bRun = FALSE;   }
diff --git a/basic/source/runtime/methods.cxx b/basic/source/runtime/methods.cxx
index 0a5a2b1736dd..4f7c70d688ef 100644
--- a/basic/source/runtime/methods.cxx
+++ b/basic/source/runtime/methods.cxx
@@ -271,17 +271,27 @@ RTLFUNC(Error)
             else
                 nErr = StarBASIC::GetSfxFromVBError( (USHORT)nCode );
         }
-        pBasic->MakeErrorText( nErr, aErrorMsg );
-                String tmpErrMsg(  pBasic->GetErrorText() );
-                // If this rtlfunc 'Error'  passed a errcode the same as the active Err Objects's
-                // current err then  return the description for the error message if it is set
-                // ( complicated isn't it ? )
-                if ( SbiRuntime::isVBAEnabled() && rPar.Count() > 1 );
-                {
-                    com::sun::star::uno::Reference< ooo::vba::XErrObject > xErrObj( SbxErrObject::getUnoErrObject() );
-                    if ( xErrObj.is() && xErrObj->getNumber() == nCode && xErrObj->getDescription().getLength() )
-                        tmpErrMsg = xErrObj->getDescription();
-                }
+
+        bool bVBA = SbiRuntime::isVBAEnabled();
+        String tmpErrMsg;
+        if( bVBA && aErrorMsg.Len() > 0 )
+        {
+            tmpErrMsg = aErrorMsg;
+        }
+        else
+        {
+            pBasic->MakeErrorText( nErr, aErrorMsg );
+            tmpErrMsg = pBasic->GetErrorText();
+        }
+        // If this rtlfunc 'Error'  passed a errcode the same as the active Err Objects's
+        // current err then  return the description for the error message if it is set
+        // ( complicated isn't it ? )
+        if ( bVBA && rPar.Count() > 1 )
+        {
+            com::sun::star::uno::Reference< ooo::vba::XErrObject > xErrObj( SbxErrObject::getUnoErrObject() );
+            if ( xErrObj.is() && xErrObj->getNumber() == nCode && xErrObj->getDescription().getLength() )
+                tmpErrMsg = xErrObj->getDescription();
+        }
         rPar.Get( 0 )->PutString( tmpErrMsg );
     }
 }
diff --git a/basic/source/runtime/props.cxx b/basic/source/runtime/props.cxx
index 9b4b35f551e2..cec74444e7a2 100644
--- a/basic/source/runtime/props.cxx
+++ b/basic/source/runtime/props.cxx
@@ -31,6 +31,7 @@
 #include "runtime.hxx"
 #include "stdobj.hxx"
 #include "rtlproto.hxx"
+#include "errobject.hxx"
 
 
 // Properties und Methoden legen beim Get (bWrite = FALSE) den Returnwert
@@ -50,14 +51,21 @@ RTLFUNC(Err)
     (void)pBasic;
     (void)bWrite;
 
-    if( bWrite )
+    if( SbiRuntime::isVBAEnabled() )
     {
-        INT32 nVal = rPar.Get( 0 )->GetLong();
-        if( nVal <= 65535L )
-            StarBASIC::Error( StarBASIC::GetSfxFromVBError( (USHORT) nVal ) );
+        rPar.Get( 0 )->PutObject( SbxErrObject::getErrObject() );
     }
     else
-        rPar.Get( 0 )->PutLong( StarBASIC::GetVBErrorCode( StarBASIC::GetErrBasic() ) );
+    {
+        if( bWrite )
+        {
+            INT32 nVal = rPar.Get( 0 )->GetLong();
+            if( nVal <= 65535L )
+                StarBASIC::Error( StarBASIC::GetSfxFromVBError( (USHORT) nVal ) );
+        }
+        else
+            rPar.Get( 0 )->PutLong( StarBASIC::GetVBErrorCode( StarBASIC::GetErrBasic() ) );
+    }
 }
 
 RTLFUNC(False)
diff --git a/basic/source/runtime/runtime.cxx b/basic/source/runtime/runtime.cxx
index 761955f6e877..295bfaa7f185 100644
--- a/basic/source/runtime/runtime.cxx
+++ b/basic/source/runtime/runtime.cxx
@@ -45,6 +45,8 @@
 #include "sbunoobj.hxx"
 #include "errobject.hxx"
 
+using namespace ::com::sun::star;
+
 bool SbiRuntime::isVBAEnabled()
 {
     bool result = false;
@@ -423,6 +425,35 @@ void SbiInstance::Error( SbError n, const String& rMsg )
     }
 }
 
+void SbiInstance::ErrorVB( sal_Int32 nVBNumber, const String& rMsg )
+{
+    if( !bWatchMode )
+    {
+        SbError n = StarBASIC::GetSfxFromVBError( static_cast< USHORT >( nVBNumber ) );
+        if ( !n )
+            n = nVBNumber; // force orig number, probably should have a specific table of vb ( localized ) errors
+
+        aErrorMsg = rMsg;
+        SbiRuntime::translateErrorToVba( n, aErrorMsg );
+
+        bool bVBATranslationAlreadyDone = true;
+        pRun->Error( SbERR_BASIC_COMPAT, bVBATranslationAlreadyDone );
+    }
+}
+
+void SbiInstance::setErrorVB( sal_Int32 nVBNumber, const String& rMsg )
+{
+    SbError n = StarBASIC::GetSfxFromVBError( static_cast< USHORT >( nVBNumber ) );
+    if( !n )
+        n = nVBNumber; // force orig number, probably should have a specific table of vb ( localized ) errors
+
+    aErrorMsg = rMsg;
+    SbiRuntime::translateErrorToVba( n, aErrorMsg );
+
+    nErr = n;
+}
+
+
 void SbiInstance::FatalError( SbError n )
 {
     pRun->FatalError( n );
@@ -792,33 +823,20 @@ BOOL SbiRuntime::Step()
     return bRun;
 }
 
-void SbiRuntime::Error( SbError n )
+void SbiRuntime::Error( SbError n, bool bVBATranslationAlreadyDone )
 {
     if( n )
     {
         nError = n;
-        if ( isVBAEnabled() )
+        if( isVBAEnabled() && !bVBATranslationAlreadyDone )
         {
             String aMsg = pInst->GetErrorMsg();
-            // If a message is defined use that ( in preference to
-            // the defined one for the error ) NB #TODO
-            // if there is an error defined it more than likely
-            // is not the one you want ( some are the same though )
-            // we really need a new vba compatible error list
-            if ( !aMsg.Len() )
-            {
-                                // is the error number vb or ( sb )
-                                SbError nTmp = StarBASIC::GetSfxFromVBError( n );
-                                if ( !nTmp )
-                                    nTmp = n;
-                StarBASIC::MakeErrorText( nTmp, aMsg );
-                aMsg =  StarBASIC::GetErrorText();
-                if ( !aMsg.Len() ) // no message for err no.
-                    // need localized resource here
-                    aMsg = String( RTL_CONSTASCII_USTRINGPARAM("Internal Object Error:") );
-            }
-            // no num? most likely then it *is* really a vba err
-            SbxErrObject::getUnoErrObject()->setNumber( ( StarBASIC::GetVBErrorCode( n ) == 0 ) ? n : StarBASIC::GetVBErrorCode( n ) );
+            sal_Int32 nVBAErrorNumber = translateErrorToVba( nError, aMsg );
+            SbxVariable* pSbxErrObjVar = SbxErrObject::getErrObject();
+            SbxErrObject* pGlobErr = static_cast< SbxErrObject* >( pSbxErrObjVar );
+            if( pGlobErr != NULL )
+                pGlobErr->setNumberAndDescription( nVBAErrorNumber, aMsg );
+
             pInst->aErrorMsg = aMsg;
             nError = SbERR_BASIC_COMPAT;
         }
@@ -854,6 +872,30 @@ void SbiRuntime::FatalError( SbError _errCode, const String& _details )
     Error( _errCode, _details );
 }
 
+sal_Int32 SbiRuntime::translateErrorToVba( SbError nError, String& rMsg )
+{
+    // If a message is defined use that ( in preference to
+    // the defined one for the error ) NB #TODO
+    // if there is an error defined it more than likely
+    // is not the one you want ( some are the same though )
+    // we really need a new vba compatible error list
+    if ( !rMsg.Len() )
+    {
+        // TEST, has to be vb here always
+        SbError nTmp = StarBASIC::GetSfxFromVBError( nError );
+        DBG_ASSERT( nTmp, "No VB error!" );
+
+        StarBASIC::MakeErrorText( nError, rMsg );
+        rMsg = StarBASIC::GetErrorText();
+        if ( !rMsg.Len() ) // no message for err no, need localized resource here
+            rMsg = String( RTL_CONSTASCII_USTRINGPARAM("Internal Object Error:") );
+    }
+    // no num? most likely then it *is* really a vba err
+    USHORT nVBErrorCode = StarBASIC::GetVBErrorCode( nError );
+    sal_Int32 nVBAErrorNumber = ( nVBErrorCode == 0 ) ? nError : nVBErrorCode;
+    return nVBAErrorNumber;
+}
+
 //////////////////////////////////////////////////////////////////////////
 //
 //  Parameter, Locals, Caller
diff --git a/basic/source/runtime/stdobj.cxx b/basic/source/runtime/stdobj.cxx
index fd4cacc646d5..13bc8810144a 100644
--- a/basic/source/runtime/stdobj.cxx
+++ b/basic/source/runtime/stdobj.cxx
@@ -33,7 +33,6 @@
 #include <basic/sbstdobj.hxx>
 #include "rtlproto.hxx"
 #include "sbintern.hxx"
-#include "errobject.hxx"
 
 // Das nArgs-Feld eines Tabelleneintrags ist wie folgt verschluesselt:
 // Zur Zeit wird davon ausgegangen, dass Properties keine Parameter
@@ -231,7 +230,7 @@ static Methods aMethods[] = {
 { "EOF",            SbxBOOL,      1 | _FUNCTION, RTLNAME(EOF),0             },
   { "Channel",      SbxINTEGER, 0,NULL,0 },
 { "Erl",            SbxLONG,          _ROPROP,   RTLNAME( Erl ),0           },
-{ "Err",            SbxLONG,          _RWPROP,   RTLNAME( Err ),0           },
+{ "Err",            SbxVARIANT,       _RWPROP,   RTLNAME( Err ),0           },
 { "Error",          SbxSTRING,    1 | _FUNCTION, RTLNAME( Error ),0         },
   { "code",         SbxLONG, 0,NULL,0 },
 { "Exp",            SbxDOUBLE,    1 | _FUNCTION, RTLNAME(Exp),0             },
@@ -653,11 +652,6 @@ SbiStdObject::~SbiStdObject()
 
 SbxVariable* SbiStdObject::Find( const String& rName, SbxClassType t )
 {
-    // #TODO #FIXME hack for substituting ooo-basic Err with vba-ish
-    // ErrObject object
-    static String sErr( RTL_CONSTASCII_USTRINGPARAM("Err") );
-    if (  SbiRuntime::isVBAEnabled() && rName.EqualsIgnoreCaseAscii( sErr ) )
-        return SbxErrObject::getErrObject();
     // Bereits eingetragen?
     SbxVariable* pVar = SbxObject::Find( rName, t );
     if( !pVar )