1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
3 * This file is part of the LibreOffice project.
5 * This Source Code Form is subject to the terms of the Mozilla Public
6 * License, v. 2.0. If a copy of the MPL was not distributed with this
7 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
9 * This file incorporates work covered by the following license notice:
11 * Licensed to the Apache Software Foundation (ASF) under one or more
12 * contributor license agreements. See the NOTICE file distributed
13 * with this work for additional information regarding copyright
14 * ownership. The ASF licenses this file to you under the Apache
15 * License, Version 2.0 (the "License"); you may not use this file
16 * except in compliance with the License. You may obtain a copy of
17 * the License at http://www.apache.org/licenses/LICENSE-2.0 .
23 #include <string_view>
24 #include <unordered_map>
26 #include <com/sun/star/beans/XPropertySet.hpp>
27 #include <com/sun/star/container/XEnumerationAccess.hpp>
28 #include <com/sun/star/container/XIndexAccess.hpp>
29 #include <com/sun/star/script/XDefaultMethod.hpp>
30 #include <com/sun/star/uno/Any.hxx>
31 #include <com/sun/star/util/SearchAlgorithms2.hpp>
33 #include <comphelper/processfactory.hxx>
34 #include <comphelper/string.hxx>
35 #include <o3tl/safeint.hxx>
36 #include <sal/log.hxx>
38 #include <tools/wldcrd.hxx>
39 #include <tools/diagnose_ex.h>
41 #include <vcl/svapp.hxx>
42 #include <vcl/settings.hxx>
44 #include <rtl/instance.hxx>
45 #include <rtl/math.hxx>
46 #include <rtl/ustrbuf.hxx>
47 #include <rtl/character.hxx>
49 #include <svl/zforlist.hxx>
51 #include <i18nutil/searchopt.hxx>
52 #include <unotools/syslocale.hxx>
53 #include <unotools/textsearch.hxx>
55 #include <basic/sbuno.hxx>
57 #include <codegen.hxx>
58 #include "comenumwrapper.hxx"
59 #include "ddectrl.hxx"
61 #include <errobject.hxx>
64 #include <opcodes.hxx>
65 #include <runtime.hxx>
67 #include <sbintern.hxx>
69 #include <sbunoobj.hxx>
70 #include <basic/codecompletecache.hxx>
73 using com::sun::star::uno::Reference
;
75 using namespace com::sun::star::uno
;
76 using namespace com::sun::star::container
;
77 using namespace com::sun::star::lang
;
78 using namespace com::sun::star::beans
;
79 using namespace com::sun::star::script
;
81 using namespace ::com::sun::star
;
83 static void lcl_clearImpl( SbxVariableRef
const & refVar
, SbxDataType
const & eType
);
84 static void lcl_eraseImpl( SbxVariableRef
const & refVar
, bool bVBAEnabled
);
88 class ScopedWritableGuard
91 ScopedWritableGuard(const SbxVariableRef
& rVar
, bool bMakeWritable
)
93 , m_bReset(bMakeWritable
&& !rVar
->CanWrite())
97 m_rVar
->SetFlag(SbxFlagBits::Write
);
100 ~ScopedWritableGuard()
104 m_rVar
->ResetFlag(SbxFlagBits::Write
);
109 SbxVariableRef m_rVar
;
114 bool SbiRuntime::isVBAEnabled()
116 bool bResult
= false;
117 SbiInstance
* pInst
= GetSbData()->pInst
;
118 if ( pInst
&& GetSbData()->pInst
->pRun
)
119 bResult
= pInst
->pRun
->bVBAEnabled
;
123 void StarBASIC::SetVBAEnabled( bool bEnabled
)
127 bVBAEnabled
= bEnabled
;
131 bool StarBASIC::isVBAEnabled() const
135 if( SbiRuntime::isVBAEnabled() )
142 struct SbiArgv
{ // Argv stack:
143 SbxArrayRef refArgv
; // Argv
146 SbiArgv(SbxArrayRef
const & refArgv_
, short nArgc_
) :
151 struct SbiGosub
{ // GOSUB-Stack:
152 const sal_uInt8
* pCode
; // Return-Pointer
153 sal_uInt16 nStartForLvl
; // #118235: For Level in moment of gosub
155 SbiGosub(const sal_uInt8
* pCode_
, sal_uInt16 nStartForLvl_
) :
157 nStartForLvl(nStartForLvl_
) {}
160 SbiRuntime::pStep0
SbiRuntime::aStep0
[] = { // all opcodes without operands
161 &SbiRuntime::StepNOP
,
162 &SbiRuntime::StepEXP
,
163 &SbiRuntime::StepMUL
,
164 &SbiRuntime::StepDIV
,
165 &SbiRuntime::StepMOD
,
166 &SbiRuntime::StepPLUS
,
167 &SbiRuntime::StepMINUS
,
168 &SbiRuntime::StepNEG
,
175 &SbiRuntime::StepIDIV
,
176 &SbiRuntime::StepAND
,
178 &SbiRuntime::StepXOR
,
179 &SbiRuntime::StepEQV
,
180 &SbiRuntime::StepIMP
,
181 &SbiRuntime::StepNOT
,
182 &SbiRuntime::StepCAT
,
184 &SbiRuntime::StepLIKE
,
187 &SbiRuntime::StepARGC
, // establish new Argv
188 &SbiRuntime::StepARGV
, // TOS ==> current Argv
189 &SbiRuntime::StepINPUT
, // Input ==> TOS
190 &SbiRuntime::StepLINPUT
, // Line Input ==> TOS
191 &SbiRuntime::StepGET
, // touch TOS
192 &SbiRuntime::StepSET
, // save object TOS ==> TOS-1
193 &SbiRuntime::StepPUT
, // TOS ==> TOS-1
194 &SbiRuntime::StepPUTC
, // TOS ==> TOS-1, then ReadOnly
195 &SbiRuntime::StepDIM
, // DIM
196 &SbiRuntime::StepREDIM
, // REDIM
197 &SbiRuntime::StepREDIMP
, // REDIM PRESERVE
198 &SbiRuntime::StepERASE
, // delete TOS
200 &SbiRuntime::StepSTOP
, // program end
201 &SbiRuntime::StepINITFOR
, // initialize FOR-Variable
202 &SbiRuntime::StepNEXT
, // increment FOR-Variable
203 &SbiRuntime::StepCASE
, // beginning CASE
204 &SbiRuntime::StepENDCASE
, // end CASE
205 &SbiRuntime::StepSTDERROR
, // standard error handling
206 &SbiRuntime::StepNOERROR
, // no error handling
207 &SbiRuntime::StepLEAVE
, // leave UP
209 &SbiRuntime::StepCHANNEL
, // TOS = channel number
210 &SbiRuntime::StepPRINT
, // print TOS
211 &SbiRuntime::StepPRINTF
, // print TOS in field
212 &SbiRuntime::StepWRITE
, // write TOS
213 &SbiRuntime::StepRENAME
, // Rename Tos+1 to Tos
214 &SbiRuntime::StepPROMPT
, // define Input Prompt from TOS
215 &SbiRuntime::StepRESTART
, // Set restart point
216 &SbiRuntime::StepCHANNEL0
, // set E/A-channel 0
217 &SbiRuntime::StepEMPTY
, // empty expression on stack
218 &SbiRuntime::StepERROR
, // TOS = error code
219 &SbiRuntime::StepLSET
, // save object TOS ==> TOS-1
220 &SbiRuntime::StepRSET
, // save object TOS ==> TOS-1
221 &SbiRuntime::StepREDIMP_ERASE
,// Copy array object for REDIMP
222 &SbiRuntime::StepINITFOREACH
,// Init for each loop
223 &SbiRuntime::StepVBASET
,// vba-like set statement
224 &SbiRuntime::StepERASE_CLEAR
,// vba-like set statement
225 &SbiRuntime::StepARRAYACCESS
,// access TOS as array
226 &SbiRuntime::StepBYVAL
, // access TOS as array
229 SbiRuntime::pStep1
SbiRuntime::aStep1
[] = { // all opcodes with one operand
230 &SbiRuntime::StepLOADNC
, // loading a numeric constant (+ID)
231 &SbiRuntime::StepLOADSC
, // loading a string constant (+ID)
232 &SbiRuntime::StepLOADI
, // Immediate Load (+value)
233 &SbiRuntime::StepARGN
, // save a named Args in Argv (+StringID)
234 &SbiRuntime::StepPAD
, // bring string to a definite length (+length)
236 &SbiRuntime::StepJUMP
, // jump (+Target)
237 &SbiRuntime::StepJUMPT
, // evaluate TOS, conditional jump (+Target)
238 &SbiRuntime::StepJUMPF
, // evaluate TOS, conditional jump (+Target)
239 &SbiRuntime::StepONJUMP
, // evaluate TOS, jump into JUMP-table (+MaxVal)
240 &SbiRuntime::StepGOSUB
, // UP-call (+Target)
241 &SbiRuntime::StepRETURN
, // UP-return (+0 or Target)
242 &SbiRuntime::StepTESTFOR
, // check FOR-variable, increment (+Endlabel)
243 &SbiRuntime::StepCASETO
, // Tos+1 <= Case <= Tos), 2xremove (+Target)
244 &SbiRuntime::StepERRHDL
, // error handler (+Offset)
245 &SbiRuntime::StepRESUME
, // resume after errors (+0 or 1 or Label)
247 &SbiRuntime::StepCLOSE
, // (+channel/0)
248 &SbiRuntime::StepPRCHAR
, // (+char)
250 &SbiRuntime::StepSETCLASS
, // check set + class names (+StringId)
251 &SbiRuntime::StepTESTCLASS
, // Check TOS class (+StringId)
252 &SbiRuntime::StepLIB
, // lib for declare-call (+StringId)
253 &SbiRuntime::StepBASED
, // TOS is incremented by BASE, BASE is pushed before
254 &SbiRuntime::StepARGTYP
, // convert last parameter in Argv (+Type)
255 &SbiRuntime::StepVBASETCLASS
,// vba-like set statement
258 SbiRuntime::pStep2
SbiRuntime::aStep2
[] = {// all opcodes with two operands
259 &SbiRuntime::StepRTL
, // load from RTL (+StringID+Typ)
260 &SbiRuntime::StepFIND
, // load (+StringID+Typ)
261 &SbiRuntime::StepELEM
, // load element (+StringID+Typ)
262 &SbiRuntime::StepPARAM
, // Parameter (+Offset+Typ)
264 &SbiRuntime::StepCALL
, // Declare-Call (+StringID+Typ)
265 &SbiRuntime::StepCALLC
, // CDecl-Declare-Call (+StringID+Typ)
266 &SbiRuntime::StepCASEIS
, // Case-Test (+Test-Opcode+False-Target)
268 &SbiRuntime::StepSTMNT
, // beginning of a statement (+Line+Col)
270 &SbiRuntime::StepOPEN
, // (+StreamMode+Flags)
272 &SbiRuntime::StepLOCAL
, // define local variable (+StringId+Typ)
273 &SbiRuntime::StepPUBLIC
, // module global variable (+StringID+Typ)
274 &SbiRuntime::StepGLOBAL
, // define global variable (+StringID+Typ)
275 &SbiRuntime::StepCREATE
, // create object (+StringId+StringId)
276 &SbiRuntime::StepSTATIC
, // static variable (+StringId+StringId)
277 &SbiRuntime::StepTCREATE
, // user-defined objects (+StringId+StringId)
278 &SbiRuntime::StepDCREATE
, // create object-array (+StringID+StringID)
279 &SbiRuntime::StepGLOBAL_P
, // define global variable which is not overwritten
280 // by the Basic on a restart (+StringID+Typ)
281 &SbiRuntime::StepFIND_G
, // finds global variable with special treatment because of _GLOBAL_P
282 &SbiRuntime::StepDCREATE_REDIMP
, // redimension object array (+StringID+StringID)
283 &SbiRuntime::StepFIND_CM
, // Search inside a class module (CM) to enable global search in time
284 &SbiRuntime::StepPUBLIC_P
, // Search inside a class module (CM) to enable global search in time
285 &SbiRuntime::StepFIND_STATIC
, // Search inside a class module (CM) to enable global search in time
291 SbiRTLData::SbiRTLData()
293 nDirFlags
= SbAttributes::NONE
;
297 SbiRTLData::~SbiRTLData()
303 // 16.10.96: #31460 new concept for StepInto/Over/Out
304 // The decision whether StepPoint shall be called is done with the help of
305 // the CallLevel. It's stopped when the current CallLevel is <= nBreakCallLvl.
306 // The current CallLevel can never be smaller than 1, as it's also incremented
307 // during the call of a method (also main). Therefore a BreakCallLvl from 0
308 // means that the program isn't stopped at all.
309 // (also have a look at: step2.cxx, SbiRuntime::StepSTMNT() )
312 void SbiInstance::CalcBreakCallLevel( BasicDebugFlags nFlags
)
315 nFlags
&= ~BasicDebugFlags::Break
;
318 if (nFlags
== BasicDebugFlags::StepInto
) {
319 nRet
= nCallLvl
+ 1; // CallLevel+1 is also stopped
320 } else if (nFlags
== (BasicDebugFlags::StepOver
| BasicDebugFlags::StepInto
)) {
321 nRet
= nCallLvl
; // current CallLevel is stopped
322 } else if (nFlags
== BasicDebugFlags::StepOut
) {
323 nRet
= nCallLvl
- 1; // smaller CallLevel is stopped
325 // Basic-IDE returns 0 instead of BasicDebugFlags::Continue, so also default=continue
326 nRet
= 0; // CallLevel is always > 0 -> no StepPoint
328 nBreakCallLvl
= nRet
; // take result
331 SbiInstance::SbiInstance( StarBASIC
* p
)
332 : pIosys(new SbiIoSystem
)
333 , pDdeCtrl(new SbiDdeControl
)
335 , meFormatterLangType(LANGUAGE_DONTKNOW
)
336 , meFormatterDateOrder(DateOrder::YMD
)
343 , bCompatibility(false)
350 SbiInstance::~SbiInstance()
354 SbiRuntime
* p
= pRun
->pNext
;
361 int nSize
= ComponentVector
.size();
364 for( int i
= nSize
- 1 ; i
>= 0 ; --i
)
366 Reference
< XComponent
> xDlgComponent
= ComponentVector
[i
];
367 if( xDlgComponent
.is() )
368 xDlgComponent
->dispose();
372 catch( const Exception
& )
374 TOOLS_WARN_EXCEPTION("basic", "SbiInstance::~SbiInstance: caught an exception while disposing the components" );
378 SbiDllMgr
* SbiInstance::GetDllMgr()
382 pDllMgr
.reset(new SbiDllMgr
);
384 return pDllMgr
.get();
387 // #39629 create NumberFormatter with the help of a static method now
388 std::shared_ptr
<SvNumberFormatter
> const & SbiInstance::GetNumberFormatter()
390 LanguageType eLangType
= Application::GetSettings().GetLanguageTag().getLanguageType();
391 SvtSysLocale aSysLocale
;
392 DateOrder eDate
= aSysLocale
.GetLocaleData().getDateOrder();
393 if( pNumberFormatter
)
395 if( eLangType
!= meFormatterLangType
||
396 eDate
!= meFormatterDateOrder
)
398 pNumberFormatter
.reset();
401 meFormatterLangType
= eLangType
;
402 meFormatterDateOrder
= eDate
;
403 if( !pNumberFormatter
)
405 pNumberFormatter
= PrepareNumberFormatter( nStdDateIdx
, nStdTimeIdx
, nStdDateTimeIdx
,
406 &meFormatterLangType
, &meFormatterDateOrder
);
408 return pNumberFormatter
;
411 // #39629 offer NumberFormatter static too
412 std::shared_ptr
<SvNumberFormatter
> SbiInstance::PrepareNumberFormatter( sal_uInt32
&rnStdDateIdx
,
413 sal_uInt32
&rnStdTimeIdx
, sal_uInt32
&rnStdDateTimeIdx
,
414 LanguageType
const * peFormatterLangType
, DateOrder
const * peFormatterDateOrder
)
416 LanguageType eLangType
;
417 if( peFormatterLangType
)
419 eLangType
= *peFormatterLangType
;
423 eLangType
= Application::GetSettings().GetLanguageTag().getLanguageType();
426 if( peFormatterDateOrder
)
428 eDate
= *peFormatterDateOrder
;
432 SvtSysLocale aSysLocale
;
433 eDate
= aSysLocale
.GetLocaleData().getDateOrder();
436 std::shared_ptr
<SvNumberFormatter
> pNumberFormatter
=
437 std::make_shared
<SvNumberFormatter
>( comphelper::getProcessComponentContext(), eLangType
);
439 // Several parser methods pass SvNumberFormatter::IsNumberFormat() a number
440 // format index to parse against. Tell the formatter the proper date
441 // evaluation order, which also determines the date acceptance patterns to
442 // use if a format was passed. NF_EVALDATEFORMAT_FORMAT restricts to the
443 // format's locale's date patterns/order (no init/system locale match
444 // tried) and falls back to NF_EVALDATEFORMAT_INTL if no specific (i.e. 0)
445 // (or an unknown) format index was passed.
446 pNumberFormatter
->SetEvalDateFormat( NF_EVALDATEFORMAT_FORMAT
);
448 sal_Int32 nCheckPos
= 0;
449 SvNumFormatType nType
;
450 rnStdTimeIdx
= pNumberFormatter
->GetStandardFormat( SvNumFormatType::TIME
, eLangType
);
452 // the formatter's standard templates have only got a two-digit date
453 // -> registering an own format
455 // HACK, because the numberformatter doesn't swap the place holders
456 // for month, day and year according to the system setting.
457 // Problem: Print Year(Date) under engl. BS
458 // also have a look at: basic/source/sbx/sbxdate.cxx
464 case DateOrder::MDY
: aDateStr
= "MM/DD/YYYY"; break;
465 case DateOrder::DMY
: aDateStr
= "DD/MM/YYYY"; break;
466 case DateOrder::YMD
: aDateStr
= "YYYY/MM/DD"; break;
468 OUString
aStr( aDateStr
); // PutandConvertEntry() modifies string!
469 pNumberFormatter
->PutandConvertEntry( aStr
, nCheckPos
, nType
,
470 rnStdDateIdx
, LANGUAGE_ENGLISH_US
, eLangType
, true);
472 aDateStr
+= " HH:MM:SS";
474 pNumberFormatter
->PutandConvertEntry( aStr
, nCheckPos
, nType
,
475 rnStdDateTimeIdx
, LANGUAGE_ENGLISH_US
, eLangType
, true);
476 return pNumberFormatter
;
480 // Let engine run. If Flags == BasicDebugFlags::Continue, take Flags over
482 void SbiInstance::Stop()
484 for( SbiRuntime
* p
= pRun
; p
; p
= p
->pNext
)
490 // Allows Basic IDE to set watch mode to suppress errors
491 static bool bWatchMode
= false;
493 void setBasicWatchMode( bool bOn
)
498 void SbiInstance::Error( ErrCode n
)
500 Error( n
, OUString() );
503 void SbiInstance::Error( ErrCode n
, const OUString
& rMsg
)
512 void SbiInstance::ErrorVB( sal_Int32 nVBNumber
, const OUString
& rMsg
)
516 ErrCode n
= StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16
>( nVBNumber
) );
519 n
= ErrCode(nVBNumber
); // force orig number, probably should have a specific table of vb ( localized ) errors
522 SbiRuntime::translateErrorToVba( n
, aErrorMsg
);
524 pRun
->Error( ERRCODE_BASIC_COMPAT
, true/*bVBATranslationAlreadyDone*/ );
528 void SbiInstance::setErrorVB( sal_Int32 nVBNumber
)
530 ErrCode n
= StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16
>( nVBNumber
) );
533 n
= ErrCode(nVBNumber
); // force orig number, probably should have a specific table of vb ( localized ) errors
535 aErrorMsg
= OUString();
536 SbiRuntime::translateErrorToVba( n
, aErrorMsg
);
542 void SbiInstance::FatalError( ErrCode n
)
544 pRun
->FatalError( n
);
547 void SbiInstance::FatalError( ErrCode _errCode
, const OUString
& _details
)
549 pRun
->FatalError( _errCode
, _details
);
552 void SbiInstance::Abort()
554 StarBASIC
* pErrBasic
= GetCurrentBasic( pBasic
);
555 pErrBasic
->RTError( nErr
, aErrorMsg
, pRun
->nLine
, pRun
->nCol1
, pRun
->nCol2
);
559 // can be unequal to pRTBasic
560 StarBASIC
* GetCurrentBasic( StarBASIC
* pRTBasic
)
562 StarBASIC
* pCurBasic
= pRTBasic
;
563 SbModule
* pActiveModule
= StarBASIC::GetActiveModule();
566 SbxObject
* pParent
= pActiveModule
->GetParent();
567 if (StarBASIC
*pBasic
= dynamic_cast<StarBASIC
*>(pParent
))
573 SbModule
* SbiInstance::GetActiveModule()
577 return pRun
->GetModule();
585 SbMethod
* SbiInstance::GetCaller( sal_uInt16 nLevel
)
587 SbiRuntime
* p
= pRun
;
588 while( nLevel
-- && p
)
592 return p
? p
->GetCaller() : nullptr;
597 // Attention: pMeth can also be NULL (on a call of the init-code)
599 SbiRuntime::SbiRuntime( SbModule
* pm
, SbMethod
* pe
, sal_uInt32 nStart
)
600 : rBasic( *static_cast<StarBASIC
*>(pm
->pParent
) ), pInst( GetSbData()->pInst
),
601 pMod( pm
), pMeth( pe
), pImg( pMod
->pImage
), mpExtCaller(nullptr), m_nLastTime(0)
603 nFlags
= pe
? pe
->GetDebugFlags() : BasicDebugFlags::NONE
;
604 pIosys
= pInst
->GetIoSystem();
612 pStmnt
= reinterpret_cast<const sal_uInt8
*>(pImg
->GetCode()) + nStart
;
622 nError
= ERRCODE_NONE
;
625 refExprStk
= new SbxArray
;
626 SetVBAEnabled( pMod
->IsVBACompat() );
627 SetParameters( pe
? pe
->GetParameters() : nullptr );
630 SbiRuntime::~SbiRuntime()
636 void SbiRuntime::SetVBAEnabled(bool bEnabled
)
638 bVBAEnabled
= bEnabled
;
643 mpExtCaller
= pMeth
->mCaller
;
648 mpExtCaller
= nullptr;
652 // tdf#79426, tdf#125180 - adds the information about a missing parameter
653 void SbiRuntime::SetIsMissing( SbxVariable
* pVar
)
655 SbxInfo
* pInfo
= pVar
->GetInfo() ? pVar
->GetInfo() : new SbxInfo();
656 pInfo
->AddParam( pVar
->GetName(), SbxMISSING
, pVar
->GetFlags() );
657 pVar
->SetInfo( pInfo
);
660 // tdf#79426, tdf#125180 - checks if a variable contains the information about a missing parameter
661 bool SbiRuntime::IsMissing( SbxVariable
* pVar
, sal_uInt16 nIdx
)
663 return pVar
->GetInfo() && pVar
->GetInfo()->GetParam( nIdx
) && pVar
->GetInfo()->GetParam( nIdx
)->eType
& SbxMISSING
;
666 // Construction of the parameter list. All ByRef-parameters are directly
667 // taken over; copies of ByVal-parameters are created. If a particular
668 // data type is requested, it is converted.
670 void SbiRuntime::SetParameters( SbxArray
* pParams
)
672 refParams
= new SbxArray
;
673 // for the return value
674 refParams
->Put32( pMeth
, 0 );
676 SbxInfo
* pInfo
= pMeth
? pMeth
->GetInfo() : nullptr;
677 sal_uInt32 nParamCount
= pParams
? pParams
->Count32() : 1;
678 assert(nParamCount
<= std::numeric_limits
<sal_uInt16
>::max());
679 if( nParamCount
> 1 )
681 for( sal_uInt32 i
= 1 ; i
< nParamCount
; i
++ )
683 const SbxParamInfo
* p
= pInfo
? pInfo
->GetParam( sal::static_int_cast
<sal_uInt16
>(i
) ) : nullptr;
685 // #111897 ParamArray
686 if( p
&& (p
->nUserData
& PARAM_INFO_PARAMARRAY
) != 0 )
688 SbxDimArray
* pArray
= new SbxDimArray( SbxVARIANT
);
689 sal_uInt32 nParamArrayParamCount
= nParamCount
- i
;
690 pArray
->unoAddDim32( 0, nParamArrayParamCount
- 1 );
691 for (sal_uInt32 j
= i
; j
< nParamCount
; ++j
)
693 SbxVariable
* v
= pParams
->Get32( j
);
694 sal_Int32 aDimIndex
[1];
695 aDimIndex
[0] = j
- i
;
696 pArray
->Put32(v
, aDimIndex
);
698 SbxVariable
* pArrayVar
= new SbxVariable( SbxVARIANT
);
699 pArrayVar
->SetFlag( SbxFlagBits::ReadWrite
);
700 pArrayVar
->PutObject( pArray
);
701 refParams
->Put32( pArrayVar
, i
);
703 // Block ParamArray for missing parameter
708 SbxVariable
* v
= pParams
->Get32( i
);
709 // methods are always byval!
710 bool bByVal
= dynamic_cast<const SbxMethod
*>(v
) != nullptr;
711 SbxDataType t
= v
->GetType();
712 bool bTargetTypeIsArray
= false;
715 bByVal
|= ( p
->eType
& SbxBYREF
) == 0;
716 // tdf#79426, tdf#125180 - don't convert missing arguments to the requested parameter type
717 if ( !IsMissing( v
, 1 ) )
719 t
= static_cast<SbxDataType
>( p
->eType
& 0x0FFF );
722 if( !bByVal
&& t
!= SbxVARIANT
&&
723 (!v
->IsFixed() || static_cast<SbxDataType
>(v
->GetType() & 0x0FFF ) != t
) )
728 bTargetTypeIsArray
= (p
->nUserData
& PARAM_INFO_WITHBRACKETS
) != 0;
732 // tdf#79426, tdf#125180 - don't convert missing arguments to the requested parameter type
733 if( bTargetTypeIsArray
&& !IsMissing( v
, 1 ) )
737 SbxVariable
* v2
= new SbxVariable( t
);
738 v2
->SetFlag( SbxFlagBits::ReadWrite
);
739 // tdf#79426, tdf#125180 - if parameter was missing, readd additional information about a missing parameter
740 if ( IsMissing( v
, 1 ) )
745 refParams
->Put32( v2
, i
);
749 // tdf#79426, tdf#125180 - don't convert missing arguments to the requested parameter type
750 if( t
!= SbxVARIANT
&& !IsMissing( v
, 1 ) && t
!= ( v
->GetType() & 0x0FFF ) )
752 if( p
&& (p
->eType
& SbxARRAY
) )
754 Error( ERRCODE_BASIC_CONVERSION
);
761 refParams
->Put32( v
, i
);
765 refParams
->PutAlias32( p
->aName
, i
);
770 // ParamArray for missing parameter
774 // #111897 Check first missing parameter for ParamArray
775 const SbxParamInfo
* p
= pInfo
->GetParam(sal::static_int_cast
<sal_uInt16
>(nParamCount
));
776 if( p
&& (p
->nUserData
& PARAM_INFO_PARAMARRAY
) != 0 )
778 SbxDimArray
* pArray
= new SbxDimArray( SbxVARIANT
);
779 pArray
->unoAddDim32( 0, -1 );
780 SbxVariable
* pArrayVar
= new SbxVariable( SbxVARIANT
);
781 pArrayVar
->SetFlag( SbxFlagBits::ReadWrite
);
782 pArrayVar
->PutObject( pArray
);
783 refParams
->Put32( pArrayVar
, nParamCount
);
790 bool SbiRuntime::Step()
794 // in any case check casually!
795 if( !( ++nOps
& 0xF ) && pInst
->IsReschedule() )
797 sal_uInt32 nTime
= osl_getGlobalTimer();
798 if (nTime
- m_nLastTime
> 5 ) // 20 ms
800 Application::Reschedule();
805 // #i48868 blocked by next call level?
808 if( pInst
->IsReschedule() )
810 Application::Reschedule();
814 SbiOpcode eOp
= static_cast<SbiOpcode
>( *pCode
++ );
816 if (eOp
<= SbiOpcode::SbOP0_END
)
818 (this->*( aStep0
[ int(eOp
) ] ) )();
820 else if (eOp
>= SbiOpcode::SbOP1_START
&& eOp
<= SbiOpcode::SbOP1_END
)
822 nOp1
= *pCode
++; nOp1
|= *pCode
++ << 8; nOp1
|= *pCode
++ << 16; nOp1
|= *pCode
++ << 24;
824 (this->*( aStep1
[ int(eOp
) - int(SbiOpcode::SbOP1_START
) ] ) )( nOp1
);
826 else if (eOp
>= SbiOpcode::SbOP2_START
&& eOp
<= SbiOpcode::SbOP2_END
)
828 nOp1
= *pCode
++; nOp1
|= *pCode
++ << 8; nOp1
|= *pCode
++ << 16; nOp1
|= *pCode
++ << 24;
829 sal_uInt32 nOp2
= *pCode
++; nOp2
|= *pCode
++ << 8; nOp2
|= *pCode
++ << 16; nOp2
|= *pCode
++ << 24;
830 (this->*( aStep2
[ int(eOp
) - int(SbiOpcode::SbOP2_START
) ] ) )( nOp1
, nOp2
);
834 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
837 ErrCode nErrCode
= SbxBase::GetError();
838 Error( nErrCode
.IgnoreWarning() );
840 // from 13.2.1997, new error handling:
841 // ATTENTION: nError can be set already even if !nErrCode
842 // since nError can now also be set from other RT-instances
846 SbxBase::ResetError();
849 // from 15.3.96: display errors only if BASIC is still active
850 // (especially not after compiler errors at the runtime)
853 ErrCode err
= nError
;
855 nError
= ERRCODE_NONE
;
860 // An error occurred in an error handler
861 // force parent handler ( if there is one )
862 // to handle the error
863 bool bLetParentHandleThis
= false;
865 // in the error handler? so std-error
870 if( !bError
) // On Error Resume Next
874 else if( pError
) // On Error Goto ...
880 bLetParentHandleThis
= true;
885 bLetParentHandleThis
= true;
886 pError
= nullptr; //terminate the handler
888 if ( bLetParentHandleThis
)
890 // from 13.2.1997, new error handling:
891 // consider superior error handlers
893 // there's no error handler -> find one farther above
894 SbiRuntime
* pRtErrHdl
= nullptr;
895 SbiRuntime
* pRt
= this;
896 while( (pRt
= pRt
->pNext
) != nullptr )
898 if( !pRt
->bError
|| pRt
->pError
!= nullptr )
908 // manipulate all the RTs that are below in the call-stack
913 if( pRt
!= pRtErrHdl
)
925 // no error-hdl found -> old behaviour
936 void SbiRuntime::Error( ErrCode n
, bool bVBATranslationAlreadyDone
)
942 if( !isVBAEnabled() || bVBATranslationAlreadyDone
)
945 OUString aMsg
= pInst
->GetErrorMsg();
946 sal_Int32 nVBAErrorNumber
= translateErrorToVba( nError
, aMsg
);
947 SbxVariable
* pSbxErrObjVar
= SbxErrObject::getErrObject().get();
948 SbxErrObject
* pGlobErr
= static_cast< SbxErrObject
* >( pSbxErrObjVar
);
949 if( pGlobErr
!= nullptr )
951 pGlobErr
->setNumberAndDescription( nVBAErrorNumber
, aMsg
);
953 pInst
->aErrorMsg
= aMsg
;
954 nError
= ERRCODE_BASIC_COMPAT
;
957 void SbiRuntime::Error( ErrCode _errCode
, const OUString
& _details
)
962 // Not correct for class module usage, remove for now
963 //OSL_WARN_IF( pInst->pRun != this, "basic", "SbiRuntime::Error: can't propagate the error message details!" );
964 if ( pInst
->pRun
== this )
966 pInst
->Error( _errCode
, _details
);
967 //OSL_WARN_IF( nError != _errCode, "basic", "SbiRuntime::Error: the instance is expected to propagate the error code back to me!" );
975 void SbiRuntime::FatalError( ErrCode n
)
981 void SbiRuntime::FatalError( ErrCode _errCode
, const OUString
& _details
)
984 Error( _errCode
, _details
);
987 sal_Int32
SbiRuntime::translateErrorToVba( ErrCode nError
, OUString
& rMsg
)
989 // If a message is defined use that ( in preference to
990 // the defined one for the error ) NB #TODO
991 // if there is an error defined it more than likely
992 // is not the one you want ( some are the same though )
993 // we really need a new vba compatible error list
994 if ( rMsg
.isEmpty() )
996 StarBASIC::MakeErrorText( nError
, rMsg
);
997 rMsg
= StarBASIC::GetErrorText();
998 if ( rMsg
.isEmpty() ) // no message for err no, need localized resource here
1000 rMsg
= "Internal Object Error:";
1003 // no num? most likely then it *is* really a vba err
1004 sal_uInt16 nVBErrorCode
= StarBASIC::GetVBErrorCode( nError
);
1005 sal_Int32 nVBAErrorNumber
= ( nVBErrorCode
== 0 ) ? sal_uInt32(nError
) : nVBErrorCode
;
1006 return nVBAErrorNumber
;
1011 // The expression-stack is available for the continuous evaluation
1014 void SbiRuntime::PushVar( SbxVariable
* pVar
)
1018 refExprStk
->Put32( pVar
, nExprLvl
++ );
1022 SbxVariableRef
SbiRuntime::PopVar()
1027 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
1028 return new SbxVariable
;
1031 SbxVariableRef xVar
= refExprStk
->Get32( --nExprLvl
);
1032 SAL_INFO_IF( xVar
->GetName() == "Cells", "basic", "PopVar: Name equals 'Cells'" );
1033 // methods hold themselves in parameter 0
1034 if( dynamic_cast<const SbxMethod
*>(xVar
.get()) != nullptr )
1036 xVar
->SetParameters(nullptr);
1041 void SbiRuntime::ClearExprStack()
1043 // Attention: Clear() doesn't suffice as methods must be deleted
1048 refExprStk
->Clear();
1051 // Take variable from the expression-stack without removing it
1054 SbxVariable
* SbiRuntime::GetTOS()
1056 short n
= nExprLvl
- 1;
1060 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
1061 return new SbxVariable
;
1064 return refExprStk
->Get32( static_cast<sal_uInt32
>(n
) );
1068 void SbiRuntime::TOSMakeTemp()
1070 SbxVariable
* p
= refExprStk
->Get32( nExprLvl
- 1 );
1071 if ( p
->GetType() == SbxEMPTY
)
1073 p
->Broadcast( SfxHintId::BasicDataWanted
);
1076 SbxVariable
* pDflt
= nullptr;
1077 if ( bVBAEnabled
&& ( p
->GetType() == SbxOBJECT
|| p
->GetType() == SbxVARIANT
) && ((pDflt
= getDefaultProp(p
)) != nullptr) )
1079 pDflt
->Broadcast( SfxHintId::BasicDataWanted
);
1080 // replacing new p on stack causes object pointed by
1081 // pDft->pParent to be deleted, when p2->Compute() is
1082 // called below pParent is accessed (but it's deleted)
1083 // so set it to NULL now
1084 pDflt
->SetParent( nullptr );
1085 p
= new SbxVariable( *pDflt
);
1086 p
->SetFlag( SbxFlagBits::ReadWrite
);
1087 refExprStk
->Put32( p
, nExprLvl
- 1 );
1089 else if( p
->GetRefCount() != 1 )
1091 SbxVariable
* pNew
= new SbxVariable( *p
);
1092 pNew
->SetFlag( SbxFlagBits::ReadWrite
);
1093 refExprStk
->Put32( pNew
, nExprLvl
- 1 );
1097 // the GOSUB-stack collects return-addresses for GOSUBs
1098 void SbiRuntime::PushGosub( const sal_uInt8
* pc
)
1100 if( pGosubStk
.size() >= MAXRECURSION
)
1102 StarBASIC::FatalError( ERRCODE_BASIC_STACK_OVERFLOW
);
1104 pGosubStk
.emplace_back(pc
, nForLvl
);
1107 void SbiRuntime::PopGosub()
1109 if( pGosubStk
.empty() )
1111 Error( ERRCODE_BASIC_NO_GOSUB
);
1115 pCode
= pGosubStk
.back().pCode
;
1116 pGosubStk
.pop_back();
1120 // the Argv-stack collects current argument-vectors
1122 void SbiRuntime::PushArgv()
1124 pArgvStk
.emplace_back(refArgv
, nArgc
);
1129 void SbiRuntime::PopArgv()
1131 if( !pArgvStk
.empty() )
1133 refArgv
= pArgvStk
.back().refArgv
;
1134 nArgc
= pArgvStk
.back().nArgc
;
1135 pArgvStk
.pop_back();
1140 void SbiRuntime::ClearArgvStack()
1142 while( !pArgvStk
.empty() )
1148 // Push of the for-stack. The stack has increment, end, begin and variable.
1149 // After the creation of the stack-element the stack's empty.
1151 void SbiRuntime::PushFor()
1153 SbiForStack
* p
= new SbiForStack
;
1154 p
->eForType
= ForType::To
;
1158 p
->refInc
= PopVar();
1159 p
->refEnd
= PopVar();
1160 SbxVariableRef xBgn
= PopVar();
1161 p
->refVar
= PopVar();
1162 // tdf#85371 - grant explicitly write access to the index variable
1163 // since it could be the name of a method itself used in the next statement.
1164 ScopedWritableGuard
aGuard(p
->refVar
, p
->refVar
.get() == pMeth
);
1165 *(p
->refVar
) = *xBgn
;
1169 void SbiRuntime::PushForEach()
1171 SbiForStack
* p
= new SbiForStack
;
1172 // Set default value in case of error which is ignored in Resume Next
1173 p
->eForType
= ForType::EachArray
;
1177 SbxVariableRef xObjVar
= PopVar();
1178 SbxBase
* pObj
= xObjVar
&& xObjVar
->GetFullType() == SbxOBJECT
? xObjVar
->GetObject() : nullptr;
1180 if (SbxDimArray
* pArray
= dynamic_cast<SbxDimArray
*>(pObj
))
1182 p
->refEnd
= reinterpret_cast<SbxVariable
*>(pArray
);
1184 sal_Int32 nDims
= pArray
->GetDims32();
1185 p
->pArrayLowerBounds
.reset( new sal_Int32
[nDims
] );
1186 p
->pArrayUpperBounds
.reset( new sal_Int32
[nDims
] );
1187 p
->pArrayCurIndices
.reset( new sal_Int32
[nDims
] );
1188 sal_Int32 lBound
, uBound
;
1189 for( sal_Int32 i
= 0 ; i
< nDims
; i
++ )
1191 pArray
->GetDim32( i
+1, lBound
, uBound
);
1192 p
->pArrayCurIndices
[i
] = p
->pArrayLowerBounds
[i
] = lBound
;
1193 p
->pArrayUpperBounds
[i
] = uBound
;
1196 else if (BasicCollection
* pCollection
= dynamic_cast<BasicCollection
*>(pObj
))
1198 p
->eForType
= ForType::EachCollection
;
1199 p
->refEnd
= pCollection
;
1200 p
->nCurCollectionIndex
= 0;
1202 else if (SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>(pObj
))
1204 // XEnumerationAccess?
1205 Any aAny
= pUnoObj
->getUnoAny();
1206 Reference
< XEnumerationAccess
> xEnumerationAccess
;
1207 if( aAny
>>= xEnumerationAccess
)
1209 p
->xEnumeration
= xEnumerationAccess
->createEnumeration();
1210 p
->eForType
= ForType::EachXEnumeration
;
1212 else if ( isVBAEnabled() && pUnoObj
->isNativeCOMObject() )
1214 uno::Reference
< script::XInvocation
> xInvocation
;
1215 if ( ( aAny
>>= xInvocation
) && xInvocation
.is() )
1219 p
->xEnumeration
= new ComEnumerationWrapper( xInvocation
);
1220 p
->eForType
= ForType::EachXEnumeration
;
1222 catch(const uno::Exception
& )
1228 // Container variable
1229 p
->refVar
= PopVar();
1234 void SbiRuntime::PopFor()
1238 SbiForStack
* p
= pForStk
;
1246 void SbiRuntime::ClearForStack()
1254 SbiForStack
* SbiRuntime::FindForStackItemForCollection( class BasicCollection
const * pCollection
)
1256 for (SbiForStack
*p
= pForStk
; p
; p
= p
->pNext
)
1258 SbxVariable
* pVar
= p
->refEnd
.is() ? p
->refEnd
.get() : nullptr;
1259 if( p
->eForType
== ForType::EachCollection
1261 && dynamic_cast<BasicCollection
*>( pVar
) == pCollection
)
1273 void SbiRuntime::DllCall
1274 ( const OUString
& aFuncName
,
1275 const OUString
& aDLLName
,
1276 SbxArray
* pArgs
, // parameter (from index 1, can be NULL)
1277 SbxDataType eResType
, // return value
1278 bool bCDecl
) // true: according to C-conventions
1280 // NOT YET IMPLEMENTED
1282 SbxVariable
* pRes
= new SbxVariable( eResType
);
1283 SbiDllMgr
* pDllMgr
= pInst
->GetDllMgr();
1284 ErrCode nErr
= pDllMgr
->Call( aFuncName
, aDLLName
, pArgs
, *pRes
, bCDecl
);
1292 bool SbiRuntime::IsImageFlag( SbiImageFlags n
) const
1294 return pImg
->IsFlag( n
);
1297 sal_uInt16
SbiRuntime::GetBase() const
1299 return pImg
->GetBase();
1302 void SbiRuntime::StepNOP()
1305 void SbiRuntime::StepArith( SbxOperator eOp
)
1307 SbxVariableRef p1
= PopVar();
1309 SbxVariable
* p2
= GetTOS();
1311 p2
->ResetFlag( SbxFlagBits::Fixed
);
1312 p2
->Compute( eOp
, *p1
);
1314 checkArithmeticOverflow( p2
);
1317 void SbiRuntime::StepUnary( SbxOperator eOp
)
1320 SbxVariable
* p
= GetTOS();
1321 p
->Compute( eOp
, *p
);
1324 void SbiRuntime::StepCompare( SbxOperator eOp
)
1326 SbxVariableRef p1
= PopVar();
1327 SbxVariableRef p2
= PopVar();
1329 // Make sure objects with default params have
1330 // values ( and type ) set as appropriate
1331 SbxDataType p1Type
= p1
->GetType();
1332 SbxDataType p2Type
= p2
->GetType();
1333 if ( p1Type
== SbxEMPTY
)
1335 p1
->Broadcast( SfxHintId::BasicDataWanted
);
1336 p1Type
= p1
->GetType();
1338 if ( p2Type
== SbxEMPTY
)
1340 p2
->Broadcast( SfxHintId::BasicDataWanted
);
1341 p2Type
= p2
->GetType();
1343 if ( p1Type
== p2Type
)
1345 // if both sides are an object and have default props
1346 // then we need to use the default props
1347 // we don't need to worry if only one side ( lhs, rhs ) is an
1348 // object ( object side will get coerced to correct type in
1350 if ( p1Type
== SbxOBJECT
)
1352 SbxVariable
* pDflt
= getDefaultProp( p1
.get() );
1356 p1
->Broadcast( SfxHintId::BasicDataWanted
);
1358 pDflt
= getDefaultProp( p2
.get() );
1362 p2
->Broadcast( SfxHintId::BasicDataWanted
);
1367 static SbxVariable
* pTRUE
= nullptr;
1368 static SbxVariable
* pFALSE
= nullptr;
1369 // why do this on non-windows ?
1370 // why do this at all ?
1371 // I dumbly follow the pattern :-/
1372 if ( bVBAEnabled
&& ( p1
->IsNull() || p2
->IsNull() ) )
1374 static SbxVariable
* pNULL
= [&]() {
1375 SbxVariable
* p
= new SbxVariable
;
1382 else if( p2
->Compare( eOp
, *p1
) )
1386 pTRUE
= new SbxVariable
;
1387 pTRUE
->PutBool( true );
1388 pTRUE
->AddFirstRef();
1396 pFALSE
= new SbxVariable
;
1397 pFALSE
->PutBool( false );
1398 pFALSE
->AddFirstRef();
1404 void SbiRuntime::StepEXP() { StepArith( SbxEXP
); }
1405 void SbiRuntime::StepMUL() { StepArith( SbxMUL
); }
1406 void SbiRuntime::StepDIV() { StepArith( SbxDIV
); }
1407 void SbiRuntime::StepIDIV() { StepArith( SbxIDIV
); }
1408 void SbiRuntime::StepMOD() { StepArith( SbxMOD
); }
1409 void SbiRuntime::StepPLUS() { StepArith( SbxPLUS
); }
1410 void SbiRuntime::StepMINUS() { StepArith( SbxMINUS
); }
1411 void SbiRuntime::StepCAT() { StepArith( SbxCAT
); }
1412 void SbiRuntime::StepAND() { StepArith( SbxAND
); }
1413 void SbiRuntime::StepOR() { StepArith( SbxOR
); }
1414 void SbiRuntime::StepXOR() { StepArith( SbxXOR
); }
1415 void SbiRuntime::StepEQV() { StepArith( SbxEQV
); }
1416 void SbiRuntime::StepIMP() { StepArith( SbxIMP
); }
1418 void SbiRuntime::StepNEG() { StepUnary( SbxNEG
); }
1419 void SbiRuntime::StepNOT() { StepUnary( SbxNOT
); }
1421 void SbiRuntime::StepEQ() { StepCompare( SbxEQ
); }
1422 void SbiRuntime::StepNE() { StepCompare( SbxNE
); }
1423 void SbiRuntime::StepLT() { StepCompare( SbxLT
); }
1424 void SbiRuntime::StepGT() { StepCompare( SbxGT
); }
1425 void SbiRuntime::StepLE() { StepCompare( SbxLE
); }
1426 void SbiRuntime::StepGE() { StepCompare( SbxGE
); }
1430 bool NeedEsc(sal_Unicode cCode
)
1432 if(!rtl::isAscii(cCode
))
1454 OUString
VBALikeToRegexp(const OUString
&rIn
)
1456 OUStringBuffer sResult
;
1457 const sal_Unicode
*start
= rIn
.getStr();
1458 const sal_Unicode
*end
= start
+ rIn
.getLength();
1462 sResult
.append('^');
1469 sResult
.append('.');
1473 sResult
.append(".*");
1477 sResult
.append("[0-9]");
1481 sResult
.append('\\');
1482 sResult
.append(*start
++);
1485 sResult
.append(*start
++);
1487 while (start
< end
&& !seenright
)
1494 sResult
.append('\\');
1495 sResult
.append(*start
);
1498 sResult
.append(*start
);
1502 sResult
.append('^');
1505 if (NeedEsc(*start
))
1507 sResult
.append('\\');
1509 sResult
.append(*start
);
1516 if (NeedEsc(*start
))
1518 sResult
.append('\\');
1520 sResult
.append(*start
++);
1524 sResult
.append('$');
1526 return sResult
.makeStringAndClear();
1530 void SbiRuntime::StepLIKE()
1532 SbxVariableRef refVar1
= PopVar();
1533 SbxVariableRef refVar2
= PopVar();
1535 OUString pattern
= VBALikeToRegexp(refVar1
->GetOUString());
1536 OUString value
= refVar2
->GetOUString();
1538 i18nutil::SearchOptions2 aSearchOpt
;
1540 aSearchOpt
.AlgorithmType2
= css::util::SearchAlgorithms2::REGEXP
;
1542 aSearchOpt
.Locale
= Application::GetSettings().GetLanguageTag().getLocale();
1543 aSearchOpt
.searchString
= pattern
;
1545 bool bTextMode(true);
1546 bool bCompatibility
= ( GetSbData()->pInst
&& GetSbData()->pInst
->IsCompatibility() );
1547 if( bCompatibility
)
1549 bTextMode
= IsImageFlag( SbiImageFlags::COMPARETEXT
);
1553 aSearchOpt
.transliterateFlags
|= TransliterationFlags::IGNORE_CASE
;
1555 SbxVariable
* pRes
= new SbxVariable
;
1556 utl::TextSearch
aSearch( aSearchOpt
);
1557 sal_Int32 nStart
=0, nEnd
=value
.getLength();
1558 bool bRes
= aSearch
.SearchForward(value
, &nStart
, &nEnd
);
1559 pRes
->PutBool( bRes
);
1564 // TOS and TOS-1 are both object variables and contain the same pointer
1566 void SbiRuntime::StepIS()
1568 SbxVariableRef refVar1
= PopVar();
1569 SbxVariableRef refVar2
= PopVar();
1571 SbxDataType eType1
= refVar1
->GetType();
1572 SbxDataType eType2
= refVar2
->GetType();
1573 if ( eType1
== SbxEMPTY
)
1575 refVar1
->Broadcast( SfxHintId::BasicDataWanted
);
1576 eType1
= refVar1
->GetType();
1578 if ( eType2
== SbxEMPTY
)
1580 refVar2
->Broadcast( SfxHintId::BasicDataWanted
);
1581 eType2
= refVar2
->GetType();
1584 bool bRes
= ( eType1
== SbxOBJECT
&& eType2
== SbxOBJECT
);
1585 if ( bVBAEnabled
&& !bRes
)
1587 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
1589 bRes
= ( bRes
&& refVar1
->GetObject() == refVar2
->GetObject() );
1590 SbxVariable
* pRes
= new SbxVariable
;
1591 pRes
->PutBool( bRes
);
1595 // update the value of TOS
1597 void SbiRuntime::StepGET()
1599 SbxVariable
* p
= GetTOS();
1600 p
->Broadcast( SfxHintId::BasicDataWanted
);
1603 // #67607 copy Uno-Structs
1604 static bool checkUnoStructCopy( bool bVBA
, SbxVariableRef
const & refVal
, SbxVariableRef
const & refVar
)
1606 SbxDataType eVarType
= refVar
->GetType();
1607 SbxDataType eValType
= refVal
->GetType();
1609 if ( ( bVBA
&& ( eVarType
== SbxEMPTY
) ) || !refVar
->CanWrite() )
1612 if ( eValType
!= SbxOBJECT
)
1614 // we seem to be duplicating parts of SbxValue=operator, maybe we should just move this to
1615 // there :-/ not sure if for every '=' we would want struct handling
1616 if( eVarType
!= SbxOBJECT
)
1618 if ( refVar
->IsFixed() )
1621 // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure
1622 else if( dynamic_cast<const SbProcedureProperty
*>( refVar
.get() ) != nullptr )
1625 SbxObjectRef xValObj
= static_cast<SbxObject
*>(refVal
->GetObject());
1626 if( !xValObj
.is() || dynamic_cast<const SbUnoAnyObject
*>( xValObj
.get() ) != nullptr )
1629 SbUnoObject
* pUnoVal
= dynamic_cast<SbUnoObject
*>( xValObj
.get() );
1630 SbUnoStructRefObject
* pUnoStructVal
= dynamic_cast<SbUnoStructRefObject
*>( xValObj
.get() );
1632 // make doubly sure value is either a Uno object or
1634 if ( pUnoVal
|| pUnoStructVal
)
1635 aAny
= pUnoVal
? pUnoVal
->getUnoAny() : pUnoStructVal
->getUnoAny();
1638 if ( aAny
.getValueType().getTypeClass() == TypeClass_STRUCT
)
1640 refVar
->SetType( SbxOBJECT
);
1641 ErrCode eOldErr
= SbxBase::GetError();
1642 // There are some circumstances when calling GetObject
1643 // will trigger an error, we need to squash those here.
1644 // Alternatively it is possible that the same scenario
1645 // could overwrite and existing error. Lets prevent that
1646 SbxObjectRef xVarObj
= static_cast<SbxObject
*>(refVar
->GetObject());
1647 if ( eOldErr
!= ERRCODE_NONE
)
1648 SbxBase::SetError( eOldErr
);
1650 SbxBase::ResetError();
1652 SbUnoStructRefObject
* pUnoStructObj
= dynamic_cast<SbUnoStructRefObject
*>( xVarObj
.get() );
1654 OUString sClassName
= pUnoVal
? pUnoVal
->GetClassName() : pUnoStructVal
->GetClassName();
1655 OUString sName
= pUnoVal
? pUnoVal
->GetName() : pUnoStructVal
->GetName();
1657 if ( pUnoStructObj
)
1659 StructRefInfo aInfo
= pUnoStructObj
->getStructInfo();
1660 aInfo
.setValue( aAny
);
1664 SbUnoObject
* pNewUnoObj
= new SbUnoObject( sName
, aAny
);
1665 // #70324: adopt ClassName
1666 pNewUnoObj
->SetClassName( sClassName
);
1667 refVar
->PutObject( pNewUnoObj
);
1675 // laying down TOS in TOS-1
1677 void SbiRuntime::StepPUT()
1679 SbxVariableRef refVal
= PopVar();
1680 SbxVariableRef refVar
= PopVar();
1681 // store on its own method (inside a function)?
1682 bool bFlagsChanged
= false;
1683 SbxFlagBits n
= SbxFlagBits::NONE
;
1684 if( refVar
.get() == pMeth
)
1686 bFlagsChanged
= true;
1687 n
= refVar
->GetFlags();
1688 refVar
->SetFlag( SbxFlagBits::Write
);
1691 // if left side arg is an object or variant and right handside isn't
1692 // either an object or a variant then try and see if a default
1694 // to use e.g. Range{"A1") = 34
1695 // could equate to Range("A1").Value = 34
1698 // yet more hacking at this, I feel we don't quite have the correct
1699 // heuristics for dealing with obj1 = obj2 ( where obj2 ( and maybe
1700 // obj1 ) has default member/property ) ) It seems that default props
1701 // aren't dealt with if the object is a member of some parent object
1702 bool bObjAssign
= false;
1703 if ( refVar
->GetType() == SbxEMPTY
)
1704 refVar
->Broadcast( SfxHintId::BasicDataWanted
);
1705 if ( refVar
->GetType() == SbxOBJECT
)
1707 if ( dynamic_cast<const SbxMethod
*>(refVar
.get()) != nullptr || ! refVar
->GetParent() )
1709 SbxVariable
* pDflt
= getDefaultProp( refVar
.get() );
1717 if ( refVal
->GetType() == SbxOBJECT
&& !bObjAssign
&& ( dynamic_cast<const SbxMethod
*>(refVal
.get()) != nullptr || ! refVal
->GetParent() ) )
1719 SbxVariable
* pDflt
= getDefaultProp( refVal
.get() );
1725 if ( !checkUnoStructCopy( bVBAEnabled
, refVal
, refVar
) )
1729 refVar
->SetFlags( n
);
1734 // VBA Dim As New behavior handling, save init object information
1735 struct DimAsNewRecoverItem
1737 OUString m_aObjClass
;
1738 OUString m_aObjName
;
1739 SbxObject
* m_pObjParent
;
1740 SbModule
* m_pClassModule
;
1742 DimAsNewRecoverItem()
1743 : m_pObjParent( nullptr )
1744 , m_pClassModule( nullptr )
1747 DimAsNewRecoverItem( const OUString
& rObjClass
, const OUString
& rObjName
,
1748 SbxObject
* pObjParent
, SbModule
* pClassModule
)
1749 : m_aObjClass( rObjClass
)
1750 , m_aObjName( rObjName
)
1751 , m_pObjParent( pObjParent
)
1752 , m_pClassModule( pClassModule
)
1758 struct SbxVariablePtrHash
1760 size_t operator()( SbxVariable
* pVar
) const
1761 { return reinterpret_cast<size_t>(pVar
); }
1766 typedef std::unordered_map
< SbxVariable
*, DimAsNewRecoverItem
,
1767 SbxVariablePtrHash
> DimAsNewRecoverHash
;
1771 class GaDimAsNewRecoverHash
: public rtl::Static
<DimAsNewRecoverHash
, GaDimAsNewRecoverHash
> {};
1775 void removeDimAsNewRecoverItem( SbxVariable
* pVar
)
1777 DimAsNewRecoverHash
&rDimAsNewRecoverHash
= GaDimAsNewRecoverHash::get();
1778 DimAsNewRecoverHash::iterator it
= rDimAsNewRecoverHash
.find( pVar
);
1779 if( it
!= rDimAsNewRecoverHash
.end() )
1781 rDimAsNewRecoverHash
.erase( it
);
1786 // saving object variable
1787 // not-object variables will cause errors
1789 const char pCollectionStr
[] = "Collection";
1791 void SbiRuntime::StepSET_Impl( SbxVariableRef
& refVal
, SbxVariableRef
& refVar
, bool bHandleDefaultProp
)
1793 // #67733 types with array-flag are OK too
1795 // Check var, !object is no error for sure if, only if type is fixed
1796 SbxDataType eVarType
= refVar
->GetType();
1797 if( !bHandleDefaultProp
&& eVarType
!= SbxOBJECT
&& !(eVarType
& SbxARRAY
) && refVar
->IsFixed() )
1799 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
1803 // Check value, !object is no error for sure if, only if type is fixed
1804 SbxDataType eValType
= refVal
->GetType();
1805 if( !bHandleDefaultProp
&& eValType
!= SbxOBJECT
&& !(eValType
& SbxARRAY
) && refVal
->IsFixed() )
1807 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
1811 // Getting in here causes problems with objects with default properties
1812 // if they are SbxEMPTY I guess
1813 if ( !bHandleDefaultProp
|| eValType
== SbxOBJECT
)
1815 // activate GetObject for collections on refVal
1816 SbxBase
* pObjVarObj
= refVal
->GetObject();
1819 SbxVariableRef refObjVal
= dynamic_cast<SbxObject
*>( pObjVarObj
);
1821 if( refObjVal
.is() )
1825 else if( !(eValType
& SbxARRAY
) )
1832 // #52896 refVal can be invalid here, if uno-sequences - or more
1833 // general arrays - are assigned to variables that are declared
1837 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
1841 bool bFlagsChanged
= false;
1842 SbxFlagBits n
= SbxFlagBits::NONE
;
1843 if( refVar
.get() == pMeth
)
1845 bFlagsChanged
= true;
1846 n
= refVar
->GetFlags();
1847 refVar
->SetFlag( SbxFlagBits::Write
);
1849 SbProcedureProperty
* pProcProperty
= dynamic_cast<SbProcedureProperty
*>( refVar
.get() );
1852 pProcProperty
->setSet( true );
1854 if ( bHandleDefaultProp
)
1856 // get default properties for lhs & rhs where necessary
1857 // SbxVariable* defaultProp = NULL; unused variable
1858 // LHS try determine if a default prop exists
1859 // again like in StepPUT (see there too ) we are tweaking the
1860 // heuristics again for when to assign an object reference or
1861 // use default members if they exist
1862 // #FIXME we really need to get to the bottom of this mess
1863 bool bObjAssign
= false;
1864 if ( refVar
->GetType() == SbxOBJECT
)
1866 if ( dynamic_cast<const SbxMethod
*>(refVar
.get()) != nullptr || ! refVar
->GetParent() )
1868 SbxVariable
* pDflt
= getDefaultProp( refVar
.get() );
1877 // RHS only get a default prop is the rhs has one
1878 if ( refVal
->GetType() == SbxOBJECT
)
1880 // check if lhs is a null object
1881 // if it is then use the object not the default property
1882 SbxObject
* pObj
= dynamic_cast<SbxObject
*>( refVar
.get() );
1884 // calling GetObject on a SbxEMPTY variable raises
1885 // object not set errors, make sure it's an Object
1886 if ( !pObj
&& refVar
->GetType() == SbxOBJECT
)
1888 SbxBase
* pObjVarObj
= refVar
->GetObject();
1889 pObj
= dynamic_cast<SbxObject
*>( pObjVarObj
);
1891 SbxVariable
* pDflt
= nullptr;
1892 if ( pObj
&& !bObjAssign
)
1894 // lhs is either a valid object || or has a defaultProp
1895 pDflt
= getDefaultProp( refVal
.get() );
1904 // Handle Dim As New
1905 bool bDimAsNew
= bVBAEnabled
&& refVar
->IsSet( SbxFlagBits::DimAsNew
);
1906 SbxBaseRef xPrevVarObj
;
1909 xPrevVarObj
= refVar
->GetObject();
1911 // Handle withevents
1912 bool bWithEvents
= refVar
->IsSet( SbxFlagBits::WithEvents
);
1915 Reference
< XInterface
> xComListener
;
1917 SbxBase
* pObj
= refVal
->GetObject();
1918 SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>( pObj
);
1919 if( pUnoObj
!= nullptr )
1921 Any aControlAny
= pUnoObj
->getUnoAny();
1922 OUString aDeclareClassName
= refVar
->GetDeclareClassName();
1923 OUString aPrefix
= refVar
->GetName();
1924 SbxObjectRef xScopeObj
= refVar
->GetParent();
1925 xComListener
= createComListener( aControlAny
, aDeclareClassName
, aPrefix
, xScopeObj
);
1927 refVal
->SetDeclareClassName( aDeclareClassName
);
1928 refVal
->SetComListener( xComListener
, &rBasic
); // Hold reference
1933 // lhs is a property who's value is currently (Empty e.g. no broadcast yet)
1934 // in this case if there is a default prop involved the value of the
1935 // default property may in fact be void so the type will also be SbxEMPTY
1936 // in this case we do not want to call checkUnoStructCopy 'cause that will
1937 // cause an error also
1938 if ( !checkUnoStructCopy( bHandleDefaultProp
, refVal
, refVar
) )
1944 if( dynamic_cast<const SbxObject
*>( refVar
.get() ) == nullptr )
1946 SbxBase
* pValObjBase
= refVal
->GetObject();
1947 if( pValObjBase
== nullptr )
1949 if( xPrevVarObj
.is() )
1951 // Object is overwritten with NULL, instantiate init object
1952 DimAsNewRecoverHash
&rDimAsNewRecoverHash
= GaDimAsNewRecoverHash::get();
1953 DimAsNewRecoverHash::iterator it
= rDimAsNewRecoverHash
.find( refVar
.get() );
1954 if( it
!= rDimAsNewRecoverHash
.end() )
1956 const DimAsNewRecoverItem
& rItem
= it
->second
;
1957 if( rItem
.m_pClassModule
!= nullptr )
1959 SbClassModuleObject
* pNewObj
= new SbClassModuleObject( rItem
.m_pClassModule
);
1960 pNewObj
->SetName( rItem
.m_aObjName
);
1961 pNewObj
->SetParent( rItem
.m_pObjParent
);
1962 refVar
->PutObject( pNewObj
);
1964 else if( rItem
.m_aObjClass
.equalsIgnoreAsciiCase( pCollectionStr
) )
1966 BasicCollection
* pNewCollection
= new BasicCollection( pCollectionStr
);
1967 pNewCollection
->SetName( rItem
.m_aObjName
);
1968 pNewCollection
->SetParent( rItem
.m_pObjParent
);
1969 refVar
->PutObject( pNewCollection
);
1976 // Does old value exist?
1977 bool bFirstInit
= !xPrevVarObj
.is();
1980 // Store information to instantiate object later
1981 SbxObject
* pValObj
= dynamic_cast<SbxObject
*>( pValObjBase
);
1982 if( pValObj
!= nullptr )
1984 OUString aObjClass
= pValObj
->GetClassName();
1986 SbClassModuleObject
* pClassModuleObj
= dynamic_cast<SbClassModuleObject
*>( pValObjBase
);
1987 DimAsNewRecoverHash
&rDimAsNewRecoverHash
= GaDimAsNewRecoverHash::get();
1988 if( pClassModuleObj
!= nullptr )
1990 SbModule
* pClassModule
= pClassModuleObj
->getClassModule();
1991 rDimAsNewRecoverHash
[refVar
.get()] =
1992 DimAsNewRecoverItem( aObjClass
, pValObj
->GetName(), pValObj
->GetParent(), pClassModule
);
1994 else if( aObjClass
.equalsIgnoreAsciiCase( "Collection" ) )
1996 rDimAsNewRecoverHash
[refVar
.get()] =
1997 DimAsNewRecoverItem( aObjClass
, pValObj
->GetName(), pValObj
->GetParent(), nullptr );
2007 refVar
->SetFlags( n
);
2012 void SbiRuntime::StepSET()
2014 SbxVariableRef refVal
= PopVar();
2015 SbxVariableRef refVar
= PopVar();
2016 StepSET_Impl( refVal
, refVar
, bVBAEnabled
); // this is really assignment
2019 void SbiRuntime::StepVBASET()
2021 SbxVariableRef refVal
= PopVar();
2022 SbxVariableRef refVar
= PopVar();
2023 // don't handle default property
2024 StepSET_Impl( refVal
, refVar
); // set obj = something
2028 void SbiRuntime::StepLSET()
2030 SbxVariableRef refVal
= PopVar();
2031 SbxVariableRef refVar
= PopVar();
2032 if( refVar
->GetType() != SbxSTRING
||
2033 refVal
->GetType() != SbxSTRING
)
2035 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
2039 SbxFlagBits n
= refVar
->GetFlags();
2040 if( refVar
.get() == pMeth
)
2042 refVar
->SetFlag( SbxFlagBits::Write
);
2044 OUString aRefVarString
= refVar
->GetOUString();
2045 OUString aRefValString
= refVal
->GetOUString();
2047 sal_Int32 nVarStrLen
= aRefVarString
.getLength();
2048 sal_Int32 nValStrLen
= aRefValString
.getLength();
2050 if( nVarStrLen
> nValStrLen
)
2052 OUStringBuffer
buf(aRefValString
);
2053 comphelper::string::padToLength(buf
, nVarStrLen
, ' ');
2054 aNewStr
= buf
.makeStringAndClear();
2058 aNewStr
= aRefValString
.copy( 0, nVarStrLen
);
2061 refVar
->PutString(aNewStr
);
2062 refVar
->SetFlags( n
);
2066 void SbiRuntime::StepRSET()
2068 SbxVariableRef refVal
= PopVar();
2069 SbxVariableRef refVar
= PopVar();
2070 if( refVar
->GetType() != SbxSTRING
|| refVal
->GetType() != SbxSTRING
)
2072 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
2076 SbxFlagBits n
= refVar
->GetFlags();
2077 if( refVar
.get() == pMeth
)
2079 refVar
->SetFlag( SbxFlagBits::Write
);
2081 OUString aRefVarString
= refVar
->GetOUString();
2082 OUString aRefValString
= refVal
->GetOUString();
2083 sal_Int32 nVarStrLen
= aRefVarString
.getLength();
2084 sal_Int32 nValStrLen
= aRefValString
.getLength();
2086 OUStringBuffer
aNewStr(nVarStrLen
);
2087 if (nVarStrLen
> nValStrLen
)
2089 comphelper::string::padToLength(aNewStr
, nVarStrLen
- nValStrLen
, ' ');
2090 aNewStr
.append(aRefValString
);
2094 aNewStr
.append(std::u16string_view(aRefValString
).substr(0, nVarStrLen
));
2096 refVar
->PutString(aNewStr
.makeStringAndClear());
2098 refVar
->SetFlags( n
);
2102 // laying down TOS in TOS-1, then set ReadOnly-Bit
2104 void SbiRuntime::StepPUTC()
2106 SbxVariableRef refVal
= PopVar();
2107 SbxVariableRef refVar
= PopVar();
2108 refVar
->SetFlag( SbxFlagBits::Write
);
2110 refVar
->ResetFlag( SbxFlagBits::Write
);
2111 refVar
->SetFlag( SbxFlagBits::Const
);
2115 // TOS = variable for the array with dimension information as parameter
2117 void SbiRuntime::StepDIM()
2119 SbxVariableRef refVar
= PopVar();
2123 // #56204 swap out DIM-functionality into a help method (step0.cxx)
2124 void SbiRuntime::DimImpl(const SbxVariableRef
& refVar
)
2126 // If refDim then this DIM statement is terminating a ReDIM and
2127 // previous StepERASE_CLEAR for an array, the following actions have
2128 // been delayed from ( StepERASE_CLEAR ) 'till here
2129 if ( refRedim
.is() )
2131 if ( !refRedimpArray
.is() ) // only erase the array not ReDim Preserve
2133 lcl_eraseImpl( refVar
, bVBAEnabled
);
2135 SbxDataType eType
= refVar
->GetType();
2136 lcl_clearImpl( refVar
, eType
);
2139 SbxArray
* pDims
= refVar
->GetParameters();
2140 // must have an even number of arguments
2141 // have in mind that Arg[0] does not count!
2142 if( pDims
&& !( pDims
->Count32() & 1 ) )
2144 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2148 SbxDataType eType
= refVar
->IsFixed() ? refVar
->GetType() : SbxVARIANT
;
2149 SbxDimArray
* pArray
= new SbxDimArray( eType
);
2150 // allow arrays without dimension information, too (VB-compatible)
2153 refVar
->ResetFlag( SbxFlagBits::VarToDim
);
2155 for( sal_uInt32 i
= 1; i
< pDims
->Count32(); )
2157 sal_Int32 lb
= pDims
->Get32( i
++ )->GetLong();
2158 sal_Int32 ub
= pDims
->Get32( i
++ )->GetLong();
2161 Error( ERRCODE_BASIC_OUT_OF_RANGE
);
2164 pArray
->AddDim32( lb
, ub
);
2167 pArray
->setHasFixedSize( true );
2173 // #62867 On creating an array of the length 0, create
2174 // a dimension (like for Uno-Sequences of the length 0)
2175 pArray
->unoAddDim32( 0, -1 );
2177 SbxFlagBits nSavFlags
= refVar
->GetFlags();
2178 refVar
->ResetFlag( SbxFlagBits::Fixed
);
2179 refVar
->PutObject( pArray
);
2180 refVar
->SetFlags( nSavFlags
);
2181 refVar
->SetParameters( nullptr );
2186 // TOS = variable for the array
2187 // argv = dimension information
2189 void SbiRuntime::StepREDIM()
2191 // Nothing different than dim at the moment because
2192 // a double dim is already recognized by the compiler.
2197 // Helper function for StepREDIMP and StepDCREATE_IMPL / bRedimp = true
2198 static void implCopyDimArray( SbxDimArray
* pNewArray
, SbxDimArray
* pOldArray
, sal_Int32 nMaxDimIndex
,
2199 sal_Int32 nActualDim
, sal_Int32
* pActualIndices
, sal_Int32
* pLowerBounds
, sal_Int32
* pUpperBounds
)
2201 sal_Int32
& ri
= pActualIndices
[nActualDim
];
2202 for( ri
= pLowerBounds
[nActualDim
] ; ri
<= pUpperBounds
[nActualDim
] ; ri
++ )
2204 if( nActualDim
< nMaxDimIndex
)
2206 implCopyDimArray( pNewArray
, pOldArray
, nMaxDimIndex
, nActualDim
+ 1,
2207 pActualIndices
, pLowerBounds
, pUpperBounds
);
2211 SbxVariable
* pSource
= pOldArray
->Get32( pActualIndices
);
2212 if (pSource
&& pOldArray
->GetRefCount() > 1)
2213 // tdf#134692: old array will stay alive after the redim - we need to copy deep
2214 pSource
= new SbxVariable(*pSource
);
2215 pNewArray
->Put32(pSource
, pActualIndices
);
2220 // Returns true when actually restored
2221 static bool implRestorePreservedArray(SbxDimArray
* pNewArray
, SbxArrayRef
& rrefRedimpArray
, bool* pbWasError
= nullptr)
2224 bool bResult
= false;
2226 *pbWasError
= false;
2227 if (rrefRedimpArray
)
2229 SbxDimArray
* pOldArray
= static_cast<SbxDimArray
*>(rrefRedimpArray
.get());
2230 const sal_Int32 nDimsNew
= pNewArray
->GetDims32();
2231 const sal_Int32 nDimsOld
= pOldArray
->GetDims32();
2233 if (nDimsOld
!= nDimsNew
)
2235 StarBASIC::Error(ERRCODE_BASIC_OUT_OF_RANGE
);
2239 else if (nDimsNew
> 0)
2241 // Store dims to use them for copying later
2242 std::unique_ptr
<sal_Int32
[]> pLowerBounds(new sal_Int32
[nDimsNew
]);
2243 std::unique_ptr
<sal_Int32
[]> pUpperBounds(new sal_Int32
[nDimsNew
]);
2244 std::unique_ptr
<sal_Int32
[]> pActualIndices(new sal_Int32
[nDimsNew
]);
2245 bool bNeedsPreallocation
= true;
2248 for (sal_Int32 i
= 1; i
<= nDimsNew
; i
++)
2250 sal_Int32 lBoundNew
, uBoundNew
;
2251 sal_Int32 lBoundOld
, uBoundOld
;
2252 pNewArray
->GetDim32(i
, lBoundNew
, uBoundNew
);
2253 pOldArray
->GetDim32(i
, lBoundOld
, uBoundOld
);
2254 lBoundNew
= std::max(lBoundNew
, lBoundOld
);
2255 uBoundNew
= std::min(uBoundNew
, uBoundOld
);
2256 sal_Int32 j
= i
- 1;
2257 pActualIndices
[j
] = pLowerBounds
[j
] = lBoundNew
;
2258 pUpperBounds
[j
] = uBoundNew
;
2259 if (lBoundNew
> uBoundNew
) // No elements in the dimension -> no elements to restore
2260 bNeedsPreallocation
= false;
2263 // Optimization: pre-allocate underlying container
2264 if (bNeedsPreallocation
)
2265 pNewArray
->Put32(nullptr, pUpperBounds
.get());
2267 // Copy data from old array by going recursively through all dimensions
2268 // (It would be faster to work on the flat internal data array of an
2269 // SbyArray but this solution is clearer and easier)
2270 implCopyDimArray(pNewArray
, pOldArray
, nDimsNew
- 1, 0, pActualIndices
.get(),
2271 pLowerBounds
.get(), pUpperBounds
.get());
2275 rrefRedimpArray
.clear();
2281 // TOS = variable for the array
2282 // argv = dimension information
2284 void SbiRuntime::StepREDIMP()
2286 SbxVariableRef refVar
= PopVar();
2289 // Now check, if we can copy from the old array
2290 if( refRedimpArray
.is() )
2292 if (SbxDimArray
* pNewArray
= dynamic_cast<SbxDimArray
*>(refVar
->GetObject()))
2293 implRestorePreservedArray(pNewArray
, refRedimpArray
);
2298 // TOS = Array-Variable, Reference to array is copied
2299 // Variable is cleared as in ERASE
2301 void SbiRuntime::StepREDIMP_ERASE()
2303 SbxVariableRef refVar
= PopVar();
2305 SbxDataType eType
= refVar
->GetType();
2306 if( eType
& SbxARRAY
)
2308 SbxBase
* pElemObj
= refVar
->GetObject();
2309 SbxDimArray
* pDimArray
= dynamic_cast<SbxDimArray
*>( pElemObj
);
2312 refRedimpArray
= pDimArray
;
2316 else if( refVar
->IsFixed() )
2322 refVar
->SetType( SbxEMPTY
);
2326 static void lcl_clearImpl( SbxVariableRef
const & refVar
, SbxDataType
const & eType
)
2328 SbxFlagBits nSavFlags
= refVar
->GetFlags();
2329 refVar
->ResetFlag( SbxFlagBits::Fixed
);
2330 refVar
->SetType( SbxDataType(eType
& 0x0FFF) );
2331 refVar
->SetFlags( nSavFlags
);
2335 static void lcl_eraseImpl( SbxVariableRef
const & refVar
, bool bVBAEnabled
)
2337 SbxDataType eType
= refVar
->GetType();
2338 if( eType
& SbxARRAY
)
2342 SbxBase
* pElemObj
= refVar
->GetObject();
2343 SbxDimArray
* pDimArray
= dynamic_cast<SbxDimArray
*>( pElemObj
);
2346 if ( pDimArray
->hasFixedSize() )
2348 // Clear all Value(s)
2349 pDimArray
->SbxArray::Clear();
2353 pDimArray
->Clear(); // clear dims and values
2358 SbxArray
* pArray
= dynamic_cast<SbxArray
*>( pElemObj
);
2367 // Arrays have on an erase to VB quite a complex behaviour. Here are
2368 // only the type problems at REDIM (#26295) removed at first:
2369 // Set type hard onto the array-type, because a variable with array is
2370 // SbxOBJECT. At REDIM there's an SbxOBJECT-array generated then and
2371 // the original type is lost -> runtime error
2372 lcl_clearImpl( refVar
, eType
);
2375 else if( refVar
->IsFixed() )
2381 refVar
->SetType( SbxEMPTY
);
2388 void SbiRuntime::StepERASE()
2390 SbxVariableRef refVar
= PopVar();
2391 lcl_eraseImpl( refVar
, bVBAEnabled
);
2394 void SbiRuntime::StepERASE_CLEAR()
2396 refRedim
= PopVar();
2399 void SbiRuntime::StepARRAYACCESS()
2403 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2405 SbxVariableRef refVar
= PopVar();
2406 refVar
->SetParameters( refArgv
.get() );
2408 PushVar( CheckArray( refVar
.get() ) );
2411 void SbiRuntime::StepBYVAL()
2413 // Copy variable on stack to break call by reference
2414 SbxVariableRef pVar
= PopVar();
2415 SbxDataType t
= pVar
->GetType();
2417 SbxVariable
* pCopyVar
= new SbxVariable( t
);
2418 pCopyVar
->SetFlag( SbxFlagBits::ReadWrite
);
2421 PushVar( pCopyVar
);
2424 // establishing an argv
2425 // nOp1 stays as it is -> 1st element is the return value
2427 void SbiRuntime::StepARGC()
2430 refArgv
= new SbxArray
;
2434 // storing an argument in Argv
2436 void SbiRuntime::StepARGV()
2440 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2444 SbxVariableRef pVal
= PopVar();
2446 // Before fix of #94916:
2447 if( dynamic_cast<const SbxMethod
*>( pVal
.get() ) != nullptr
2448 || dynamic_cast<const SbUnoProperty
*>( pVal
.get() ) != nullptr
2449 || dynamic_cast<const SbProcedureProperty
*>( pVal
.get() ) != nullptr )
2451 // evaluate methods and properties!
2452 SbxVariable
* pRes
= new SbxVariable( *pVal
);
2455 refArgv
->Put32( pVal
.get(), nArgc
++ );
2459 // Input to Variable. The variable is on TOS and is
2460 // is removed afterwards.
2461 void SbiRuntime::StepINPUT()
2467 while( ( err
= pIosys
->GetError() ) == ERRCODE_NONE
)
2469 ch
= pIosys
->Read();
2470 if( ch
!= ' ' && ch
!= '\t' && ch
!= '\n' )
2477 // Scan until comma or whitespace
2478 char sep
= ( ch
== '"' ) ? ch
: 0;
2481 ch
= pIosys
->Read();
2483 while( ( err
= pIosys
->GetError() ) == ERRCODE_NONE
)
2487 ch
= pIosys
->Read();
2493 else if( !sep
&& (ch
== ',' || ch
== '\n') )
2498 ch
= pIosys
->Read();
2501 if( ch
== ' ' || ch
== '\t' )
2503 while( ( err
= pIosys
->GetError() ) == ERRCODE_NONE
)
2505 if( ch
!= ' ' && ch
!= '\t' && ch
!= '\n' )
2509 ch
= pIosys
->Read();
2515 OUString s
= sin
.makeStringAndClear();
2516 SbxVariableRef pVar
= GetTOS();
2517 // try to fill the variable with a numeric value first,
2518 // then with a string value
2519 if( !pVar
->IsFixed() || pVar
->IsNumeric() )
2521 sal_uInt16 nLen
= 0;
2522 if( !pVar
->Scan( s
, &nLen
) )
2524 err
= SbxBase::GetError();
2525 SbxBase::ResetError();
2527 // the value has to be scanned in completely
2528 else if( nLen
!= s
.getLength() && !pVar
->PutString( s
) )
2530 err
= SbxBase::GetError();
2531 SbxBase::ResetError();
2533 else if( nLen
!= s
.getLength() && pVar
->IsNumeric() )
2535 err
= SbxBase::GetError();
2536 SbxBase::ResetError();
2539 err
= ERRCODE_BASIC_CONVERSION
;
2545 pVar
->PutString( s
);
2546 err
= SbxBase::GetError();
2547 SbxBase::ResetError();
2550 if( err
== ERRCODE_BASIC_USER_ABORT
)
2556 if( pRestart
&& !pIosys
->GetChannel() )
2571 // Line Input to Variable. The variable is on TOS and is
2572 // deleted afterwards.
2574 void SbiRuntime::StepLINPUT()
2577 pIosys
->Read( aInput
);
2578 Error( pIosys
->GetError() );
2579 SbxVariableRef p
= PopVar();
2580 p
->PutString(OStringToOUString(aInput
, osl_getThreadTextEncoding()));
2585 void SbiRuntime::StepSTOP()
2591 void SbiRuntime::StepINITFOR()
2596 void SbiRuntime::StepINITFOREACH()
2601 // increment FOR-variable
2603 void SbiRuntime::StepNEXT()
2607 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2610 if (pForStk
->eForType
!= ForType::To
)
2612 if (!pForStk
->refVar
)
2614 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2617 // tdf#85371 - grant explicitly write access to the index variable
2618 // since it could be the name of a method itself used in the next statement.
2619 ScopedWritableGuard
aGuard(pForStk
->refVar
, pForStk
->refVar
.get() == pMeth
);
2620 pForStk
->refVar
->Compute( SbxPLUS
, *pForStk
->refInc
);
2623 // beginning CASE: TOS in CASE-stack
2625 void SbiRuntime::StepCASE()
2627 if( !refCaseStk
.is() )
2629 refCaseStk
= new SbxArray
;
2631 SbxVariableRef xVar
= PopVar();
2632 refCaseStk
->Put32( xVar
.get(), refCaseStk
->Count32() );
2635 // end CASE: free variable
2637 void SbiRuntime::StepENDCASE()
2639 if( !refCaseStk
.is() || !refCaseStk
->Count32() )
2641 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2645 refCaseStk
->Remove( refCaseStk
->Count32() - 1 );
2650 void SbiRuntime::StepSTDERROR()
2652 pError
= nullptr; bError
= true;
2653 pInst
->aErrorMsg
.clear();
2654 pInst
->nErr
= ERRCODE_NONE
;
2656 nError
= ERRCODE_NONE
;
2657 SbxErrObject::getUnoErrObject()->Clear();
2660 void SbiRuntime::StepNOERROR()
2662 pInst
->aErrorMsg
.clear();
2663 pInst
->nErr
= ERRCODE_NONE
;
2665 nError
= ERRCODE_NONE
;
2666 SbxErrObject::getUnoErrObject()->Clear();
2672 void SbiRuntime::StepLEAVE()
2675 // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
2676 if ( bInError
&& pError
)
2678 SbxErrObject::getUnoErrObject()->Clear();
2682 void SbiRuntime::StepCHANNEL() // TOS = channel number
2684 SbxVariableRef pChan
= PopVar();
2685 short nChan
= pChan
->GetInteger();
2686 pIosys
->SetChannel( nChan
);
2687 Error( pIosys
->GetError() );
2690 void SbiRuntime::StepCHANNEL0()
2692 pIosys
->ResetChannel();
2695 void SbiRuntime::StepPRINT() // print TOS
2697 SbxVariableRef p
= PopVar();
2698 OUString s1
= p
->GetOUString();
2700 if( p
->GetType() >= SbxINTEGER
&& p
->GetType() <= SbxDOUBLE
)
2702 s
= " "; // one blank before
2706 Error( pIosys
->GetError() );
2709 void SbiRuntime::StepPRINTF() // print TOS in field
2711 SbxVariableRef p
= PopVar();
2712 OUString s1
= p
->GetOUString();
2714 if( p
->GetType() >= SbxINTEGER
&& p
->GetType() <= SbxDOUBLE
)
2719 comphelper::string::padToLength(s
, 14, ' ');
2720 pIosys
->Write( s
.makeStringAndClear() );
2721 Error( pIosys
->GetError() );
2724 void SbiRuntime::StepWRITE() // write TOS
2726 SbxVariableRef p
= PopVar();
2727 // Does the string have to be encapsulated?
2729 switch (p
->GetType() )
2731 case SbxSTRING
: ch
= '"'; break;
2734 case SbxDATE
: ch
= '#'; break;
2742 s
+= p
->GetOUString();
2748 Error( pIosys
->GetError() );
2751 void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos
2753 SbxVariableRef pTos1
= PopVar();
2754 SbxVariableRef pTos
= PopVar();
2755 OUString aDest
= pTos1
->GetOUString();
2756 OUString aSource
= pTos
->GetOUString();
2760 implStepRenameUCB( aSource
, aDest
);
2764 implStepRenameOSL( aSource
, aDest
);
2770 void SbiRuntime::StepPROMPT()
2772 SbxVariableRef p
= PopVar();
2773 OString
aStr(OUStringToOString(p
->GetOUString(), osl_getThreadTextEncoding()));
2774 pIosys
->SetPrompt( aStr
);
2777 // Set Restart point
2779 void SbiRuntime::StepRESTART()
2784 // empty expression on stack for missing parameter
2786 void SbiRuntime::StepEMPTY()
2788 // #57915 The semantics of StepEMPTY() is the representation of a missing argument.
2789 // This is represented by the value 448 (ERRCODE_BASIC_NAMED_NOT_FOUND) of the type error
2790 // in VB. StepEmpty should now rather be named StepMISSING() but the name is kept
2791 // to simplify matters.
2792 SbxVariableRef xVar
= new SbxVariable( SbxVARIANT
);
2793 xVar
->PutErr( 448 );
2794 // tdf#79426, tdf#125180 - add additional information about a missing parameter
2795 SetIsMissing( xVar
.get() );
2796 PushVar( xVar
.get() );
2801 void SbiRuntime::StepERROR()
2803 SbxVariableRef refCode
= PopVar();
2804 sal_uInt16 n
= refCode
->GetUShort();
2805 ErrCode error
= StarBASIC::GetSfxFromVBError( n
);
2808 pInst
->Error( error
);
2816 // loading a numeric constant (+ID)
2818 void SbiRuntime::StepLOADNC( sal_uInt32 nOp1
)
2820 // #57844 use localized function
2821 OUString aStr
= pImg
->GetString( static_cast<short>( nOp1
) );
2823 sal_Int32 iComma
= aStr
.indexOf(',');
2826 aStr
= aStr
.replaceAt(iComma
, 1, ".");
2828 sal_Int32 nParseEnd
= 0;
2829 rtl_math_ConversionStatus eStatus
= rtl_math_ConversionStatus_Ok
;
2830 double n
= ::rtl::math::stringToDouble( aStr
, '.', ',', &eStatus
, &nParseEnd
);
2832 // tdf#131296 - retrieve data type put in SbiExprNode::Gen
2833 SbxDataType eType
= SbxDOUBLE
;
2834 if ( nParseEnd
< aStr
.getLength() )
2836 switch ( aStr
[nParseEnd
] )
2838 // See GetSuffixType in basic/source/comp/scanner.cxx for type characters
2839 case '%': eType
= SbxINTEGER
; break;
2840 case '&': eType
= SbxLONG
; break;
2841 case '!': eType
= SbxSINGLE
; break;
2842 case '@': eType
= SbxCURRENCY
; break;
2845 SbxVariable
* p
= new SbxVariable( eType
);
2847 // tdf#133913 - create variable with Variant/Type in order to prevent type conversion errors
2848 p
->ResetFlag( SbxFlagBits::Fixed
);
2852 // loading a string constant (+ID)
2854 void SbiRuntime::StepLOADSC( sal_uInt32 nOp1
)
2856 SbxVariable
* p
= new SbxVariable
;
2857 p
->PutString( pImg
->GetString( static_cast<short>( nOp1
) ) );
2861 // Immediate Load (+value)
2862 // The opcode is not generated in SbiExprNode::Gen anymore; used for legacy images
2864 void SbiRuntime::StepLOADI( sal_uInt32 nOp1
)
2866 SbxVariable
* p
= new SbxVariable
;
2867 p
->PutInteger( static_cast<sal_Int16
>( nOp1
) );
2871 // store a named argument in Argv (+Arg-no. from 1!)
2873 void SbiRuntime::StepARGN( sal_uInt32 nOp1
)
2876 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2879 OUString
aAlias( pImg
->GetString( static_cast<short>( nOp1
) ) );
2880 SbxVariableRef pVal
= PopVar();
2882 ( dynamic_cast<const SbxMethod
*>( pVal
.get()) != nullptr
2883 || dynamic_cast<const SbUnoProperty
*>( pVal
.get()) != nullptr
2884 || dynamic_cast<const SbProcedureProperty
*>( pVal
.get()) != nullptr ) )
2886 // named variables ( that are Any especially properties ) can be empty at this point and need a broadcast
2887 if ( pVal
->GetType() == SbxEMPTY
)
2888 pVal
->Broadcast( SfxHintId::BasicDataWanted
);
2889 // evaluate methods and properties!
2890 SbxVariable
* pRes
= new SbxVariable( *pVal
);
2893 refArgv
->Put32( pVal
.get(), nArgc
);
2894 refArgv
->PutAlias32( aAlias
, nArgc
++ );
2898 // converting the type of an argument in Argv for DECLARE-Fkt. (+type)
2900 void SbiRuntime::StepARGTYP( sal_uInt32 nOp1
)
2903 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2906 bool bByVal
= (nOp1
& 0x8000) != 0; // Is BYVAL requested?
2907 SbxDataType t
= static_cast<SbxDataType
>(nOp1
& 0x7FFF);
2908 SbxVariable
* pVar
= refArgv
->Get32( refArgv
->Count32() - 1 ); // last Arg
2911 if( pVar
->GetRefCount() > 2 ) // 2 is normal for BYVAL
2913 // parameter is a reference
2916 // Call by Value is requested -> create a copy
2917 pVar
= new SbxVariable( *pVar
);
2918 pVar
->SetFlag( SbxFlagBits::ReadWrite
);
2919 refExprStk
->Put32( pVar
, refArgv
->Count32() - 1 );
2922 pVar
->SetFlag( SbxFlagBits::Reference
); // Ref-Flag for DllMgr
2926 // parameter is NO reference
2928 pVar
->ResetFlag( SbxFlagBits::Reference
); // no reference -> OK
2930 Error( ERRCODE_BASIC_BAD_PARAMETERS
); // reference needed
2933 if( pVar
->GetType() != t
)
2935 // variant for correct conversion
2936 // besides error, if SbxBYREF
2937 pVar
->Convert( SbxVARIANT
);
2943 // bring string to a definite length (+length)
2945 void SbiRuntime::StepPAD( sal_uInt32 nOp1
)
2947 SbxVariable
* p
= GetTOS();
2948 OUString s
= p
->GetOUString();
2949 sal_Int32
nLen(nOp1
);
2950 if( s
.getLength() == nLen
)
2953 OUStringBuffer
aBuf(s
);
2954 if (aBuf
.getLength() > nLen
)
2956 comphelper::string::truncateToLength(aBuf
, nLen
);
2960 comphelper::string::padToLength(aBuf
, nLen
, ' ');
2962 s
= aBuf
.makeStringAndClear();
2967 void SbiRuntime::StepJUMP( sal_uInt32 nOp1
)
2970 // #QUESTION shouldn't this be
2971 // if( (sal_uInt8*)( nOp1+pImagGetCode() ) >= pImg->GetCodeSize() )
2972 if( nOp1
>= pImg
->GetCodeSize() )
2973 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2975 pCode
= reinterpret_cast<const sal_uInt8
*>(pImg
->GetCode()) + nOp1
;
2978 // evaluate TOS, conditional jump (+target)
2980 void SbiRuntime::StepJUMPT( sal_uInt32 nOp1
)
2982 SbxVariableRef p
= PopVar();
2987 // evaluate TOS, conditional jump (+target)
2989 void SbiRuntime::StepJUMPF( sal_uInt32 nOp1
)
2991 SbxVariableRef p
= PopVar();
2992 // In a test e.g. If Null then
2993 // will evaluate Null will act as if False
2994 if( ( bVBAEnabled
&& p
->IsNull() ) || !p
->GetBool() )
2998 // evaluate TOS, jump into JUMP-table (+MaxVal)
3004 // if 0x8000 is set in the operand, push the return address (ON..GOSUB)
3006 void SbiRuntime::StepONJUMP( sal_uInt32 nOp1
)
3008 SbxVariableRef p
= PopVar();
3009 sal_Int16 n
= p
->GetInteger();
3013 PushGosub( pCode
+ 5 * nOp1
);
3015 if( n
< 1 || o3tl::make_unsigned(n
) > nOp1
)
3016 n
= static_cast<sal_Int16
>( nOp1
+ 1 );
3017 nOp1
= static_cast<sal_uInt32
>( reinterpret_cast<const char*>(pCode
) - pImg
->GetCode() ) + 5 * --n
;
3021 // UP-call (+target)
3023 void SbiRuntime::StepGOSUB( sal_uInt32 nOp1
)
3026 if( nOp1
>= pImg
->GetCodeSize() )
3027 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
3028 pCode
= reinterpret_cast<const sal_uInt8
*>(pImg
->GetCode()) + nOp1
;
3031 // UP-return (+0 or target)
3033 void SbiRuntime::StepRETURN( sal_uInt32 nOp1
)
3040 // check FOR-variable (+Endlabel)
3042 void SbiRuntime::StepTESTFOR( sal_uInt32 nOp1
)
3046 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
3050 bool bEndLoop
= false;
3051 switch( pForStk
->eForType
)
3055 SbxOperator eOp
= ( pForStk
->refInc
->GetDouble() < 0 ) ? SbxLT
: SbxGT
;
3056 if( pForStk
->refVar
->Compare( eOp
, *pForStk
->refEnd
) )
3058 if (SbxBase::IsError())
3059 pForStk
->eForType
= ForType::Error
; // terminate loop at the next iteration
3062 case ForType::EachArray
:
3064 SbiForStack
* p
= pForStk
;
3067 SbxBase::SetError(ERRCODE_BASIC_CONVERSION
);
3068 pForStk
->eForType
= ForType::Error
; // terminate loop at the next iteration
3070 else if (p
->pArrayCurIndices
== nullptr)
3076 SbxDimArray
* pArray
= reinterpret_cast<SbxDimArray
*>(p
->refEnd
.get());
3077 sal_Int32 nDims
= pArray
->GetDims32();
3080 if( nDims
== 1 && p
->pArrayLowerBounds
[0] > p
->pArrayUpperBounds
[0] )
3085 SbxVariable
* pVal
= pArray
->Get32( p
->pArrayCurIndices
.get() );
3086 *(p
->refVar
) = *pVal
;
3088 bool bFoundNext
= false;
3089 for(sal_Int32 i
= 0 ; i
< nDims
; i
++ )
3091 if( p
->pArrayCurIndices
[i
] < p
->pArrayUpperBounds
[i
] )
3094 p
->pArrayCurIndices
[i
]++;
3095 for( sal_Int32 j
= i
- 1 ; j
>= 0 ; j
-- )
3096 p
->pArrayCurIndices
[j
] = p
->pArrayLowerBounds
[j
];
3102 p
->pArrayCurIndices
.reset();
3107 case ForType::EachCollection
:
3109 if (!pForStk
->refEnd
)
3111 SbxBase::SetError(ERRCODE_BASIC_CONVERSION
);
3112 pForStk
->eForType
= ForType::Error
; // terminate loop at the next iteration
3116 BasicCollection
* pCollection
= static_cast<BasicCollection
*>(pForStk
->refEnd
.get());
3117 SbxArrayRef xItemArray
= pCollection
->xItemArray
;
3118 sal_Int32 nCount
= xItemArray
->Count32();
3119 if( pForStk
->nCurCollectionIndex
< nCount
)
3121 SbxVariable
* pRes
= xItemArray
->Get32( pForStk
->nCurCollectionIndex
);
3122 pForStk
->nCurCollectionIndex
++;
3123 (*pForStk
->refVar
) = *pRes
;
3131 case ForType::EachXEnumeration
:
3133 SbiForStack
* p
= pForStk
;
3134 if (!p
->xEnumeration
)
3136 SbxBase::SetError(ERRCODE_BASIC_CONVERSION
);
3137 pForStk
->eForType
= ForType::Error
; // terminate loop at the next iteration
3139 else if (p
->xEnumeration
->hasMoreElements())
3141 Any aElem
= p
->xEnumeration
->nextElement();
3142 SbxVariableRef xVar
= new SbxVariable( SbxVARIANT
);
3143 unoToSbxValue( xVar
.get(), aElem
);
3144 (*pForStk
->refVar
) = *xVar
;
3152 case ForType::Error
:
3154 // We are in Resume Next mode after failed loop initialization
3156 Error(ERRCODE_BASIC_BAD_PARAMETER
);
3167 // Tos+1 <= Tos+2 <= Tos, 2xremove (+Target)
3169 void SbiRuntime::StepCASETO( sal_uInt32 nOp1
)
3171 if( !refCaseStk
.is() || !refCaseStk
->Count32() )
3172 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
3175 SbxVariableRef xTo
= PopVar();
3176 SbxVariableRef xFrom
= PopVar();
3177 SbxVariableRef xCase
= refCaseStk
->Get32( refCaseStk
->Count32() - 1 );
3178 if( *xCase
>= *xFrom
&& *xCase
<= *xTo
)
3184 void SbiRuntime::StepERRHDL( sal_uInt32 nOp1
)
3186 const sal_uInt8
* p
= pCode
;
3190 pInst
->aErrorMsg
.clear();
3191 pInst
->nErr
= ERRCODE_NONE
;
3193 nError
= ERRCODE_NONE
;
3194 SbxErrObject::getUnoErrObject()->Clear();
3197 // Resume after errors (+0=statement, 1=next or Label)
3199 void SbiRuntime::StepRESUME( sal_uInt32 nOp1
)
3201 // #32714 Resume without error? -> error
3204 Error( ERRCODE_BASIC_BAD_RESUME
);
3209 // set Code-pointer to the next statement
3211 pCode
= pMod
->FindNextStmnt( pErrCode
, n1
, n2
, true, pImg
);
3215 if ( pError
) // current in error handler ( and got a Resume Next statement )
3216 SbxErrObject::getUnoErrObject()->Clear();
3220 pInst
->aErrorMsg
.clear();
3221 pInst
->nErr
= ERRCODE_NONE
;
3223 nError
= ERRCODE_NONE
;
3227 // close channel (+channel, 0=all)
3228 void SbiRuntime::StepCLOSE( sal_uInt32 nOp1
)
3235 err
= pIosys
->GetError();
3241 err
= pIosys
->GetError();
3245 // output character (+char)
3247 void SbiRuntime::StepPRCHAR( sal_uInt32 nOp1
)
3249 OUString
s(static_cast<sal_Unicode
>(nOp1
));
3251 Error( pIosys
->GetError() );
3254 // check whether TOS is a certain object class (+StringID)
3256 bool SbiRuntime::implIsClass( SbxObject
const * pObj
, const OUString
& aClass
)
3260 if( !aClass
.isEmpty() )
3262 bRet
= pObj
->IsClass( aClass
);
3264 bRet
= aClass
.equalsIgnoreAsciiCase( "object" );
3267 const OUString
& aObjClass
= pObj
->GetClassName();
3268 SbModule
* pClassMod
= GetSbData()->pClassFac
->FindClass( aObjClass
);
3271 SbClassData
* pClassData
= pClassMod
->pClassData
.get();
3272 if (pClassData
!= nullptr )
3274 SbxVariable
* pClassVar
= pClassData
->mxIfaces
->Find( aClass
, SbxClassType::DontCare
);
3275 bRet
= (pClassVar
!= nullptr);
3283 bool SbiRuntime::checkClass_Impl( const SbxVariableRef
& refVal
,
3284 const OUString
& aClass
, bool bRaiseErrors
, bool bDefault
)
3286 bool bOk
= bDefault
;
3288 SbxDataType t
= refVal
->GetType();
3289 SbxVariable
* pVal
= refVal
.get();
3290 // we don't know the type of uno properties that are (maybevoid)
3291 if ( t
== SbxEMPTY
)
3293 if ( auto pProp
= dynamic_cast<SbUnoProperty
*>( refVal
.get() ) )
3295 t
= pProp
->getRealType();
3298 if( t
== SbxOBJECT
|| bVBAEnabled
)
3300 SbxObject
* pObj
= dynamic_cast<SbxObject
*>(pVal
);
3303 pObj
= dynamic_cast<SbxObject
*>(refVal
->GetObject());
3307 if( !implIsClass( pObj
, aClass
) )
3309 SbUnoObject
* pUnoObj(nullptr);
3310 if (bVBAEnabled
|| CodeCompleteOptions::IsExtendedTypeDeclaration())
3312 pUnoObj
= dynamic_cast<SbUnoObject
*>(pObj
);
3316 bOk
= checkUnoObjectType(*pUnoObj
, aClass
);
3319 if ( !bOk
&& bRaiseErrors
)
3320 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
3326 SbClassModuleObject
* pClassModuleObject
= dynamic_cast<SbClassModuleObject
*>( pObj
);
3327 if( pClassModuleObject
!= nullptr )
3328 pClassModuleObject
->triggerInitializeEvent();
3335 Error( ERRCODE_BASIC_NEEDS_OBJECT
);
3341 void SbiRuntime::StepSETCLASS_impl( sal_uInt32 nOp1
, bool bHandleDflt
)
3343 SbxVariableRef refVal
= PopVar();
3344 SbxVariableRef refVar
= PopVar();
3345 OUString
aClass( pImg
->GetString( static_cast<short>( nOp1
) ) );
3347 bool bOk
= checkClass_Impl( refVal
, aClass
, true, true );
3350 StepSET_Impl( refVal
, refVar
, bHandleDflt
); // don't do handle default prop for a "proper" set
3354 void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1
)
3356 StepSETCLASS_impl( nOp1
, false );
3359 void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1
)
3361 StepSETCLASS_impl( nOp1
, true );
3364 void SbiRuntime::StepTESTCLASS( sal_uInt32 nOp1
)
3366 SbxVariableRef xObjVal
= PopVar();
3367 OUString
aClass( pImg
->GetString( static_cast<short>( nOp1
) ) );
3368 bool bDefault
= !bVBAEnabled
;
3369 bool bOk
= checkClass_Impl( xObjVal
, aClass
, false, bDefault
);
3371 SbxVariable
* pRet
= new SbxVariable
;
3372 pRet
->PutBool( bOk
);
3376 // define library for following declare-call
3378 void SbiRuntime::StepLIB( sal_uInt32 nOp1
)
3380 aLibName
= pImg
->GetString( static_cast<short>( nOp1
) );
3383 // TOS is incremented by BASE, BASE is pushed before (+BASE)
3384 // This opcode is pushed before DIM/REDIM-commands,
3385 // if there's been only one index named.
3387 void SbiRuntime::StepBASED( sal_uInt32 nOp1
)
3389 SbxVariable
* p1
= new SbxVariable
;
3390 SbxVariableRef x2
= PopVar();
3392 // #109275 Check compatibility mode
3393 bool bCompatible
= ((nOp1
& 0x8000) != 0);
3394 sal_uInt16 uBase
= static_cast<sal_uInt16
>(nOp1
& 1); // Can only be 0 or 1
3395 p1
->PutInteger( uBase
);
3398 // tdf#85371 - grant explicitly write access to the dimension variable
3399 // since in Star/OpenOffice Basic the upper index border is affected,
3400 // and the dimension variable could be the name of the method itself.
3401 ScopedWritableGuard
aGuard(x2
, x2
.get() == pMeth
);
3402 x2
->Compute( SbxPLUS
, *p1
);
3404 PushVar( x2
.get() ); // first the Expr
3405 PushVar( p1
); // then the Base
3408 // the bits in the String-ID:
3409 // 0x8000 - Argv is reserved
3411 SbxVariable
* SbiRuntime::FindElement( SbxObject
* pObj
, sal_uInt32 nOp1
, sal_uInt32 nOp2
,
3412 ErrCode nNotFound
, bool bLocal
, bool bStatic
)
3414 bool bIsVBAInterOp
= SbiRuntime::isVBAEnabled();
3417 StarBASIC
* pMSOMacroRuntimeLib
= GetSbData()->pMSOMacroRuntimLib
;
3418 if( pMSOMacroRuntimeLib
!= nullptr )
3420 pMSOMacroRuntimeLib
->ResetFlag( SbxFlagBits::ExtSearch
);
3424 SbxVariable
* pElem
= nullptr;
3427 Error( ERRCODE_BASIC_NO_OBJECT
);
3428 pElem
= new SbxVariable
;
3432 bool bFatalError
= false;
3433 SbxDataType t
= static_cast<SbxDataType
>(nOp2
);
3434 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
& 0x7FFF ) ) );
3435 // Hacky capture of Evaluate [] syntax
3436 // this should be tackled I feel at the pcode level
3437 if ( bIsVBAInterOp
&& aName
.startsWith("[") )
3439 // emulate pcode here
3441 // pseudo StepLOADSC
3442 OUString sArg
= aName
.copy( 1, aName
.getLength() - 2 );
3443 SbxVariable
* p
= new SbxVariable
;
3444 p
->PutString( sArg
);
3447 nOp1
= nOp1
| 0x8000; // indicate params are present
3452 if ( bStatic
&& pMeth
)
3454 pElem
= pMeth
->GetStatics()->Find( aName
, SbxClassType::DontCare
);
3459 pElem
= refLocals
->Find( aName
, SbxClassType::DontCare
);
3464 bool bSave
= rBasic
.bNoRtl
;
3465 rBasic
.bNoRtl
= true;
3466 pElem
= pObj
->Find( aName
, SbxClassType::DontCare
);
3468 // #110004, #112015: Make private really private
3469 if( bLocal
&& pElem
) // Local as flag for global search
3471 if( pElem
->IsSet( SbxFlagBits::Private
) )
3473 SbiInstance
* pInst_
= GetSbData()->pInst
;
3474 if( pInst_
&& pInst_
->IsCompatibility() && pObj
!= pElem
->GetParent() )
3476 pElem
= nullptr; // Found but in wrong module!
3478 // Interfaces: Use SbxFlagBits::ExtFound
3481 rBasic
.bNoRtl
= bSave
;
3483 // is it a global uno-identifier?
3484 if( bLocal
&& !pElem
)
3486 bool bSetName
= true; // preserve normal behaviour
3488 // i#i68894# if VBAInterOp favour searching vba globals
3489 // over searching for uno classes
3492 // Try Find in VBA symbols space
3493 pElem
= rBasic
.VBAFind( aName
, SbxClassType::DontCare
);
3496 bSetName
= false; // don't overwrite uno name
3500 pElem
= VBAConstantHelper::instance().getVBAConstant( aName
);
3506 // #72382 ATTENTION! ALWAYS returns a result now
3507 // because of unknown modules!
3508 SbUnoClass
* pUnoClass
= findUnoClass( aName
);
3511 pElem
= new SbxVariable( t
);
3512 SbxValues
aRes( SbxOBJECT
);
3513 aRes
.pObj
= pUnoClass
;
3514 pElem
->SbxVariable::Put( aRes
);
3518 // #62939 If a uno-class has been found, the wrapper
3519 // object has to be held, because the uno-class, e. g.
3520 // "stardiv", has to be read out of the registry
3521 // every time again otherwise
3524 // #63774 May not be saved too!!!
3525 pElem
->SetFlag( SbxFlagBits::DontStore
);
3526 pElem
->SetFlag( SbxFlagBits::NoModify
);
3528 // #72382 save locally, all variables that have been declared
3529 // implicit would become global automatically otherwise!
3532 pElem
->SetName( aName
);
3534 refLocals
->Put32( pElem
, refLocals
->Count32() );
3540 // not there and not in the object?
3541 // don't establish if that thing has parameters!
3547 // else, if there are parameters, use different error code
3548 if( !bLocal
|| pImg
->IsFlag( SbiImageFlags::EXPLICIT
) )
3550 // #39108 if explicit and as ELEM always a fatal error
3554 if( !( nOp1
& 0x8000 ) && nNotFound
== ERRCODE_BASIC_PROC_UNDEFINED
)
3556 nNotFound
= ERRCODE_BASIC_VAR_UNDEFINED
;
3561 // #39108 use dummy variable instead of fatal error
3562 if( !xDummyVar
.is() )
3564 xDummyVar
= new SbxVariable( SbxVARIANT
);
3566 pElem
= xDummyVar
.get();
3570 Error( nNotFound
, aName
);
3576 pElem
= StepSTATIC_Impl( aName
, t
, 0 );
3580 pElem
= new SbxVariable( t
);
3581 if( t
!= SbxVARIANT
)
3583 pElem
->SetFlag( SbxFlagBits::Fixed
);
3585 pElem
->SetName( aName
);
3586 refLocals
->Put32( pElem
, refLocals
->Count32() );
3591 // #39108 Args can already be deleted!
3594 SetupArgs( pElem
, nOp1
);
3596 // because a particular call-type is requested
3597 if (SbxMethod
* pMethod
= dynamic_cast<SbxMethod
*>(pElem
))
3599 // shall the type be converted?
3600 SbxDataType t2
= pElem
->GetType();
3602 if( (pElem
->GetFlags() & SbxFlagBits::Fixed
) == SbxFlagBits::NONE
)
3604 if( t
!= SbxVARIANT
&& t
!= t2
&&
3605 t
>= SbxINTEGER
&& t
<= SbxSTRING
)
3607 pElem
->SetType( t
);
3611 // assign pElem to a Ref, to delete a temp-var if applicable
3612 SbxVariableRef xDeleteRef
= pElem
;
3614 // remove potential rests of the last call of the SbxMethod
3615 // free Write before, so that there's no error
3616 SbxFlagBits nSavFlags
= pElem
->GetFlags();
3617 pElem
->SetFlag( SbxFlagBits::ReadWrite
| SbxFlagBits::NoBroadcast
);
3618 pElem
->SbxValue::Clear();
3619 pElem
->SetFlags( nSavFlags
);
3621 // don't touch before setting, as e. g. LEFT()
3622 // has to know the difference between Left$() and Left()
3624 // because the methods' parameters are cut away in PopVar()
3625 SbxVariable
* pNew
= new SbxMethod(*pMethod
);
3626 //OLD: SbxVariable* pNew = new SbxVariable( *pElem );
3628 pElem
->SetParameters(nullptr);
3629 pNew
->SetFlag( SbxFlagBits::ReadWrite
);
3633 pElem
->SetType( t2
);
3637 // consider index-access for UnoObjects
3638 // definitely we want this for VBA where properties are often
3639 // collections ( which need index access ), but lets only do
3640 // this if we actually have params following
3641 else if( bVBAEnabled
&& dynamic_cast<const SbUnoProperty
*>( pElem
) != nullptr && pElem
->GetParameters() )
3643 SbxVariableRef xDeleteRef
= pElem
;
3645 // dissolve the notify while copying variable
3646 SbxVariable
* pNew
= new SbxVariable( *pElem
);
3647 pElem
->SetParameters( nullptr );
3651 return CheckArray( pElem
);
3654 // for current scope (e. g. query from BASIC-IDE)
3655 SbxBase
* SbiRuntime::FindElementExtern( const OUString
& rName
)
3657 // don't expect pMeth to be != 0, as there are none set
3658 // in the RunInit yet
3660 SbxVariable
* pElem
= nullptr;
3661 if( !pMod
|| rName
.isEmpty() )
3665 if( refLocals
.is() )
3667 pElem
= refLocals
->Find( rName
, SbxClassType::DontCare
);
3669 if ( !pElem
&& pMeth
)
3671 // for statics, set the method's name in front
3672 OUString aMethName
= pMeth
->GetName() + ":" + rName
;
3673 pElem
= pMod
->Find(aMethName
, SbxClassType::DontCare
);
3676 // search in parameter list
3677 if( !pElem
&& pMeth
)
3679 SbxInfo
* pInfo
= pMeth
->GetInfo();
3680 if( pInfo
&& refParams
.is() )
3682 sal_uInt32 nParamCount
= refParams
->Count32();
3683 assert(nParamCount
<= std::numeric_limits
<sal_uInt16
>::max());
3685 const SbxParamInfo
* pParam
= pInfo
->GetParam( j
);
3688 if( pParam
->aName
.equalsIgnoreAsciiCase( rName
) )
3690 if( j
>= nParamCount
)
3692 // Parameter is missing
3693 pElem
= new SbxVariable( SbxSTRING
);
3694 pElem
->PutString( "<missing parameter>");
3698 pElem
= refParams
->Get32( j
);
3702 pParam
= pInfo
->GetParam( ++j
);
3710 bool bSave
= rBasic
.bNoRtl
;
3711 rBasic
.bNoRtl
= true;
3712 pElem
= pMod
->Find( rName
, SbxClassType::DontCare
);
3713 rBasic
.bNoRtl
= bSave
;
3719 void SbiRuntime::SetupArgs( SbxVariable
* p
, sal_uInt32 nOp1
)
3725 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
3727 bool bHasNamed
= false;
3729 sal_uInt32 nArgCount
= refArgv
->Count32();
3730 for( i
= 1 ; i
< nArgCount
; i
++ )
3732 if( !refArgv
->GetAlias32(i
).isEmpty() )
3734 bHasNamed
= true; break;
3739 SbxInfo
* pInfo
= p
->GetInfo();
3742 bool bError_
= true;
3744 SbUnoMethod
* pUnoMethod
= dynamic_cast<SbUnoMethod
*>( p
);
3745 SbUnoProperty
* pUnoProperty
= dynamic_cast<SbUnoProperty
*>( p
);
3746 if( pUnoMethod
|| pUnoProperty
)
3748 SbUnoObject
* pParentUnoObj
= dynamic_cast<SbUnoObject
*>( p
->GetParent() );
3751 Any aUnoAny
= pParentUnoObj
->getUnoAny();
3752 Reference
< XInvocation
> xInvocation
;
3753 aUnoAny
>>= xInvocation
;
3754 if( xInvocation
.is() ) // TODO: if( xOLEAutomation.is() )
3758 sal_uInt32 nCurPar
= 1;
3759 AutomationNamedArgsSbxArray
* pArg
=
3760 new AutomationNamedArgsSbxArray( nArgCount
);
3761 OUString
* pNames
= pArg
->getNames().getArray();
3762 for( i
= 1 ; i
< nArgCount
; i
++ )
3764 SbxVariable
* pVar
= refArgv
->Get32( i
);
3765 OUString aName
= refArgv
->GetAlias32(i
);
3766 if (!aName
.isEmpty())
3770 pArg
->Put32( pVar
, nCurPar
++ );
3776 else if( bVBAEnabled
&& p
->GetType() == SbxOBJECT
&& (dynamic_cast<const SbxMethod
*>( p
) == nullptr || !p
->IsBroadcaster()) )
3778 // Check for default method with named parameters
3779 SbxBaseRef xObj
= p
->GetObject();
3780 if (SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>( xObj
.get() ))
3782 Any aAny
= pUnoObj
->getUnoAny();
3784 if( aAny
.getValueType().getTypeClass() == TypeClass_INTERFACE
)
3786 Reference
< XDefaultMethod
> xDfltMethod( aAny
, UNO_QUERY
);
3788 OUString sDefaultMethod
;
3789 if ( xDfltMethod
.is() )
3791 sDefaultMethod
= xDfltMethod
->getDefaultMethodName();
3793 if ( !sDefaultMethod
.isEmpty() )
3795 SbxVariable
* meth
= pUnoObj
->Find( sDefaultMethod
, SbxClassType::Method
);
3796 if( meth
!= nullptr )
3798 pInfo
= meth
->GetInfo();
3810 Error( ERRCODE_BASIC_NO_NAMED_ARGS
);
3815 sal_uInt32 nCurPar
= 1;
3816 SbxArray
* pArg
= new SbxArray
;
3817 for( i
= 1 ; i
< nArgCount
; i
++ )
3819 SbxVariable
* pVar
= refArgv
->Get32( i
);
3820 OUString aName
= refArgv
->GetAlias32(i
);
3821 if (!aName
.isEmpty())
3823 // nCurPar is set to the found parameter
3825 const SbxParamInfo
* pParam
= pInfo
->GetParam( j
);
3828 if( pParam
->aName
.equalsIgnoreAsciiCase( aName
) )
3833 pParam
= pInfo
->GetParam( ++j
);
3837 Error( ERRCODE_BASIC_NAMED_NOT_FOUND
); break;
3840 pArg
->Put32( pVar
, nCurPar
++ );
3845 // own var as parameter 0
3846 refArgv
->Put32( p
, 0 );
3847 p
->SetParameters( refArgv
.get() );
3852 p
->SetParameters( nullptr );
3856 // getting an array element
3858 SbxVariable
* SbiRuntime::CheckArray( SbxVariable
* pElem
)
3861 if( ( pElem
->GetType() & SbxARRAY
) && refRedim
.get() != pElem
)
3863 SbxBase
* pElemObj
= pElem
->GetObject();
3864 SbxDimArray
* pDimArray
= dynamic_cast<SbxDimArray
*>( pElemObj
);
3865 pPar
= pElem
->GetParameters();
3868 // parameters may be missing, if an array is
3869 // passed as an argument
3871 pElem
= pDimArray
->Get( pPar
);
3875 SbxArray
* pArray
= dynamic_cast<SbxArray
*>( pElemObj
);
3880 Error( ERRCODE_BASIC_OUT_OF_RANGE
);
3881 pElem
= new SbxVariable
;
3885 pElem
= pArray
->Get32( pPar
->Get32( 1 )->GetInteger() );
3890 // #42940, set parameter 0 to NULL so that var doesn't contain itself
3893 pPar
->Put32( nullptr, 0 );
3896 // consider index-access for UnoObjects
3897 else if( pElem
->GetType() == SbxOBJECT
&&
3898 dynamic_cast<const SbxMethod
*>( pElem
) == nullptr &&
3899 ( !bVBAEnabled
|| dynamic_cast<const SbxProperty
*>( pElem
) == nullptr ) )
3901 pPar
= pElem
->GetParameters();
3904 // is it a uno-object?
3905 SbxBaseRef pObj
= pElem
->GetObject();
3908 if (SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>( pObj
.get()))
3910 Any aAny
= pUnoObj
->getUnoAny();
3912 if( aAny
.getValueType().getTypeClass() == TypeClass_INTERFACE
)
3914 Reference
< XIndexAccess
> xIndexAccess( aAny
, UNO_QUERY
);
3917 if( xIndexAccess
.is() )
3919 sal_uInt32 nParamCount
= pPar
->Count32() - 1;
3920 if( nParamCount
!= 1 )
3922 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3927 sal_Int32 nIndex
= pPar
->Get32( 1 )->GetLong();
3928 Reference
< XInterface
> xRet
;
3931 Any aAny2
= xIndexAccess
->getByIndex( nIndex
);
3934 catch (const IndexOutOfBoundsException
&)
3936 // usually expect converting problem
3937 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE
);
3940 // #57847 always create a new variable, else error
3941 // due to PutObject(NULL) at ReadOnly-properties
3942 pElem
= new SbxVariable( SbxVARIANT
);
3947 // #67173 don't specify a name so that the real class name is entered
3948 SbxObjectRef xWrapper
= static_cast<SbxObject
*>(new SbUnoObject( OUString(), aAny
));
3949 pElem
->PutObject( xWrapper
.get() );
3953 pElem
->PutObject( nullptr );
3959 // check if there isn't a default member between the current variable
3960 // and the params, e.g.
3961 // Dim rst1 As New ADODB.Recordset
3963 // val = rst1("FirstName")
3964 // has the default 'Fields' member between rst1 and '("FirstName")'
3966 SbxVariable
* pDflt
= getDefaultProp( pElem
);
3969 pDflt
->Broadcast( SfxHintId::BasicDataWanted
);
3970 SbxBaseRef pDfltObj
= pDflt
->GetObject();
3973 if (SbUnoObject
* pSbObj
= dynamic_cast<SbUnoObject
*>(pDfltObj
.get()))
3976 Any aUnoAny
= pUnoObj
->getUnoAny();
3978 if( aUnoAny
.getValueType().getTypeClass() == TypeClass_INTERFACE
)
3984 OUString sDefaultMethod
;
3986 Reference
< XDefaultMethod
> xDfltMethod( x
, UNO_QUERY
);
3988 if ( xDfltMethod
.is() )
3990 sDefaultMethod
= xDfltMethod
->getDefaultMethodName();
3992 else if( xIndexAccess
.is() )
3994 sDefaultMethod
= "getByIndex";
3996 if ( !sDefaultMethod
.isEmpty() )
3998 SbxVariable
* meth
= pUnoObj
->Find( sDefaultMethod
, SbxClassType::Method
);
3999 SbxVariableRef refTemp
= meth
;
4002 meth
->SetParameters( pPar
);
4003 SbxVariable
* pNew
= new SbxMethod( *static_cast<SbxMethod
*>(meth
) );
4010 // #42940, set parameter 0 to NULL so that var doesn't contain itself
4011 pPar
->Put32( nullptr, 0 );
4013 else if (BasicCollection
* pCol
= dynamic_cast<BasicCollection
*>(pObj
.get()))
4015 pElem
= new SbxVariable( SbxVARIANT
);
4016 pPar
->Put32( pElem
, 0 );
4017 pCol
->CollItem( pPar
);
4020 else if( bVBAEnabled
) // !pObj
4022 SbxArray
* pParam
= pElem
->GetParameters();
4023 if( pParam
!= nullptr && !pElem
->IsSet( SbxFlagBits::VarToDim
) )
4025 Error( ERRCODE_BASIC_NO_OBJECT
);
4034 // loading an element from the runtime-library (+StringID+type)
4036 void SbiRuntime::StepRTL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4038 PushVar( FindElement( rBasic
.pRtl
.get(), nOp1
, nOp2
, ERRCODE_BASIC_PROC_UNDEFINED
, false ) );
4041 void SbiRuntime::StepFIND_Impl( SbxObject
* pObj
, sal_uInt32 nOp1
, sal_uInt32 nOp2
,
4042 ErrCode nNotFound
, bool bStatic
)
4044 if( !refLocals
.is() )
4046 refLocals
= new SbxArray
;
4048 PushVar( FindElement( pObj
, nOp1
, nOp2
, nNotFound
, true/*bLocal*/, bStatic
) );
4050 // loading a local/global variable (+StringID+type)
4052 void SbiRuntime::StepFIND( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4054 StepFIND_Impl( pMod
, nOp1
, nOp2
, ERRCODE_BASIC_PROC_UNDEFINED
);
4057 // Search inside a class module (CM) to enable global search in time
4058 void SbiRuntime::StepFIND_CM( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4061 SbClassModuleObject
* pClassModuleObject
= dynamic_cast<SbClassModuleObject
*>( pMod
);
4062 if( pClassModuleObject
)
4064 pMod
->SetFlag( SbxFlagBits::GlobalSearch
);
4066 StepFIND_Impl( pMod
, nOp1
, nOp2
, ERRCODE_BASIC_PROC_UNDEFINED
);
4068 if( pClassModuleObject
)
4070 pMod
->ResetFlag( SbxFlagBits::GlobalSearch
);
4074 void SbiRuntime::StepFIND_STATIC( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4076 StepFIND_Impl( pMod
, nOp1
, nOp2
, ERRCODE_BASIC_PROC_UNDEFINED
, true );
4079 // loading an object-element (+StringID+type)
4080 // the object lies on TOS
4082 void SbiRuntime::StepELEM( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4084 SbxVariableRef pObjVar
= PopVar();
4086 SbxObject
* pObj
= dynamic_cast<SbxObject
*>( pObjVar
.get() );
4089 SbxBase
* pObjVarObj
= pObjVar
->GetObject();
4090 pObj
= dynamic_cast<SbxObject
*>( pObjVarObj
);
4093 // #56368 save reference at StepElem, otherwise objects could
4094 // lose their reference too early in qualification chains like
4095 // ActiveComponent.Selection(0).Text
4096 // #74254 now per list
4099 aRefSaved
.emplace_back(pObj
);
4101 PushVar( FindElement( pObj
, nOp1
, nOp2
, ERRCODE_BASIC_NO_METHOD
, false ) );
4104 /** Loading of a parameter (+offset+type)
4105 If the data type is wrong, create a copy and search for optionals including
4106 the default value. The data type SbxEMPTY shows that no parameters are given.
4107 Get( 0 ) may be EMPTY
4110 the index of the current parameter being processed,
4111 where the entry of the index 0 is for the return value.
4114 the data type of the parameter.
4116 void SbiRuntime::StepPARAM( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4118 sal_uInt16 nIdx
= static_cast<sal_uInt16
>( nOp1
& 0x7FFF );
4119 SbxDataType eType
= static_cast<SbxDataType
>(nOp2
);
4122 // #57915 solve missing in a cleaner way
4123 sal_uInt32 nParamCount
= refParams
->Count32();
4124 if( nIdx
>= nParamCount
)
4126 sal_uInt16 iLoop
= nIdx
;
4127 while( iLoop
>= nParamCount
)
4129 pVar
= new SbxVariable();
4130 pVar
->PutErr( 448 ); // like in VB: Error-Code 448 (ERRCODE_BASIC_NAMED_NOT_FOUND)
4131 // tdf#79426, tdf#125180 - add additional information about a missing parameter
4132 SetIsMissing( pVar
);
4133 refParams
->Put32( pVar
, iLoop
);
4137 pVar
= refParams
->Get32( nIdx
);
4139 // tdf#79426, tdf#125180 - check for optionals only if the parameter is actually missing
4140 if( pVar
->GetType() == SbxERROR
&& IsMissing( pVar
, 1 ) && nIdx
)
4142 // if there's a parameter missing, it can be OPTIONAL
4146 SbxInfo
* pInfo
= pMeth
->GetInfo();
4149 const SbxParamInfo
* pParam
= pInfo
->GetParam( nIdx
);
4150 if( pParam
&& ( pParam
->nFlags
& SbxFlagBits::Optional
) )
4152 // tdf#136143 - reset SbxFlagBits::Fixed in order to prevent type conversion errors
4153 pVar
->ResetFlag( SbxFlagBits::Fixed
);
4155 sal_uInt16 nDefaultId
= static_cast<sal_uInt16
>(pParam
->nUserData
& 0x0ffff);
4156 if( nDefaultId
> 0 )
4158 OUString aDefaultStr
= pImg
->GetString( nDefaultId
);
4159 pVar
= new SbxVariable(pParam
-> eType
);
4160 pVar
->PutString( aDefaultStr
);
4161 refParams
->Put32( pVar
, nIdx
);
4163 else if ( SbiRuntime::isVBAEnabled() && eType
!= SbxVARIANT
)
4165 // tdf#36737 - initialize the parameter with the default value of its type
4166 pVar
= new SbxVariable( pParam
->eType
);
4167 refParams
->Put32( pVar
, nIdx
);
4175 Error( ERRCODE_BASIC_NOT_OPTIONAL
);
4178 else if( eType
!= SbxVARIANT
&& static_cast<SbxDataType
>(pVar
->GetType() & 0x0FFF ) != eType
)
4180 // tdf#43003 - convert parameter to the requested type
4181 pVar
->Convert(eType
);
4183 SetupArgs( pVar
, nOp1
);
4184 PushVar( CheckArray( pVar
) );
4187 // Case-Test (+True-Target+Test-Opcode)
4189 void SbiRuntime::StepCASEIS( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4191 if( !refCaseStk
.is() || !refCaseStk
->Count32() )
4193 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
4197 SbxVariableRef xComp
= PopVar();
4198 SbxVariableRef xCase
= refCaseStk
->Get32( refCaseStk
->Count32() - 1 );
4199 if( xCase
->Compare( static_cast<SbxOperator
>(nOp2
), *xComp
) )
4206 // call of a DLL-procedure (+StringID+type)
4207 // the StringID's MSB shows that Argv is occupied
4209 void SbiRuntime::StepCALL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4211 OUString aName
= pImg
->GetString( static_cast<short>( nOp1
& 0x7FFF ) );
4212 SbxArray
* pArgs
= nullptr;
4215 pArgs
= refArgv
.get();
4217 DllCall( aName
, aLibName
, pArgs
, static_cast<SbxDataType
>(nOp2
), false );
4225 // call of a DLL-procedure after CDecl (+StringID+type)
4227 void SbiRuntime::StepCALLC( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4229 OUString aName
= pImg
->GetString( static_cast<short>( nOp1
& 0x7FFF ) );
4230 SbxArray
* pArgs
= nullptr;
4233 pArgs
= refArgv
.get();
4235 DllCall( aName
, aLibName
, pArgs
, static_cast<SbxDataType
>(nOp2
), true );
4244 // beginning of a statement (+Line+Col)
4246 void SbiRuntime::StepSTMNT( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4248 // If the Expr-Stack at the beginning of a statement contains a variable,
4249 // some fool has called X as a function, although it's a variable!
4250 bool bFatalExpr
= false;
4251 OUString sUnknownMethodName
;
4258 SbxVariable
* p
= refExprStk
->Get32( 0 );
4259 if( p
->GetRefCount() > 1 &&
4260 refLocals
.is() && refLocals
->Find( p
->GetName(), p
->GetClass() ) )
4262 sUnknownMethodName
= p
->GetName();
4271 // We have to cancel hard here because line and column
4272 // would be wrong later otherwise!
4275 StarBASIC::FatalError( ERRCODE_BASIC_NO_METHOD
, sUnknownMethodName
);
4279 sal_uInt16 nOld
= nLine
;
4280 nLine
= static_cast<short>( nOp1
);
4282 // #29955 & 0xFF, to filter out for-loop-level
4283 nCol1
= static_cast<short>( nOp2
& 0xFF );
4285 // find the next STMNT-command to set the final column
4286 // of this statement
4290 const sal_uInt8
* p
= pMod
->FindNextStmnt( pCode
, n1
, n2
);
4295 // #29955 & 0xFF, to filter out for-loop-level
4296 nCol2
= (n2
& 0xFF) - 1;
4300 // #29955 correct for-loop-level, #67452 NOT in the error-handler
4303 // (there's a difference here in case of a jump out of a loop)
4304 sal_uInt16 nExpectedForLevel
= static_cast<sal_uInt16
>( nOp2
/ 0x100 );
4305 if( !pGosubStk
.empty() )
4307 nExpectedForLevel
= nExpectedForLevel
+ pGosubStk
.back().nStartForLvl
;
4310 // if the actual for-level is too small it'd jump out
4311 // of a loop -> corrected
4312 while( nForLvl
> nExpectedForLevel
)
4318 // 16.10.96: #31460 new concept for StepInto/Over/Out
4319 // see explanation at _ImplGetBreakCallLevel
4320 if( pInst
->nCallLvl
<= pInst
->nBreakCallLvl
)
4322 StarBASIC
* pStepBasic
= GetCurrentBasic( &rBasic
);
4323 BasicDebugFlags nNewFlags
= pStepBasic
->StepPoint( nLine
, nCol1
, nCol2
);
4325 pInst
->CalcBreakCallLevel( nNewFlags
);
4328 // break points only at STMNT-commands in a new line!
4329 else if( ( nOp1
!= nOld
)
4330 && ( nFlags
& BasicDebugFlags::Break
)
4331 && pMod
->IsBP( static_cast<sal_uInt16
>( nOp1
) ) )
4333 StarBASIC
* pBreakBasic
= GetCurrentBasic( &rBasic
);
4334 BasicDebugFlags nNewFlags
= pBreakBasic
->BreakPoint( nLine
, nCol1
, nCol2
);
4336 pInst
->CalcBreakCallLevel( nNewFlags
);
4340 // (+StreamMode+Flags)
4341 // Stack: block length
4345 void SbiRuntime::StepOPEN( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4347 SbxVariableRef pName
= PopVar();
4348 SbxVariableRef pChan
= PopVar();
4349 SbxVariableRef pLen
= PopVar();
4350 short nBlkLen
= pLen
->GetInteger();
4351 short nChan
= pChan
->GetInteger();
4352 OString
aName(OUStringToOString(pName
->GetOUString(), osl_getThreadTextEncoding()));
4353 pIosys
->Open( nChan
, aName
, static_cast<StreamMode
>( nOp1
),
4354 static_cast<SbiStreamFlags
>( nOp2
), nBlkLen
);
4355 Error( pIosys
->GetError() );
4358 // create object (+StringID+StringID)
4360 void SbiRuntime::StepCREATE( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4362 OUString
aClass( pImg
->GetString( static_cast<short>( nOp2
) ) );
4363 SbxObject
*pObj
= SbxBase::CreateObject( aClass
);
4366 Error( ERRCODE_BASIC_INVALID_OBJECT
);
4370 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4371 pObj
->SetName( aName
);
4372 // the object must be able to call the BASIC
4373 pObj
->SetParent( &rBasic
);
4374 SbxVariable
* pNew
= new SbxVariable
;
4375 pNew
->PutObject( pObj
);
4380 void SbiRuntime::StepDCREATE( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4382 StepDCREATE_IMPL( nOp1
, nOp2
);
4385 void SbiRuntime::StepDCREATE_REDIMP( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4387 StepDCREATE_IMPL( nOp1
, nOp2
);
4390 // #56204 create object array (+StringID+StringID), DCREATE == Dim-Create
4391 void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4393 SbxVariableRef refVar
= PopVar();
4397 // fill the array with instances of the requested class
4398 SbxBase
* pObj
= refVar
->GetObject();
4401 StarBASIC::Error( ERRCODE_BASIC_INVALID_OBJECT
);
4405 SbxDimArray
* pArray
= dynamic_cast<SbxDimArray
*>(pObj
);
4409 const sal_Int32 nDims
= pArray
->GetDims32();
4410 sal_Int32 nTotalSize
= nDims
> 0 ? 1 : 0;
4412 // must be a one-dimensional array
4413 sal_Int32 nLower
, nUpper
;
4414 for( sal_Int32 i
= 0 ; i
< nDims
; ++i
)
4416 pArray
->GetDim32( i
+1, nLower
, nUpper
);
4417 const sal_Int32 nSize
= nUpper
- nLower
+ 1;
4418 nTotalSize
*= nSize
;
4421 // Optimization: pre-allocate underlying container
4423 pArray
->SbxArray::GetRef32(nTotalSize
- 1);
4425 // First, fill those parts of the array that are preserved
4426 bool bWasError
= false;
4427 const bool bRestored
= implRestorePreservedArray(pArray
, refRedimpArray
, &bWasError
);
4429 nTotalSize
= 0; // on error, don't create objects
4431 // create objects and insert them into the array
4432 OUString
aClass( pImg
->GetString( static_cast<short>( nOp2
) ) );
4434 for( sal_Int32 i
= 0 ; i
< nTotalSize
; ++i
)
4436 if (!bRestored
|| !pArray
->SbxArray::GetRef32(i
)) // For those left unset after preserve
4438 SbxObject
* pClassObj
= SbxBase::CreateObject(aClass
);
4441 Error(ERRCODE_BASIC_INVALID_OBJECT
);
4446 if (aName
.isEmpty())
4447 aName
= pImg
->GetString(static_cast<short>(nOp1
));
4448 pClassObj
->SetName(aName
);
4449 // the object must be able to call the basic
4450 pClassObj
->SetParent(&rBasic
);
4451 pArray
->SbxArray::Put32(pClassObj
, i
);
4457 void SbiRuntime::StepTCREATE( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4459 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4460 OUString
aClass( pImg
->GetString( static_cast<short>( nOp2
) ) );
4462 SbxObject
* pCopyObj
= createUserTypeImpl( aClass
);
4465 pCopyObj
->SetName( aName
);
4467 SbxVariable
* pNew
= new SbxVariable
;
4468 pNew
->PutObject( pCopyObj
);
4469 pNew
->SetDeclareClassName( aClass
);
4473 void SbiRuntime::implHandleSbxFlags( SbxVariable
* pVar
, SbxDataType t
, sal_uInt32 nOp2
)
4475 bool bWithEvents
= ((t
& 0xff) == SbxOBJECT
&& (nOp2
& SBX_TYPE_WITH_EVENTS_FLAG
) != 0);
4478 pVar
->SetFlag( SbxFlagBits::WithEvents
);
4480 bool bDimAsNew
= ((nOp2
& SBX_TYPE_DIM_AS_NEW_FLAG
) != 0);
4483 pVar
->SetFlag( SbxFlagBits::DimAsNew
);
4485 bool bFixedString
= ((t
& 0xff) == SbxSTRING
&& (nOp2
& SBX_FIXED_LEN_STRING_FLAG
) != 0);
4488 sal_uInt16 nCount
= static_cast<sal_uInt16
>( nOp2
>> 17 ); // len = all bits above 0x10000
4489 OUStringBuffer aBuf
;
4490 comphelper::string::padToLength(aBuf
, nCount
);
4491 pVar
->PutString(aBuf
.makeStringAndClear());
4494 bool bVarToDim
= ((nOp2
& SBX_TYPE_VAR_TO_DIM_FLAG
) != 0);
4497 pVar
->SetFlag( SbxFlagBits::VarToDim
);
4501 // establishing a local variable (+StringID+type)
4503 void SbiRuntime::StepLOCAL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4505 if( !refLocals
.is() )
4507 refLocals
= new SbxArray
;
4509 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4510 if( refLocals
->Find( aName
, SbxClassType::DontCare
) == nullptr )
4512 SbxDataType t
= static_cast<SbxDataType
>(nOp2
& 0xffff);
4513 SbxVariable
* p
= new SbxVariable( t
);
4514 p
->SetName( aName
);
4515 implHandleSbxFlags( p
, t
, nOp2
);
4516 refLocals
->Put32( p
, refLocals
->Count32() );
4520 // establishing a module-global variable (+StringID+type)
4522 void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1
, sal_uInt32 nOp2
, bool bUsedForClassModule
)
4524 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4525 SbxDataType t
= static_cast<SbxDataType
>(nOp2
& 0xffff);
4526 bool bFlag
= pMod
->IsSet( SbxFlagBits::NoModify
);
4527 pMod
->SetFlag( SbxFlagBits::NoModify
);
4528 SbxVariableRef p
= pMod
->Find( aName
, SbxClassType::Property
);
4531 pMod
->Remove (p
.get());
4533 SbProperty
* pProp
= pMod
->GetProperty( aName
, t
);
4534 if( !bUsedForClassModule
)
4536 pProp
->SetFlag( SbxFlagBits::Private
);
4540 pMod
->ResetFlag( SbxFlagBits::NoModify
);
4544 pProp
->SetFlag( SbxFlagBits::DontStore
);
4545 // from 2.7.1996: HACK because of 'reference can't be saved'
4546 pProp
->SetFlag( SbxFlagBits::NoModify
);
4548 implHandleSbxFlags( pProp
, t
, nOp2
);
4552 void SbiRuntime::StepPUBLIC( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4554 StepPUBLIC_Impl( nOp1
, nOp2
, false );
4557 void SbiRuntime::StepPUBLIC_P( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4559 // Creates module variable that isn't reinitialised when
4560 // between invocations ( for VBASupport & document basic only )
4561 if( pMod
->pImage
->bFirstInit
)
4563 bool bUsedForClassModule
= pImg
->IsFlag( SbiImageFlags::CLASSMODULE
);
4564 StepPUBLIC_Impl( nOp1
, nOp2
, bUsedForClassModule
);
4568 // establishing a global variable (+StringID+type)
4570 void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4572 if( pImg
->IsFlag( SbiImageFlags::CLASSMODULE
) )
4574 StepPUBLIC_Impl( nOp1
, nOp2
, true );
4576 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4577 SbxDataType t
= static_cast<SbxDataType
>(nOp2
& 0xffff);
4579 // Store module scope variables at module scope
4580 // in non vba mode these are stored at the library level :/
4581 // not sure if this really should not be enabled for ALL basic
4582 SbxObject
* pStorage
= &rBasic
;
4583 if ( SbiRuntime::isVBAEnabled() )
4586 pMod
->AddVarName( aName
);
4589 bool bFlag
= pStorage
->IsSet( SbxFlagBits::NoModify
);
4590 rBasic
.SetFlag( SbxFlagBits::NoModify
);
4591 SbxVariableRef p
= pStorage
->Find( aName
, SbxClassType::Property
);
4594 pStorage
->Remove (p
.get());
4596 p
= pStorage
->Make( aName
, SbxClassType::Property
, t
);
4599 pStorage
->ResetFlag( SbxFlagBits::NoModify
);
4603 p
->SetFlag( SbxFlagBits::DontStore
);
4604 // from 2.7.1996: HACK because of 'reference can't be saved'
4605 p
->SetFlag( SbxFlagBits::NoModify
);
4610 // Creates global variable that isn't reinitialised when
4611 // basic is restarted, P=PERSIST (+StringID+Typ)
4613 void SbiRuntime::StepGLOBAL_P( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4615 if( pMod
->pImage
->bFirstInit
)
4617 StepGLOBAL( nOp1
, nOp2
);
4622 // Searches for global variable, behavior depends on the fact
4623 // if the variable is initialised for the first time
4625 void SbiRuntime::StepFIND_G( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4627 if( pMod
->pImage
->bFirstInit
)
4629 // Behave like always during first init
4630 StepFIND( nOp1
, nOp2
);
4634 // Return dummy variable
4635 SbxDataType t
= static_cast<SbxDataType
>(nOp2
);
4636 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
& 0x7FFF ) ) );
4638 SbxVariable
* pDummyVar
= new SbxVariable( t
);
4639 pDummyVar
->SetName( aName
);
4640 PushVar( pDummyVar
);
4645 SbxVariable
* SbiRuntime::StepSTATIC_Impl(
4646 OUString
const & aName
, SbxDataType t
, sal_uInt32 nOp2
)
4648 SbxVariable
* p
= nullptr;
4651 SbxArray
* pStatics
= pMeth
->GetStatics();
4652 if( pStatics
&& ( pStatics
->Find( aName
, SbxClassType::DontCare
) == nullptr ) )
4654 p
= new SbxVariable( t
);
4655 if( t
!= SbxVARIANT
)
4657 p
->SetFlag( SbxFlagBits::Fixed
);
4659 p
->SetName( aName
);
4660 implHandleSbxFlags( p
, t
, nOp2
);
4661 pStatics
->Put32( p
, pStatics
->Count32() );
4666 // establishing a static variable (+StringID+type)
4667 void SbiRuntime::StepSTATIC( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4669 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4670 SbxDataType t
= static_cast<SbxDataType
>(nOp2
& 0xffff);
4671 StepSTATIC_Impl( aName
, t
, nOp2
);
4674 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */