ab75: #i110417# initial ( untested ) implementation

4 files changed, 49 insertions, 1 deletions

diff --git a/basic/source/runtime/runtime.cxx b/basic/source/runtime/runtime.cxx
index 52aa76e2f2df..75ff47c73486 100644
--- a/basic/source/runtime/runtime.cxx
+++ b/basic/source/runtime/runtime.cxx
@@ -43,6 +43,7 @@
 #include <comphelper/processfactory.hxx>
 #include <com/sun/star/container/XEnumerationAccess.hpp>
 #include "sbunoobj.hxx"
+#include "errobject.hxx"
 
 bool SbiRuntime::isVBAEnabled()
 {
@@ -794,7 +795,38 @@ BOOL SbiRuntime::Step()
 void SbiRuntime::Error( SbError n )
 {
     if( n )
+    {
         nError = n;
+        if ( isVBAEnabled() )
+        {
+            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() )
+            {
+                StarBASIC::MakeErrorText( n, 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 ) );
+            SbxErrObject::getUnoErrObject()->setDescription( aMsg );
+
+            // prepend an error number to the message.
+            String aTmp = '\'';
+                        aTmp += String::CreateFromInt32( SbxErrObject::getUnoErrObject()->getNumber() );
+                        aTmp += String( RTL_CONSTASCII_USTRINGPARAM("\'\n") );
+                        aTmp += aMsg;
+
+            pInst->aErrorMsg = aTmp;
+            nError = SbERR_BASIC_COMPAT;
+        }
+    }
 }
 
 void SbiRuntime::Error( SbError _errCode, const String& _details )
diff --git a/basic/source/runtime/stdobj.cxx b/basic/source/runtime/stdobj.cxx
index c0b4ffa3cd59..d2585501c826 100644
--- a/basic/source/runtime/stdobj.cxx
+++ b/basic/source/runtime/stdobj.cxx
@@ -33,6 +33,7 @@
 #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
@@ -652,6 +653,11 @@ 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 (  rName.EqualsIgnoreCaseAscii( sErr ) )
+        return SbxErrObject::getErrObject();
     // Bereits eingetragen?
     SbxVariable* pVar = SbxObject::Find( rName, t );
     if( !pVar )
diff --git a/basic/source/runtime/step0.cxx b/basic/source/runtime/step0.cxx
index 33df854a4499..b432d1851ed5 100644
--- a/basic/source/runtime/step0.cxx
+++ b/basic/source/runtime/step0.cxx
@@ -30,6 +30,7 @@
 #include <vcl/msgbox.hxx>
 #include <tools/fsys.hxx>
 
+#include "errobject.hxx"
 #include "runtime.hxx"
 #include "sbintern.hxx"
 #include "iosys.hxx"
@@ -1116,6 +1117,7 @@ void SbiRuntime::StepSTDERROR()
     pInst->nErr = 0L;
     pInst->nErl = 0;
     nError = 0L;
+    SbxErrObject::getUnoErrObject()->Clear();
 }
 
 void SbiRuntime::StepNOERROR()
@@ -1124,6 +1126,7 @@ void SbiRuntime::StepNOERROR()
     pInst->nErr = 0L;
     pInst->nErl = 0;
     nError = 0L;
+    SbxErrObject::getUnoErrObject()->Clear();
     bError = FALSE;
 }
 
@@ -1132,6 +1135,9 @@ void SbiRuntime::StepNOERROR()
 void SbiRuntime::StepLEAVE()
 {
     bRun = FALSE;
+        // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
+    if ( bInError && pError )
+        SbxErrObject::getUnoErrObject()->Clear();
 }
 
 void SbiRuntime::StepCHANNEL()      // TOS = Kanalnummer
@@ -1265,6 +1271,6 @@ void SbiRuntime::StepERROR()
     SbxVariableRef refCode = PopVar();
     USHORT n = refCode->GetUShort();
     SbError error = StarBASIC::GetSfxFromVBError( n );
-    Error( error );
+    pInst->Error( error );
 }
 
diff --git a/basic/source/runtime/step1.cxx b/basic/source/runtime/step1.cxx
index 399257cf6ad3..2161f3d1dd09 100644
--- a/basic/source/runtime/step1.cxx
+++ b/basic/source/runtime/step1.cxx
@@ -35,6 +35,7 @@
 #include "iosys.hxx"
 #include "image.hxx"
 #include "sbunoobj.hxx"
+#include "errobject.hxx"
 
 bool checkUnoObjectType( SbUnoObject* refVal,
     const String& aClass );
@@ -360,6 +361,7 @@ void SbiRuntime::StepERRHDL( UINT32 nOp1 )
     pInst->nErr = 0;
     pInst->nErl = 0;
     nError = 0;
+    SbxErrObject::getUnoErrObject()->Clear();
 }
 
 // Resume nach Fehlern (+0=statement, 1=next or Label)
@@ -380,6 +382,8 @@ void SbiRuntime::StepRESUME( UINT32 nOp1 )
     }
     else
         pCode = pErrStmnt;
+    if ( pError ) // current in error handler ( and got a Resume Next statment )
+        SbxErrObject::getUnoErrObject()->Clear();
 
     if( nOp1 > 1 )
         StepJUMP( nOp1 );