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/math.hxx>
45 #include <rtl/ustrbuf.hxx>
46 #include <rtl/character.hxx>
48 #include <svl/numformat.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 const 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 const 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 const 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()
292 : 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
.get() ), mpExtCaller(nullptr), m_nLastTime(0)
603 nFlags
= pe
? pe
->GetDebugFlags() : BasicDebugFlags::NONE
;
604 pIosys
= pInst
->GetIoSystem();
612 pStmnt
= 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
->Put(pMeth
, 0);
676 SbxInfo
* pInfo
= pMeth
? pMeth
->GetInfo() : nullptr;
677 sal_uInt32 nParamCount
= pParams
? pParams
->Count() : 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
->unoAddDim(0, nParamArrayParamCount
- 1);
691 for (sal_uInt32 j
= i
; j
< nParamCount
; ++j
)
693 SbxVariable
* v
= pParams
->Get(j
);
694 sal_Int32 aDimIndex
[1];
695 aDimIndex
[0] = j
- i
;
696 pArray
->Put(v
, aDimIndex
);
698 SbxVariable
* pArrayVar
= new SbxVariable( SbxVARIANT
);
699 pArrayVar
->SetFlag( SbxFlagBits::ReadWrite
);
700 pArrayVar
->PutObject( pArray
);
701 refParams
->Put(pArrayVar
, i
);
703 // Block ParamArray for missing parameter
708 SbxVariable
* v
= pParams
->Get(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
->Put(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
->Put(v
, i
);
765 refParams
->PutAlias(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
->unoAddDim(0, -1);
780 SbxVariable
* pArrayVar
= new SbxVariable( SbxVARIANT
);
781 pArrayVar
->SetFlag( SbxFlagBits::ReadWrite
);
782 pArrayVar
->PutObject( pArray
);
783 refParams
->Put(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 // tdf#123144 - always translate an error number to a vba error message
995 StarBASIC::MakeErrorText( nError
, rMsg
);
996 rMsg
= StarBASIC::GetErrorText();
997 // no num? most likely then it *is* really a vba err
998 sal_uInt16 nVBErrorCode
= StarBASIC::GetVBErrorCode( nError
);
999 sal_Int32 nVBAErrorNumber
= ( nVBErrorCode
== 0 ) ? sal_uInt32(nError
) : nVBErrorCode
;
1000 return nVBAErrorNumber
;
1005 // The expression-stack is available for the continuous evaluation
1008 void SbiRuntime::PushVar( SbxVariable
* pVar
)
1012 refExprStk
->Put(pVar
, nExprLvl
++);
1016 SbxVariableRef
SbiRuntime::PopVar()
1021 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
1022 return new SbxVariable
;
1025 SbxVariableRef xVar
= refExprStk
->Get(--nExprLvl
);
1026 SAL_INFO_IF( xVar
->GetName() == "Cells", "basic", "PopVar: Name equals 'Cells'" );
1027 // methods hold themselves in parameter 0
1028 if( dynamic_cast<const SbxMethod
*>(xVar
.get()) != nullptr )
1030 xVar
->SetParameters(nullptr);
1035 void SbiRuntime::ClearExprStack()
1037 // Attention: Clear() doesn't suffice as methods must be deleted
1042 refExprStk
->Clear();
1045 // Take variable from the expression-stack without removing it
1048 SbxVariable
* SbiRuntime::GetTOS()
1050 short n
= nExprLvl
- 1;
1054 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
1055 return new SbxVariable
;
1058 return refExprStk
->Get(static_cast<sal_uInt32
>(n
));
1062 void SbiRuntime::TOSMakeTemp()
1064 SbxVariable
* p
= refExprStk
->Get(nExprLvl
- 1);
1065 if ( p
->GetType() == SbxEMPTY
)
1067 p
->Broadcast( SfxHintId::BasicDataWanted
);
1070 SbxVariable
* pDflt
= nullptr;
1071 if ( bVBAEnabled
&& ( p
->GetType() == SbxOBJECT
|| p
->GetType() == SbxVARIANT
) && ((pDflt
= getDefaultProp(p
)) != nullptr) )
1073 pDflt
->Broadcast( SfxHintId::BasicDataWanted
);
1074 // replacing new p on stack causes object pointed by
1075 // pDft->pParent to be deleted, when p2->Compute() is
1076 // called below pParent is accessed (but it's deleted)
1077 // so set it to NULL now
1078 pDflt
->SetParent( nullptr );
1079 p
= new SbxVariable( *pDflt
);
1080 p
->SetFlag( SbxFlagBits::ReadWrite
);
1081 refExprStk
->Put(p
, nExprLvl
- 1);
1083 else if( p
->GetRefCount() != 1 )
1085 SbxVariable
* pNew
= new SbxVariable( *p
);
1086 pNew
->SetFlag( SbxFlagBits::ReadWrite
);
1087 refExprStk
->Put(pNew
, nExprLvl
- 1);
1091 // the GOSUB-stack collects return-addresses for GOSUBs
1092 void SbiRuntime::PushGosub( const sal_uInt8
* pc
)
1094 if( pGosubStk
.size() >= MAXRECURSION
)
1096 StarBASIC::FatalError( ERRCODE_BASIC_STACK_OVERFLOW
);
1098 pGosubStk
.emplace_back(pc
, nForLvl
);
1101 void SbiRuntime::PopGosub()
1103 if( pGosubStk
.empty() )
1105 Error( ERRCODE_BASIC_NO_GOSUB
);
1109 pCode
= pGosubStk
.back().pCode
;
1110 pGosubStk
.pop_back();
1114 // the Argv-stack collects current argument-vectors
1116 void SbiRuntime::PushArgv()
1118 pArgvStk
.emplace_back(refArgv
, nArgc
);
1123 void SbiRuntime::PopArgv()
1125 if( !pArgvStk
.empty() )
1127 refArgv
= pArgvStk
.back().refArgv
;
1128 nArgc
= pArgvStk
.back().nArgc
;
1129 pArgvStk
.pop_back();
1134 void SbiRuntime::ClearArgvStack()
1136 while( !pArgvStk
.empty() )
1142 // Push of the for-stack. The stack has increment, end, begin and variable.
1143 // After the creation of the stack-element the stack's empty.
1145 void SbiRuntime::PushFor()
1147 SbiForStack
* p
= new SbiForStack
;
1148 p
->eForType
= ForType::To
;
1152 p
->refInc
= PopVar();
1153 p
->refEnd
= PopVar();
1154 SbxVariableRef xBgn
= PopVar();
1155 p
->refVar
= PopVar();
1156 // tdf#85371 - grant explicitly write access to the index variable
1157 // since it could be the name of a method itself used in the next statement.
1158 ScopedWritableGuard
aGuard(p
->refVar
, p
->refVar
.get() == pMeth
);
1159 *(p
->refVar
) = *xBgn
;
1163 void SbiRuntime::PushForEach()
1165 SbiForStack
* p
= new SbiForStack
;
1166 // Set default value in case of error which is ignored in Resume Next
1167 p
->eForType
= ForType::EachArray
;
1171 SbxVariableRef xObjVar
= PopVar();
1172 SbxBase
* pObj
= xObjVar
&& xObjVar
->GetFullType() == SbxOBJECT
? xObjVar
->GetObject() : nullptr;
1174 if (SbxDimArray
* pArray
= dynamic_cast<SbxDimArray
*>(pObj
))
1176 p
->refEnd
= reinterpret_cast<SbxVariable
*>(pArray
);
1178 sal_Int32 nDims
= pArray
->GetDims();
1179 p
->pArrayLowerBounds
.reset( new sal_Int32
[nDims
] );
1180 p
->pArrayUpperBounds
.reset( new sal_Int32
[nDims
] );
1181 p
->pArrayCurIndices
.reset( new sal_Int32
[nDims
] );
1182 sal_Int32 lBound
, uBound
;
1183 for( sal_Int32 i
= 0 ; i
< nDims
; i
++ )
1185 pArray
->GetDim(i
+ 1, lBound
, uBound
);
1186 p
->pArrayCurIndices
[i
] = p
->pArrayLowerBounds
[i
] = lBound
;
1187 p
->pArrayUpperBounds
[i
] = uBound
;
1190 else if (BasicCollection
* pCollection
= dynamic_cast<BasicCollection
*>(pObj
))
1192 p
->eForType
= ForType::EachCollection
;
1193 p
->refEnd
= pCollection
;
1194 p
->nCurCollectionIndex
= 0;
1196 else if (SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>(pObj
))
1198 // XEnumerationAccess or XIndexAccess?
1199 Any aAny
= pUnoObj
->getUnoAny();
1200 Reference
<XIndexAccess
> xIndexAccess
;
1201 Reference
< XEnumerationAccess
> xEnumerationAccess
;
1202 if( aAny
>>= xEnumerationAccess
)
1204 p
->xEnumeration
= xEnumerationAccess
->createEnumeration();
1205 p
->eForType
= ForType::EachXEnumeration
;
1207 // tdf#130307 - support for each loop for objects exposing XIndexAccess
1208 else if (aAny
>>= xIndexAccess
)
1210 p
->eForType
= ForType::EachXIndexAccess
;
1211 p
->xIndexAccess
= xIndexAccess
;
1212 p
->nCurCollectionIndex
= 0;
1214 else if ( isVBAEnabled() && pUnoObj
->isNativeCOMObject() )
1216 uno::Reference
< script::XInvocation
> xInvocation
;
1217 if ( ( aAny
>>= xInvocation
) && xInvocation
.is() )
1221 p
->xEnumeration
= new ComEnumerationWrapper( xInvocation
);
1222 p
->eForType
= ForType::EachXEnumeration
;
1224 catch(const uno::Exception
& )
1230 // Container variable
1231 p
->refVar
= PopVar();
1236 void SbiRuntime::PopFor()
1240 SbiForStack
* p
= pForStk
;
1248 void SbiRuntime::ClearForStack()
1256 SbiForStack
* SbiRuntime::FindForStackItemForCollection( class BasicCollection
const * pCollection
)
1258 for (SbiForStack
*p
= pForStk
; p
; p
= p
->pNext
)
1260 SbxVariable
* pVar
= p
->refEnd
.is() ? p
->refEnd
.get() : nullptr;
1261 if( p
->eForType
== ForType::EachCollection
1263 && dynamic_cast<BasicCollection
*>( pVar
) == pCollection
)
1275 void SbiRuntime::DllCall
1276 ( std::u16string_view aFuncName
,
1277 std::u16string_view aDLLName
,
1278 SbxArray
* pArgs
, // parameter (from index 1, can be NULL)
1279 SbxDataType eResType
, // return value
1280 bool bCDecl
) // true: according to C-conventions
1282 // NOT YET IMPLEMENTED
1284 SbxVariable
* pRes
= new SbxVariable( eResType
);
1285 SbiDllMgr
* pDllMgr
= pInst
->GetDllMgr();
1286 ErrCode nErr
= pDllMgr
->Call( aFuncName
, aDLLName
, pArgs
, *pRes
, bCDecl
);
1294 bool SbiRuntime::IsImageFlag( SbiImageFlags n
) const
1296 return pImg
->IsFlag( n
);
1299 sal_uInt16
SbiRuntime::GetBase() const
1301 return pImg
->GetBase();
1304 void SbiRuntime::StepNOP()
1307 void SbiRuntime::StepArith( SbxOperator eOp
)
1309 SbxVariableRef p1
= PopVar();
1311 SbxVariable
* p2
= GetTOS();
1313 // tdf#144353 - do not compute any operation with a missing optional variable
1314 if ((p1
->GetType() == SbxERROR
&& IsMissing(p1
.get(), 1))
1315 || (p2
->GetType() == SbxERROR
&& IsMissing(p2
, 1)))
1317 Error(ERRCODE_BASIC_NOT_OPTIONAL
);
1321 p2
->ResetFlag( SbxFlagBits::Fixed
);
1322 p2
->Compute( eOp
, *p1
);
1324 checkArithmeticOverflow( p2
);
1327 void SbiRuntime::StepUnary( SbxOperator eOp
)
1330 SbxVariable
* p
= GetTOS();
1331 // tdf#144353 - do not compute any operation with a missing optional variable
1332 if (p
->GetType() == SbxERROR
&& IsMissing(p
, 1))
1334 Error(ERRCODE_BASIC_NOT_OPTIONAL
);
1337 p
->Compute( eOp
, *p
);
1340 void SbiRuntime::StepCompare( SbxOperator eOp
)
1342 SbxVariableRef p1
= PopVar();
1343 SbxVariableRef p2
= PopVar();
1345 // tdf#144353 - do not compare a missing optional variable
1346 if ((p1
->GetType() == SbxERROR
&& SbiRuntime::IsMissing(p1
.get(), 1))
1347 || (p2
->GetType() == SbxERROR
&& SbiRuntime::IsMissing(p2
.get(), 1)))
1349 SbxBase::SetError(ERRCODE_BASIC_NOT_OPTIONAL
);
1353 // Make sure objects with default params have
1354 // values ( and type ) set as appropriate
1355 SbxDataType p1Type
= p1
->GetType();
1356 SbxDataType p2Type
= p2
->GetType();
1357 if ( p1Type
== SbxEMPTY
)
1359 p1
->Broadcast( SfxHintId::BasicDataWanted
);
1360 p1Type
= p1
->GetType();
1362 if ( p2Type
== SbxEMPTY
)
1364 p2
->Broadcast( SfxHintId::BasicDataWanted
);
1365 p2Type
= p2
->GetType();
1367 if ( p1Type
== p2Type
)
1369 // if both sides are an object and have default props
1370 // then we need to use the default props
1371 // we don't need to worry if only one side ( lhs, rhs ) is an
1372 // object ( object side will get coerced to correct type in
1374 if ( p1Type
== SbxOBJECT
)
1376 SbxVariable
* pDflt
= getDefaultProp( p1
.get() );
1380 p1
->Broadcast( SfxHintId::BasicDataWanted
);
1382 pDflt
= getDefaultProp( p2
.get() );
1386 p2
->Broadcast( SfxHintId::BasicDataWanted
);
1391 static SbxVariable
* pTRUE
= nullptr;
1392 static SbxVariable
* pFALSE
= nullptr;
1393 // why do this on non-windows ?
1394 // why do this at all ?
1395 // I dumbly follow the pattern :-/
1396 if ( bVBAEnabled
&& ( p1
->IsNull() || p2
->IsNull() ) )
1398 static SbxVariable
* pNULL
= []() {
1399 SbxVariable
* p
= new SbxVariable
;
1406 else if( p2
->Compare( eOp
, *p1
) )
1410 pTRUE
= new SbxVariable
;
1411 pTRUE
->PutBool( true );
1412 pTRUE
->AddFirstRef();
1420 pFALSE
= new SbxVariable
;
1421 pFALSE
->PutBool( false );
1422 pFALSE
->AddFirstRef();
1428 void SbiRuntime::StepEXP() { StepArith( SbxEXP
); }
1429 void SbiRuntime::StepMUL() { StepArith( SbxMUL
); }
1430 void SbiRuntime::StepDIV() { StepArith( SbxDIV
); }
1431 void SbiRuntime::StepIDIV() { StepArith( SbxIDIV
); }
1432 void SbiRuntime::StepMOD() { StepArith( SbxMOD
); }
1433 void SbiRuntime::StepPLUS() { StepArith( SbxPLUS
); }
1434 void SbiRuntime::StepMINUS() { StepArith( SbxMINUS
); }
1435 void SbiRuntime::StepCAT() { StepArith( SbxCAT
); }
1436 void SbiRuntime::StepAND() { StepArith( SbxAND
); }
1437 void SbiRuntime::StepOR() { StepArith( SbxOR
); }
1438 void SbiRuntime::StepXOR() { StepArith( SbxXOR
); }
1439 void SbiRuntime::StepEQV() { StepArith( SbxEQV
); }
1440 void SbiRuntime::StepIMP() { StepArith( SbxIMP
); }
1442 void SbiRuntime::StepNEG() { StepUnary( SbxNEG
); }
1443 void SbiRuntime::StepNOT() { StepUnary( SbxNOT
); }
1445 void SbiRuntime::StepEQ() { StepCompare( SbxEQ
); }
1446 void SbiRuntime::StepNE() { StepCompare( SbxNE
); }
1447 void SbiRuntime::StepLT() { StepCompare( SbxLT
); }
1448 void SbiRuntime::StepGT() { StepCompare( SbxGT
); }
1449 void SbiRuntime::StepLE() { StepCompare( SbxLE
); }
1450 void SbiRuntime::StepGE() { StepCompare( SbxGE
); }
1454 bool NeedEsc(sal_Unicode cCode
)
1456 if(!rtl::isAscii(cCode
))
1478 OUString
VBALikeToRegexp(const OUString
&rIn
)
1480 OUStringBuffer sResult
;
1481 const sal_Unicode
*start
= rIn
.getStr();
1482 const sal_Unicode
*end
= start
+ rIn
.getLength();
1486 sResult
.append('^');
1493 sResult
.append('.');
1497 sResult
.append(".*");
1501 sResult
.append("[0-9]");
1505 sResult
.append('\\');
1506 sResult
.append(*start
++);
1509 sResult
.append(*start
++);
1511 while (start
< end
&& !seenright
)
1518 sResult
.append('\\');
1519 sResult
.append(*start
);
1522 sResult
.append(*start
);
1526 sResult
.append('^');
1529 if (NeedEsc(*start
))
1531 sResult
.append('\\');
1533 sResult
.append(*start
);
1540 if (NeedEsc(*start
))
1542 sResult
.append('\\');
1544 sResult
.append(*start
++);
1548 sResult
.append('$');
1550 return sResult
.makeStringAndClear();
1554 void SbiRuntime::StepLIKE()
1556 SbxVariableRef refVar1
= PopVar();
1557 SbxVariableRef refVar2
= PopVar();
1559 OUString pattern
= VBALikeToRegexp(refVar1
->GetOUString());
1560 OUString value
= refVar2
->GetOUString();
1562 i18nutil::SearchOptions2 aSearchOpt
;
1564 aSearchOpt
.AlgorithmType2
= css::util::SearchAlgorithms2::REGEXP
;
1566 aSearchOpt
.Locale
= Application::GetSettings().GetLanguageTag().getLocale();
1567 aSearchOpt
.searchString
= pattern
;
1569 bool bTextMode(true);
1570 bool bCompatibility
= ( GetSbData()->pInst
&& GetSbData()->pInst
->IsCompatibility() );
1571 if( bCompatibility
)
1573 bTextMode
= IsImageFlag( SbiImageFlags::COMPARETEXT
);
1577 aSearchOpt
.transliterateFlags
|= TransliterationFlags::IGNORE_CASE
;
1579 SbxVariable
* pRes
= new SbxVariable
;
1580 utl::TextSearch
aSearch( aSearchOpt
);
1581 sal_Int32 nStart
=0, nEnd
=value
.getLength();
1582 bool bRes
= aSearch
.SearchForward(value
, &nStart
, &nEnd
);
1583 pRes
->PutBool( bRes
);
1588 // TOS and TOS-1 are both object variables and contain the same pointer
1590 void SbiRuntime::StepIS()
1592 SbxVariableRef refVar1
= PopVar();
1593 SbxVariableRef refVar2
= PopVar();
1595 SbxDataType eType1
= refVar1
->GetType();
1596 SbxDataType eType2
= refVar2
->GetType();
1597 if ( eType1
== SbxEMPTY
)
1599 refVar1
->Broadcast( SfxHintId::BasicDataWanted
);
1600 eType1
= refVar1
->GetType();
1602 if ( eType2
== SbxEMPTY
)
1604 refVar2
->Broadcast( SfxHintId::BasicDataWanted
);
1605 eType2
= refVar2
->GetType();
1608 bool bRes
= ( eType1
== SbxOBJECT
&& eType2
== SbxOBJECT
);
1609 if ( bVBAEnabled
&& !bRes
)
1611 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
1613 bRes
= ( bRes
&& refVar1
->GetObject() == refVar2
->GetObject() );
1614 SbxVariable
* pRes
= new SbxVariable
;
1615 pRes
->PutBool( bRes
);
1619 // update the value of TOS
1621 void SbiRuntime::StepGET()
1623 SbxVariable
* p
= GetTOS();
1624 p
->Broadcast( SfxHintId::BasicDataWanted
);
1627 // #67607 copy Uno-Structs
1628 static bool checkUnoStructCopy( bool bVBA
, SbxVariableRef
const & refVal
, SbxVariableRef
const & refVar
)
1630 SbxDataType eVarType
= refVar
->GetType();
1631 SbxDataType eValType
= refVal
->GetType();
1633 // tdf#144353 - do not assign a missing optional variable to a property
1634 if (refVal
->GetType() == SbxERROR
&& SbiRuntime::IsMissing(refVal
.get(), 1))
1636 SbxBase::SetError(ERRCODE_BASIC_NOT_OPTIONAL
);
1640 if ( ( bVBA
&& ( eVarType
== SbxEMPTY
) ) || !refVar
->CanWrite() )
1643 if ( eValType
!= SbxOBJECT
)
1645 // we seem to be duplicating parts of SbxValue=operator, maybe we should just move this to
1646 // there :-/ not sure if for every '=' we would want struct handling
1647 if( eVarType
!= SbxOBJECT
)
1649 if ( refVar
->IsFixed() )
1652 // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure
1653 else if( dynamic_cast<const SbProcedureProperty
*>( refVar
.get() ) != nullptr )
1656 SbxObjectRef xValObj
= static_cast<SbxObject
*>(refVal
->GetObject());
1657 if( !xValObj
.is() || dynamic_cast<const SbUnoAnyObject
*>( xValObj
.get() ) != nullptr )
1660 SbUnoObject
* pUnoVal
= dynamic_cast<SbUnoObject
*>( xValObj
.get() );
1661 SbUnoStructRefObject
* pUnoStructVal
= dynamic_cast<SbUnoStructRefObject
*>( xValObj
.get() );
1663 // make doubly sure value is either a Uno object or
1665 if ( pUnoVal
|| pUnoStructVal
)
1666 aAny
= pUnoVal
? pUnoVal
->getUnoAny() : pUnoStructVal
->getUnoAny();
1669 if ( aAny
.getValueType().getTypeClass() == TypeClass_STRUCT
)
1671 refVar
->SetType( SbxOBJECT
);
1672 ErrCode eOldErr
= SbxBase::GetError();
1673 // There are some circumstances when calling GetObject
1674 // will trigger an error, we need to squash those here.
1675 // Alternatively it is possible that the same scenario
1676 // could overwrite and existing error. Lets prevent that
1677 SbxObjectRef xVarObj
= static_cast<SbxObject
*>(refVar
->GetObject());
1678 if ( eOldErr
!= ERRCODE_NONE
)
1679 SbxBase::SetError( eOldErr
);
1681 SbxBase::ResetError();
1683 SbUnoStructRefObject
* pUnoStructObj
= dynamic_cast<SbUnoStructRefObject
*>( xVarObj
.get() );
1685 OUString sClassName
= pUnoVal
? pUnoVal
->GetClassName() : pUnoStructVal
->GetClassName();
1686 OUString sName
= pUnoVal
? pUnoVal
->GetName() : pUnoStructVal
->GetName();
1688 if ( pUnoStructObj
)
1690 StructRefInfo aInfo
= pUnoStructObj
->getStructInfo();
1691 aInfo
.setValue( aAny
);
1695 SbUnoObject
* pNewUnoObj
= new SbUnoObject( sName
, aAny
);
1696 // #70324: adopt ClassName
1697 pNewUnoObj
->SetClassName( sClassName
);
1698 refVar
->PutObject( pNewUnoObj
);
1706 // laying down TOS in TOS-1
1708 void SbiRuntime::StepPUT()
1710 SbxVariableRef refVal
= PopVar();
1711 SbxVariableRef refVar
= PopVar();
1712 // store on its own method (inside a function)?
1713 bool bFlagsChanged
= false;
1714 SbxFlagBits n
= SbxFlagBits::NONE
;
1715 if( refVar
.get() == pMeth
)
1717 bFlagsChanged
= true;
1718 n
= refVar
->GetFlags();
1719 refVar
->SetFlag( SbxFlagBits::Write
);
1722 // if left side arg is an object or variant and right handside isn't
1723 // either an object or a variant then try and see if a default
1725 // to use e.g. Range{"A1") = 34
1726 // could equate to Range("A1").Value = 34
1729 // yet more hacking at this, I feel we don't quite have the correct
1730 // heuristics for dealing with obj1 = obj2 ( where obj2 ( and maybe
1731 // obj1 ) has default member/property ) ) It seems that default props
1732 // aren't dealt with if the object is a member of some parent object
1733 bool bObjAssign
= false;
1734 if ( refVar
->GetType() == SbxEMPTY
)
1735 refVar
->Broadcast( SfxHintId::BasicDataWanted
);
1736 if ( refVar
->GetType() == SbxOBJECT
)
1738 if ( dynamic_cast<const SbxMethod
*>(refVar
.get()) != nullptr || ! refVar
->GetParent() )
1740 SbxVariable
* pDflt
= getDefaultProp( refVar
.get() );
1748 if ( refVal
->GetType() == SbxOBJECT
&& !bObjAssign
&& ( dynamic_cast<const SbxMethod
*>(refVal
.get()) != nullptr || ! refVal
->GetParent() ) )
1750 SbxVariable
* pDflt
= getDefaultProp( refVal
.get() );
1756 if ( !checkUnoStructCopy( bVBAEnabled
, refVal
, refVar
) )
1760 refVar
->SetFlags( n
);
1765 // VBA Dim As New behavior handling, save init object information
1766 struct DimAsNewRecoverItem
1768 OUString m_aObjClass
;
1769 OUString m_aObjName
;
1770 SbxObject
* m_pObjParent
;
1771 SbModule
* m_pClassModule
;
1773 DimAsNewRecoverItem()
1774 : m_pObjParent( nullptr )
1775 , m_pClassModule( nullptr )
1778 DimAsNewRecoverItem( const OUString
& rObjClass
, const OUString
& rObjName
,
1779 SbxObject
* pObjParent
, SbModule
* pClassModule
)
1780 : m_aObjClass( rObjClass
)
1781 , m_aObjName( rObjName
)
1782 , m_pObjParent( pObjParent
)
1783 , m_pClassModule( pClassModule
)
1789 struct SbxVariablePtrHash
1791 size_t operator()( SbxVariable
* pVar
) const
1792 { return reinterpret_cast<size_t>(pVar
); }
1797 typedef std::unordered_map
< SbxVariable
*, DimAsNewRecoverItem
,
1798 SbxVariablePtrHash
> DimAsNewRecoverHash
;
1802 DimAsNewRecoverHash gaDimAsNewRecoverHash
;
1806 void removeDimAsNewRecoverItem( SbxVariable
* pVar
)
1808 DimAsNewRecoverHash::iterator it
= gaDimAsNewRecoverHash
.find( pVar
);
1809 if( it
!= gaDimAsNewRecoverHash
.end() )
1811 gaDimAsNewRecoverHash
.erase( it
);
1816 // saving object variable
1817 // not-object variables will cause errors
1819 constexpr OUStringLiteral pCollectionStr
= u
"Collection";
1821 void SbiRuntime::StepSET_Impl( SbxVariableRef
& refVal
, SbxVariableRef
& refVar
, bool bHandleDefaultProp
)
1823 // #67733 types with array-flag are OK too
1825 // Check var, !object is no error for sure if, only if type is fixed
1826 SbxDataType eVarType
= refVar
->GetType();
1827 if( !bHandleDefaultProp
&& eVarType
!= SbxOBJECT
&& !(eVarType
& SbxARRAY
) && refVar
->IsFixed() )
1829 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
1833 // Check value, !object is no error for sure if, only if type is fixed
1834 SbxDataType eValType
= refVal
->GetType();
1835 if( !bHandleDefaultProp
&& eValType
!= SbxOBJECT
&& !(eValType
& SbxARRAY
) && refVal
->IsFixed() )
1837 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
1841 // Getting in here causes problems with objects with default properties
1842 // if they are SbxEMPTY I guess
1843 if ( !bHandleDefaultProp
|| eValType
== SbxOBJECT
)
1845 // activate GetObject for collections on refVal
1846 SbxBase
* pObjVarObj
= refVal
->GetObject();
1849 SbxVariableRef refObjVal
= dynamic_cast<SbxObject
*>( pObjVarObj
);
1851 if( refObjVal
.is() )
1855 else if( !(eValType
& SbxARRAY
) )
1862 // #52896 refVal can be invalid here, if uno-sequences - or more
1863 // general arrays - are assigned to variables that are declared
1867 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
1871 bool bFlagsChanged
= false;
1872 SbxFlagBits n
= SbxFlagBits::NONE
;
1873 if( refVar
.get() == pMeth
)
1875 bFlagsChanged
= true;
1876 n
= refVar
->GetFlags();
1877 refVar
->SetFlag( SbxFlagBits::Write
);
1879 SbProcedureProperty
* pProcProperty
= dynamic_cast<SbProcedureProperty
*>( refVar
.get() );
1882 pProcProperty
->setSet( true );
1884 if ( bHandleDefaultProp
)
1886 // get default properties for lhs & rhs where necessary
1887 // SbxVariable* defaultProp = NULL; unused variable
1888 // LHS try determine if a default prop exists
1889 // again like in StepPUT (see there too ) we are tweaking the
1890 // heuristics again for when to assign an object reference or
1891 // use default members if they exist
1892 // #FIXME we really need to get to the bottom of this mess
1893 bool bObjAssign
= false;
1894 if ( refVar
->GetType() == SbxOBJECT
)
1896 if ( dynamic_cast<const SbxMethod
*>(refVar
.get()) != nullptr || ! refVar
->GetParent() )
1898 SbxVariable
* pDflt
= getDefaultProp( refVar
.get() );
1907 // RHS only get a default prop is the rhs has one
1908 if ( refVal
->GetType() == SbxOBJECT
)
1910 // check if lhs is a null object
1911 // if it is then use the object not the default property
1912 SbxObject
* pObj
= dynamic_cast<SbxObject
*>( refVar
.get() );
1914 // calling GetObject on a SbxEMPTY variable raises
1915 // object not set errors, make sure it's an Object
1916 if ( !pObj
&& refVar
->GetType() == SbxOBJECT
)
1918 SbxBase
* pObjVarObj
= refVar
->GetObject();
1919 pObj
= dynamic_cast<SbxObject
*>( pObjVarObj
);
1921 SbxVariable
* pDflt
= nullptr;
1922 if ( pObj
&& !bObjAssign
)
1924 // lhs is either a valid object || or has a defaultProp
1925 pDflt
= getDefaultProp( refVal
.get() );
1934 // Handle Dim As New
1935 bool bDimAsNew
= bVBAEnabled
&& refVar
->IsSet( SbxFlagBits::DimAsNew
);
1936 SbxBaseRef xPrevVarObj
;
1939 xPrevVarObj
= refVar
->GetObject();
1941 // Handle withevents
1942 bool bWithEvents
= refVar
->IsSet( SbxFlagBits::WithEvents
);
1945 Reference
< XInterface
> xComListener
;
1947 SbxBase
* pObj
= refVal
->GetObject();
1948 SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>( pObj
);
1949 if( pUnoObj
!= nullptr )
1951 Any aControlAny
= pUnoObj
->getUnoAny();
1952 OUString aDeclareClassName
= refVar
->GetDeclareClassName();
1953 OUString aPrefix
= refVar
->GetName();
1954 SbxObjectRef xScopeObj
= refVar
->GetParent();
1955 xComListener
= createComListener( aControlAny
, aDeclareClassName
, aPrefix
, xScopeObj
);
1957 refVal
->SetDeclareClassName( aDeclareClassName
);
1958 refVal
->SetComListener( xComListener
, &rBasic
); // Hold reference
1963 // lhs is a property who's value is currently (Empty e.g. no broadcast yet)
1964 // in this case if there is a default prop involved the value of the
1965 // default property may in fact be void so the type will also be SbxEMPTY
1966 // in this case we do not want to call checkUnoStructCopy 'cause that will
1967 // cause an error also
1968 if ( !checkUnoStructCopy( bHandleDefaultProp
, refVal
, refVar
) )
1974 if( dynamic_cast<const SbxObject
*>( refVar
.get() ) == nullptr )
1976 SbxBase
* pValObjBase
= refVal
->GetObject();
1977 if( pValObjBase
== nullptr )
1979 if( xPrevVarObj
.is() )
1981 // Object is overwritten with NULL, instantiate init object
1982 DimAsNewRecoverHash::iterator it
= gaDimAsNewRecoverHash
.find( refVar
.get() );
1983 if( it
!= gaDimAsNewRecoverHash
.end() )
1985 const DimAsNewRecoverItem
& rItem
= it
->second
;
1986 if( rItem
.m_pClassModule
!= nullptr )
1988 SbClassModuleObject
* pNewObj
= new SbClassModuleObject( rItem
.m_pClassModule
);
1989 pNewObj
->SetName( rItem
.m_aObjName
);
1990 pNewObj
->SetParent( rItem
.m_pObjParent
);
1991 refVar
->PutObject( pNewObj
);
1993 else if( rItem
.m_aObjClass
.equalsIgnoreAsciiCase( pCollectionStr
) )
1995 BasicCollection
* pNewCollection
= new BasicCollection( pCollectionStr
);
1996 pNewCollection
->SetName( rItem
.m_aObjName
);
1997 pNewCollection
->SetParent( rItem
.m_pObjParent
);
1998 refVar
->PutObject( pNewCollection
);
2005 // Does old value exist?
2006 bool bFirstInit
= !xPrevVarObj
.is();
2009 // Store information to instantiate object later
2010 SbxObject
* pValObj
= dynamic_cast<SbxObject
*>( pValObjBase
);
2011 if( pValObj
!= nullptr )
2013 OUString aObjClass
= pValObj
->GetClassName();
2015 SbClassModuleObject
* pClassModuleObj
= dynamic_cast<SbClassModuleObject
*>( pValObjBase
);
2016 if( pClassModuleObj
!= nullptr )
2018 SbModule
* pClassModule
= pClassModuleObj
->getClassModule();
2019 gaDimAsNewRecoverHash
[refVar
.get()] =
2020 DimAsNewRecoverItem( aObjClass
, pValObj
->GetName(), pValObj
->GetParent(), pClassModule
);
2022 else if( aObjClass
.equalsIgnoreAsciiCase( "Collection" ) )
2024 gaDimAsNewRecoverHash
[refVar
.get()] =
2025 DimAsNewRecoverItem( aObjClass
, pValObj
->GetName(), pValObj
->GetParent(), nullptr );
2035 refVar
->SetFlags( n
);
2040 void SbiRuntime::StepSET()
2042 SbxVariableRef refVal
= PopVar();
2043 SbxVariableRef refVar
= PopVar();
2044 StepSET_Impl( refVal
, refVar
, bVBAEnabled
); // this is really assignment
2047 void SbiRuntime::StepVBASET()
2049 SbxVariableRef refVal
= PopVar();
2050 SbxVariableRef refVar
= PopVar();
2051 // don't handle default property
2052 StepSET_Impl( refVal
, refVar
); // set obj = something
2056 void SbiRuntime::StepLSET()
2058 SbxVariableRef refVal
= PopVar();
2059 SbxVariableRef refVar
= PopVar();
2060 if( refVar
->GetType() != SbxSTRING
||
2061 refVal
->GetType() != SbxSTRING
)
2063 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
2067 SbxFlagBits n
= refVar
->GetFlags();
2068 if( refVar
.get() == pMeth
)
2070 refVar
->SetFlag( SbxFlagBits::Write
);
2072 OUString aRefVarString
= refVar
->GetOUString();
2073 OUString aRefValString
= refVal
->GetOUString();
2075 sal_Int32 nVarStrLen
= aRefVarString
.getLength();
2076 sal_Int32 nValStrLen
= aRefValString
.getLength();
2078 if( nVarStrLen
> nValStrLen
)
2080 OUStringBuffer
buf(aRefValString
);
2081 comphelper::string::padToLength(buf
, nVarStrLen
, ' ');
2082 aNewStr
= buf
.makeStringAndClear();
2086 aNewStr
= aRefValString
.copy( 0, nVarStrLen
);
2089 refVar
->PutString(aNewStr
);
2090 refVar
->SetFlags( n
);
2094 void SbiRuntime::StepRSET()
2096 SbxVariableRef refVal
= PopVar();
2097 SbxVariableRef refVar
= PopVar();
2098 if( refVar
->GetType() != SbxSTRING
|| refVal
->GetType() != SbxSTRING
)
2100 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
2104 SbxFlagBits n
= refVar
->GetFlags();
2105 if( refVar
.get() == pMeth
)
2107 refVar
->SetFlag( SbxFlagBits::Write
);
2109 OUString aRefVarString
= refVar
->GetOUString();
2110 OUString aRefValString
= refVal
->GetOUString();
2111 sal_Int32 nVarStrLen
= aRefVarString
.getLength();
2112 sal_Int32 nValStrLen
= aRefValString
.getLength();
2114 OUStringBuffer
aNewStr(nVarStrLen
);
2115 if (nVarStrLen
> nValStrLen
)
2117 comphelper::string::padToLength(aNewStr
, nVarStrLen
- nValStrLen
, ' ');
2118 aNewStr
.append(aRefValString
);
2122 aNewStr
.append(aRefValString
.subView(0, nVarStrLen
));
2124 refVar
->PutString(aNewStr
.makeStringAndClear());
2126 refVar
->SetFlags( n
);
2130 // laying down TOS in TOS-1, then set ReadOnly-Bit
2132 void SbiRuntime::StepPUTC()
2134 SbxVariableRef refVal
= PopVar();
2135 SbxVariableRef refVar
= PopVar();
2136 refVar
->SetFlag( SbxFlagBits::Write
);
2138 refVar
->ResetFlag( SbxFlagBits::Write
);
2139 refVar
->SetFlag( SbxFlagBits::Const
);
2143 // TOS = variable for the array with dimension information as parameter
2145 void SbiRuntime::StepDIM()
2147 SbxVariableRef refVar
= PopVar();
2151 // #56204 swap out DIM-functionality into a help method (step0.cxx)
2152 void SbiRuntime::DimImpl(const SbxVariableRef
& refVar
)
2154 // If refDim then this DIM statement is terminating a ReDIM and
2155 // previous StepERASE_CLEAR for an array, the following actions have
2156 // been delayed from ( StepERASE_CLEAR ) 'till here
2157 if ( refRedim
.is() )
2159 if ( !refRedimpArray
.is() ) // only erase the array not ReDim Preserve
2161 lcl_eraseImpl( refVar
, bVBAEnabled
);
2163 SbxDataType eType
= refVar
->GetType();
2164 lcl_clearImpl( refVar
, eType
);
2167 SbxArray
* pDims
= refVar
->GetParameters();
2168 // must have an even number of arguments
2169 // have in mind that Arg[0] does not count!
2170 if (pDims
&& !(pDims
->Count() & 1))
2172 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2176 SbxDataType eType
= refVar
->IsFixed() ? refVar
->GetType() : SbxVARIANT
;
2177 SbxDimArray
* pArray
= new SbxDimArray( eType
);
2178 // allow arrays without dimension information, too (VB-compatible)
2181 refVar
->ResetFlag( SbxFlagBits::VarToDim
);
2183 for (sal_uInt32 i
= 1; i
< pDims
->Count();)
2185 sal_Int32 lb
= pDims
->Get(i
++)->GetLong();
2186 sal_Int32 ub
= pDims
->Get(i
++)->GetLong();
2189 Error( ERRCODE_BASIC_OUT_OF_RANGE
);
2192 pArray
->AddDim(lb
, ub
);
2195 pArray
->setHasFixedSize( true );
2201 // #62867 On creating an array of the length 0, create
2202 // a dimension (like for Uno-Sequences of the length 0)
2203 pArray
->unoAddDim(0, -1);
2205 SbxFlagBits nSavFlags
= refVar
->GetFlags();
2206 refVar
->ResetFlag( SbxFlagBits::Fixed
);
2207 refVar
->PutObject( pArray
);
2208 refVar
->SetFlags( nSavFlags
);
2209 refVar
->SetParameters( nullptr );
2214 // TOS = variable for the array
2215 // argv = dimension information
2217 void SbiRuntime::StepREDIM()
2219 // Nothing different than dim at the moment because
2220 // a double dim is already recognized by the compiler.
2225 // Helper function for StepREDIMP and StepDCREATE_IMPL / bRedimp = true
2226 static void implCopyDimArray( SbxDimArray
* pNewArray
, SbxDimArray
* pOldArray
, sal_Int32 nMaxDimIndex
,
2227 sal_Int32 nActualDim
, sal_Int32
* pActualIndices
, sal_Int32
* pLowerBounds
, sal_Int32
* pUpperBounds
)
2229 sal_Int32
& ri
= pActualIndices
[nActualDim
];
2230 for( ri
= pLowerBounds
[nActualDim
] ; ri
<= pUpperBounds
[nActualDim
] ; ri
++ )
2232 if( nActualDim
< nMaxDimIndex
)
2234 implCopyDimArray( pNewArray
, pOldArray
, nMaxDimIndex
, nActualDim
+ 1,
2235 pActualIndices
, pLowerBounds
, pUpperBounds
);
2239 SbxVariable
* pSource
= pOldArray
->Get(pActualIndices
);
2240 if (pSource
&& pOldArray
->GetRefCount() > 1)
2241 // tdf#134692: old array will stay alive after the redim - we need to copy deep
2242 pSource
= new SbxVariable(*pSource
);
2243 pNewArray
->Put(pSource
, pActualIndices
);
2248 // Returns true when actually restored
2249 static bool implRestorePreservedArray(SbxDimArray
* pNewArray
, SbxArrayRef
& rrefRedimpArray
, bool* pbWasError
= nullptr)
2252 bool bResult
= false;
2254 *pbWasError
= false;
2255 if (rrefRedimpArray
)
2257 SbxDimArray
* pOldArray
= static_cast<SbxDimArray
*>(rrefRedimpArray
.get());
2258 const sal_Int32 nDimsNew
= pNewArray
->GetDims();
2259 const sal_Int32 nDimsOld
= pOldArray
->GetDims();
2261 if (nDimsOld
!= nDimsNew
)
2263 StarBASIC::Error(ERRCODE_BASIC_OUT_OF_RANGE
);
2267 else if (nDimsNew
> 0)
2269 // Store dims to use them for copying later
2270 std::unique_ptr
<sal_Int32
[]> pLowerBounds(new sal_Int32
[nDimsNew
]);
2271 std::unique_ptr
<sal_Int32
[]> pUpperBounds(new sal_Int32
[nDimsNew
]);
2272 std::unique_ptr
<sal_Int32
[]> pActualIndices(new sal_Int32
[nDimsNew
]);
2273 bool bNeedsPreallocation
= true;
2276 for (sal_Int32 i
= 1; i
<= nDimsNew
; i
++)
2278 sal_Int32 lBoundNew
, uBoundNew
;
2279 sal_Int32 lBoundOld
, uBoundOld
;
2280 pNewArray
->GetDim(i
, lBoundNew
, uBoundNew
);
2281 pOldArray
->GetDim(i
, lBoundOld
, uBoundOld
);
2282 lBoundNew
= std::max(lBoundNew
, lBoundOld
);
2283 uBoundNew
= std::min(uBoundNew
, uBoundOld
);
2284 sal_Int32 j
= i
- 1;
2285 pActualIndices
[j
] = pLowerBounds
[j
] = lBoundNew
;
2286 pUpperBounds
[j
] = uBoundNew
;
2287 if (lBoundNew
> uBoundNew
) // No elements in the dimension -> no elements to restore
2288 bNeedsPreallocation
= false;
2291 // Optimization: pre-allocate underlying container
2292 if (bNeedsPreallocation
)
2293 pNewArray
->Put(nullptr, pUpperBounds
.get());
2295 // Copy data from old array by going recursively through all dimensions
2296 // (It would be faster to work on the flat internal data array of an
2297 // SbyArray but this solution is clearer and easier)
2298 implCopyDimArray(pNewArray
, pOldArray
, nDimsNew
- 1, 0, pActualIndices
.get(),
2299 pLowerBounds
.get(), pUpperBounds
.get());
2303 rrefRedimpArray
.clear();
2309 // TOS = variable for the array
2310 // argv = dimension information
2312 void SbiRuntime::StepREDIMP()
2314 SbxVariableRef refVar
= PopVar();
2317 // Now check, if we can copy from the old array
2318 if( refRedimpArray
.is() )
2320 if (SbxDimArray
* pNewArray
= dynamic_cast<SbxDimArray
*>(refVar
->GetObject()))
2321 implRestorePreservedArray(pNewArray
, refRedimpArray
);
2326 // TOS = Array-Variable, Reference to array is copied
2327 // Variable is cleared as in ERASE
2329 void SbiRuntime::StepREDIMP_ERASE()
2331 SbxVariableRef refVar
= PopVar();
2333 SbxDataType eType
= refVar
->GetType();
2334 if( eType
& SbxARRAY
)
2336 SbxBase
* pElemObj
= refVar
->GetObject();
2337 SbxDimArray
* pDimArray
= dynamic_cast<SbxDimArray
*>( pElemObj
);
2340 refRedimpArray
= pDimArray
;
2344 else if( refVar
->IsFixed() )
2350 refVar
->SetType( SbxEMPTY
);
2354 static void lcl_clearImpl( SbxVariableRef
const & refVar
, SbxDataType
const & eType
)
2356 SbxFlagBits nSavFlags
= refVar
->GetFlags();
2357 refVar
->ResetFlag( SbxFlagBits::Fixed
);
2358 refVar
->SetType( SbxDataType(eType
& 0x0FFF) );
2359 refVar
->SetFlags( nSavFlags
);
2363 static void lcl_eraseImpl( SbxVariableRef
const & refVar
, bool bVBAEnabled
)
2365 SbxDataType eType
= refVar
->GetType();
2366 if( eType
& SbxARRAY
)
2370 SbxBase
* pElemObj
= refVar
->GetObject();
2371 SbxDimArray
* pDimArray
= dynamic_cast<SbxDimArray
*>( pElemObj
);
2374 if ( pDimArray
->hasFixedSize() )
2376 // Clear all Value(s)
2377 pDimArray
->SbxArray::Clear();
2381 pDimArray
->Clear(); // clear dims and values
2386 SbxArray
* pArray
= dynamic_cast<SbxArray
*>( pElemObj
);
2395 // Arrays have on an erase to VB quite a complex behaviour. Here are
2396 // only the type problems at REDIM (#26295) removed at first:
2397 // Set type hard onto the array-type, because a variable with array is
2398 // SbxOBJECT. At REDIM there's an SbxOBJECT-array generated then and
2399 // the original type is lost -> runtime error
2400 lcl_clearImpl( refVar
, eType
);
2403 else if( refVar
->IsFixed() )
2409 refVar
->SetType( SbxEMPTY
);
2416 void SbiRuntime::StepERASE()
2418 SbxVariableRef refVar
= PopVar();
2419 lcl_eraseImpl( refVar
, bVBAEnabled
);
2422 void SbiRuntime::StepERASE_CLEAR()
2424 refRedim
= PopVar();
2427 void SbiRuntime::StepARRAYACCESS()
2431 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2433 SbxVariableRef refVar
= PopVar();
2434 refVar
->SetParameters( refArgv
.get() );
2436 PushVar( CheckArray( refVar
.get() ) );
2439 void SbiRuntime::StepBYVAL()
2441 // Copy variable on stack to break call by reference
2442 SbxVariableRef pVar
= PopVar();
2443 SbxDataType t
= pVar
->GetType();
2445 SbxVariable
* pCopyVar
= new SbxVariable( t
);
2446 pCopyVar
->SetFlag( SbxFlagBits::ReadWrite
);
2449 PushVar( pCopyVar
);
2452 // establishing an argv
2453 // nOp1 stays as it is -> 1st element is the return value
2455 void SbiRuntime::StepARGC()
2458 refArgv
= new SbxArray
;
2462 // storing an argument in Argv
2464 void SbiRuntime::StepARGV()
2468 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2472 SbxVariableRef pVal
= PopVar();
2474 // Before fix of #94916:
2475 if( dynamic_cast<const SbxMethod
*>( pVal
.get() ) != nullptr
2476 || dynamic_cast<const SbUnoProperty
*>( pVal
.get() ) != nullptr
2477 || dynamic_cast<const SbProcedureProperty
*>( pVal
.get() ) != nullptr )
2479 // evaluate methods and properties!
2480 SbxVariable
* pRes
= new SbxVariable( *pVal
);
2483 refArgv
->Put(pVal
.get(), nArgc
++);
2487 // Input to Variable. The variable is on TOS and is
2488 // is removed afterwards.
2489 void SbiRuntime::StepINPUT()
2495 while( ( err
= pIosys
->GetError() ) == ERRCODE_NONE
)
2497 ch
= pIosys
->Read();
2498 if( ch
!= ' ' && ch
!= '\t' && ch
!= '\n' )
2505 // Scan until comma or whitespace
2506 char sep
= ( ch
== '"' ) ? ch
: 0;
2509 ch
= pIosys
->Read();
2511 while( ( err
= pIosys
->GetError() ) == ERRCODE_NONE
)
2515 ch
= pIosys
->Read();
2521 else if( !sep
&& (ch
== ',' || ch
== '\n') )
2526 ch
= pIosys
->Read();
2529 if( ch
== ' ' || ch
== '\t' )
2531 while( ( err
= pIosys
->GetError() ) == ERRCODE_NONE
)
2533 if( ch
!= ' ' && ch
!= '\t' && ch
!= '\n' )
2537 ch
= pIosys
->Read();
2543 OUString s
= sin
.makeStringAndClear();
2544 SbxVariableRef pVar
= GetTOS();
2545 // try to fill the variable with a numeric value first,
2546 // then with a string value
2547 if( !pVar
->IsFixed() || pVar
->IsNumeric() )
2549 sal_uInt16 nLen
= 0;
2550 if( !pVar
->Scan( s
, &nLen
) )
2552 err
= SbxBase::GetError();
2553 SbxBase::ResetError();
2555 // the value has to be scanned in completely
2556 else if( nLen
!= s
.getLength() && !pVar
->PutString( s
) )
2558 err
= SbxBase::GetError();
2559 SbxBase::ResetError();
2561 else if( nLen
!= s
.getLength() && pVar
->IsNumeric() )
2563 err
= SbxBase::GetError();
2564 SbxBase::ResetError();
2567 err
= ERRCODE_BASIC_CONVERSION
;
2573 pVar
->PutString( s
);
2574 err
= SbxBase::GetError();
2575 SbxBase::ResetError();
2578 if( err
== ERRCODE_BASIC_USER_ABORT
)
2584 if( pRestart
&& !pIosys
->GetChannel() )
2599 // Line Input to Variable. The variable is on TOS and is
2600 // deleted afterwards.
2602 void SbiRuntime::StepLINPUT()
2605 pIosys
->Read( aInput
);
2606 Error( pIosys
->GetError() );
2607 SbxVariableRef p
= PopVar();
2608 p
->PutString(OStringToOUString(aInput
, osl_getThreadTextEncoding()));
2613 void SbiRuntime::StepSTOP()
2619 void SbiRuntime::StepINITFOR()
2624 void SbiRuntime::StepINITFOREACH()
2629 // increment FOR-variable
2631 void SbiRuntime::StepNEXT()
2635 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2638 if (pForStk
->eForType
!= ForType::To
)
2640 if (!pForStk
->refVar
)
2642 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2645 // tdf#85371 - grant explicitly write access to the index variable
2646 // since it could be the name of a method itself used in the next statement.
2647 ScopedWritableGuard
aGuard(pForStk
->refVar
, pForStk
->refVar
.get() == pMeth
);
2648 pForStk
->refVar
->Compute( SbxPLUS
, *pForStk
->refInc
);
2651 // beginning CASE: TOS in CASE-stack
2653 void SbiRuntime::StepCASE()
2655 if( !refCaseStk
.is() )
2657 refCaseStk
= new SbxArray
;
2659 SbxVariableRef xVar
= PopVar();
2660 refCaseStk
->Put(xVar
.get(), refCaseStk
->Count());
2663 // end CASE: free variable
2665 void SbiRuntime::StepENDCASE()
2667 if (!refCaseStk
.is() || !refCaseStk
->Count())
2669 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2673 refCaseStk
->Remove(refCaseStk
->Count() - 1);
2678 void SbiRuntime::StepSTDERROR()
2680 pError
= nullptr; bError
= true;
2681 pInst
->aErrorMsg
.clear();
2682 pInst
->nErr
= ERRCODE_NONE
;
2684 nError
= ERRCODE_NONE
;
2685 SbxErrObject::getUnoErrObject()->Clear();
2688 void SbiRuntime::StepNOERROR()
2690 pInst
->aErrorMsg
.clear();
2691 pInst
->nErr
= ERRCODE_NONE
;
2693 nError
= ERRCODE_NONE
;
2694 SbxErrObject::getUnoErrObject()->Clear();
2700 void SbiRuntime::StepLEAVE()
2703 // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
2704 if ( bInError
&& pError
)
2706 SbxErrObject::getUnoErrObject()->Clear();
2710 void SbiRuntime::StepCHANNEL() // TOS = channel number
2712 SbxVariableRef pChan
= PopVar();
2713 short nChan
= pChan
->GetInteger();
2714 pIosys
->SetChannel( nChan
);
2715 Error( pIosys
->GetError() );
2718 void SbiRuntime::StepCHANNEL0()
2720 pIosys
->ResetChannel();
2723 void SbiRuntime::StepPRINT() // print TOS
2725 SbxVariableRef p
= PopVar();
2726 OUString s1
= p
->GetOUString();
2728 if( p
->GetType() >= SbxINTEGER
&& p
->GetType() <= SbxDOUBLE
)
2730 s
= " "; // one blank before
2734 Error( pIosys
->GetError() );
2737 void SbiRuntime::StepPRINTF() // print TOS in field
2739 SbxVariableRef p
= PopVar();
2740 OUString s1
= p
->GetOUString();
2742 if( p
->GetType() >= SbxINTEGER
&& p
->GetType() <= SbxDOUBLE
)
2747 comphelper::string::padToLength(s
, 14, ' ');
2748 pIosys
->Write( s
.makeStringAndClear() );
2749 Error( pIosys
->GetError() );
2752 void SbiRuntime::StepWRITE() // write TOS
2754 SbxVariableRef p
= PopVar();
2755 // Does the string have to be encapsulated?
2757 switch (p
->GetType() )
2759 case SbxSTRING
: ch
= '"'; break;
2762 case SbxDATE
: ch
= '#'; break;
2768 s
+= OUStringChar(ch
);
2770 s
+= p
->GetOUString();
2773 s
+= OUStringChar(ch
);
2776 Error( pIosys
->GetError() );
2779 void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos
2781 SbxVariableRef pTos1
= PopVar();
2782 SbxVariableRef pTos
= PopVar();
2783 OUString aDest
= pTos1
->GetOUString();
2784 OUString aSource
= pTos
->GetOUString();
2788 implStepRenameUCB( aSource
, aDest
);
2792 implStepRenameOSL( aSource
, aDest
);
2798 void SbiRuntime::StepPROMPT()
2800 SbxVariableRef p
= PopVar();
2801 OString
aStr(OUStringToOString(p
->GetOUString(), osl_getThreadTextEncoding()));
2802 pIosys
->SetPrompt( aStr
);
2805 // Set Restart point
2807 void SbiRuntime::StepRESTART()
2812 // empty expression on stack for missing parameter
2814 void SbiRuntime::StepEMPTY()
2816 // #57915 The semantics of StepEMPTY() is the representation of a missing argument.
2817 // This is represented by the value 448 (ERRCODE_BASIC_NAMED_NOT_FOUND) of the type error
2818 // in VB. StepEmpty should now rather be named StepMISSING() but the name is kept
2819 // to simplify matters.
2820 SbxVariableRef xVar
= new SbxVariable( SbxVARIANT
);
2821 xVar
->PutErr( 448 );
2822 // tdf#79426, tdf#125180 - add additional information about a missing parameter
2823 SetIsMissing( xVar
.get() );
2824 PushVar( xVar
.get() );
2829 void SbiRuntime::StepERROR()
2831 SbxVariableRef refCode
= PopVar();
2832 sal_uInt16 n
= refCode
->GetUShort();
2833 ErrCode error
= StarBASIC::GetSfxFromVBError( n
);
2836 pInst
->Error( error
);
2844 // loading a numeric constant (+ID)
2846 void SbiRuntime::StepLOADNC( sal_uInt32 nOp1
)
2848 // tdf#143707 - check if the data type character was added after the string termination symbol
2849 SbxDataType eTypeStr
;
2850 // #57844 use localized function
2851 OUString aStr
= pImg
->GetString(static_cast<short>(nOp1
), &eTypeStr
);
2853 sal_Int32 iComma
= aStr
.indexOf(',');
2856 aStr
= aStr
.replaceAt(iComma
, 1, u
".");
2858 sal_Int32 nParseEnd
= 0;
2859 rtl_math_ConversionStatus eStatus
= rtl_math_ConversionStatus_Ok
;
2860 double n
= ::rtl::math::stringToDouble( aStr
, '.', ',', &eStatus
, &nParseEnd
);
2862 // tdf#131296 - retrieve data type put in SbiExprNode::Gen
2863 SbxDataType eType
= SbxDOUBLE
;
2864 if ( nParseEnd
< aStr
.getLength() )
2866 // tdf#143707 - Check if there was a data type character after the numeric constant,
2867 // added by older versions of the fix of the default values for strings.
2868 switch ( aStr
[nParseEnd
] )
2870 // See GetSuffixType in basic/source/comp/scanner.cxx for type characters
2871 case '%': eType
= SbxINTEGER
; break;
2872 case '&': eType
= SbxLONG
; break;
2873 case '!': eType
= SbxSINGLE
; break;
2874 case '@': eType
= SbxCURRENCY
; break;
2875 // tdf#142460 - properly handle boolean values in string pool
2876 case 'b': eType
= SbxBOOL
; break;
2879 // tdf#143707 - if the data type character is different from the default value, it was added
2880 // in basic/source/comp/symtbl.cxx. Hence, change the type of the numeric constant to be loaded.
2881 else if (eTypeStr
!= SbxSTRING
)
2885 SbxVariable
* p
= new SbxVariable( eType
);
2887 // tdf#133913 - create variable with Variant/Type in order to prevent type conversion errors
2888 p
->ResetFlag( SbxFlagBits::Fixed
);
2892 // loading a string constant (+ID)
2894 void SbiRuntime::StepLOADSC( sal_uInt32 nOp1
)
2896 SbxVariable
* p
= new SbxVariable
;
2897 p
->PutString( pImg
->GetString( static_cast<short>( nOp1
) ) );
2901 // Immediate Load (+value)
2902 // The opcode is not generated in SbiExprNode::Gen anymore; used for legacy images
2904 void SbiRuntime::StepLOADI( sal_uInt32 nOp1
)
2906 SbxVariable
* p
= new SbxVariable
;
2907 p
->PutInteger( static_cast<sal_Int16
>( nOp1
) );
2911 // store a named argument in Argv (+Arg-no. from 1!)
2913 void SbiRuntime::StepARGN( sal_uInt32 nOp1
)
2916 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2919 OUString
aAlias( pImg
->GetString( static_cast<short>( nOp1
) ) );
2920 SbxVariableRef pVal
= PopVar();
2922 ( dynamic_cast<const SbxMethod
*>( pVal
.get()) != nullptr
2923 || dynamic_cast<const SbUnoProperty
*>( pVal
.get()) != nullptr
2924 || dynamic_cast<const SbProcedureProperty
*>( pVal
.get()) != nullptr ) )
2926 // named variables ( that are Any especially properties ) can be empty at this point and need a broadcast
2927 if ( pVal
->GetType() == SbxEMPTY
)
2928 pVal
->Broadcast( SfxHintId::BasicDataWanted
);
2929 // evaluate methods and properties!
2930 SbxVariable
* pRes
= new SbxVariable( *pVal
);
2933 refArgv
->Put(pVal
.get(), nArgc
);
2934 refArgv
->PutAlias(aAlias
, nArgc
++);
2938 // converting the type of an argument in Argv for DECLARE-Fkt. (+type)
2940 void SbiRuntime::StepARGTYP( sal_uInt32 nOp1
)
2943 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2946 bool bByVal
= (nOp1
& 0x8000) != 0; // Is BYVAL requested?
2947 SbxDataType t
= static_cast<SbxDataType
>(nOp1
& 0x7FFF);
2948 SbxVariable
* pVar
= refArgv
->Get(refArgv
->Count() - 1); // last Arg
2951 if( pVar
->GetRefCount() > 2 ) // 2 is normal for BYVAL
2953 // parameter is a reference
2956 // Call by Value is requested -> create a copy
2957 pVar
= new SbxVariable( *pVar
);
2958 pVar
->SetFlag( SbxFlagBits::ReadWrite
);
2959 refExprStk
->Put(pVar
, refArgv
->Count() - 1);
2962 pVar
->SetFlag( SbxFlagBits::Reference
); // Ref-Flag for DllMgr
2966 // parameter is NO reference
2968 pVar
->ResetFlag( SbxFlagBits::Reference
); // no reference -> OK
2970 Error( ERRCODE_BASIC_BAD_PARAMETERS
); // reference needed
2973 if( pVar
->GetType() != t
)
2975 // variant for correct conversion
2976 // besides error, if SbxBYREF
2977 pVar
->Convert( SbxVARIANT
);
2983 // bring string to a definite length (+length)
2985 void SbiRuntime::StepPAD( sal_uInt32 nOp1
)
2987 SbxVariable
* p
= GetTOS();
2988 OUString s
= p
->GetOUString();
2989 sal_Int32
nLen(nOp1
);
2990 if( s
.getLength() == nLen
)
2993 OUStringBuffer
aBuf(s
);
2994 if (aBuf
.getLength() > nLen
)
2996 comphelper::string::truncateToLength(aBuf
, nLen
);
3000 comphelper::string::padToLength(aBuf
, nLen
, ' ');
3002 s
= aBuf
.makeStringAndClear();
3007 void SbiRuntime::StepJUMP( sal_uInt32 nOp1
)
3010 // #QUESTION shouldn't this be
3011 // if( (sal_uInt8*)( nOp1+pImagGetCode() ) >= pImg->GetCodeSize() )
3012 if( nOp1
>= pImg
->GetCodeSize() )
3013 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
3015 pCode
= pImg
->GetCode() + nOp1
;
3018 bool SbiRuntime::EvaluateTopOfStackAsBool()
3020 SbxVariableRef tos
= PopVar();
3021 // In a test e.g. If Null then
3022 // will evaluate Null will act as if False
3023 if ( bVBAEnabled
&& tos
->IsNull() )
3027 if ( tos
->IsObject() )
3029 //GetBool applied to an Object attempts to dereference and evaluate
3030 //the underlying value as Bool. Here, we're checking rather that
3032 return tos
->GetObject();
3036 return tos
->GetBool();
3040 // evaluate TOS, conditional jump (+target)
3042 void SbiRuntime::StepJUMPT( sal_uInt32 nOp1
)
3044 if ( EvaluateTopOfStackAsBool() )
3050 // evaluate TOS, conditional jump (+target)
3052 void SbiRuntime::StepJUMPF( sal_uInt32 nOp1
)
3054 if ( !EvaluateTopOfStackAsBool() )
3060 // evaluate TOS, jump into JUMP-table (+MaxVal)
3066 // if 0x8000 is set in the operand, push the return address (ON..GOSUB)
3068 void SbiRuntime::StepONJUMP( sal_uInt32 nOp1
)
3070 SbxVariableRef p
= PopVar();
3071 sal_Int16 n
= p
->GetInteger();
3075 PushGosub( pCode
+ 5 * nOp1
);
3077 if( n
< 1 || o3tl::make_unsigned(n
) > nOp1
)
3078 n
= static_cast<sal_Int16
>( nOp1
+ 1 );
3079 nOp1
= static_cast<sal_uInt32
>(pCode
- pImg
->GetCode()) + 5 * --n
;
3083 // UP-call (+target)
3085 void SbiRuntime::StepGOSUB( sal_uInt32 nOp1
)
3088 if( nOp1
>= pImg
->GetCodeSize() )
3089 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
3090 pCode
= pImg
->GetCode() + nOp1
;
3093 // UP-return (+0 or target)
3095 void SbiRuntime::StepRETURN( sal_uInt32 nOp1
)
3102 // check FOR-variable (+Endlabel)
3104 void SbiRuntime::StepTESTFOR( sal_uInt32 nOp1
)
3108 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
3112 bool bEndLoop
= false;
3113 switch( pForStk
->eForType
)
3117 SbxOperator eOp
= ( pForStk
->refInc
->GetDouble() < 0 ) ? SbxLT
: SbxGT
;
3118 if( pForStk
->refVar
->Compare( eOp
, *pForStk
->refEnd
) )
3120 if (SbxBase::IsError())
3121 pForStk
->eForType
= ForType::Error
; // terminate loop at the next iteration
3124 case ForType::EachArray
:
3126 SbiForStack
* p
= pForStk
;
3129 SbxBase::SetError(ERRCODE_BASIC_CONVERSION
);
3130 pForStk
->eForType
= ForType::Error
; // terminate loop at the next iteration
3132 else if (p
->pArrayCurIndices
== nullptr)
3138 SbxDimArray
* pArray
= reinterpret_cast<SbxDimArray
*>(p
->refEnd
.get());
3139 sal_Int32 nDims
= pArray
->GetDims();
3142 if( nDims
== 1 && p
->pArrayLowerBounds
[0] > p
->pArrayUpperBounds
[0] )
3147 SbxVariable
* pVal
= pArray
->Get(p
->pArrayCurIndices
.get());
3148 *(p
->refVar
) = *pVal
;
3150 bool bFoundNext
= false;
3151 for(sal_Int32 i
= 0 ; i
< nDims
; i
++ )
3153 if( p
->pArrayCurIndices
[i
] < p
->pArrayUpperBounds
[i
] )
3156 p
->pArrayCurIndices
[i
]++;
3157 for( sal_Int32 j
= i
- 1 ; j
>= 0 ; j
-- )
3158 p
->pArrayCurIndices
[j
] = p
->pArrayLowerBounds
[j
];
3164 p
->pArrayCurIndices
.reset();
3169 case ForType::EachCollection
:
3171 if (!pForStk
->refEnd
)
3173 SbxBase::SetError(ERRCODE_BASIC_CONVERSION
);
3174 pForStk
->eForType
= ForType::Error
; // terminate loop at the next iteration
3178 BasicCollection
* pCollection
= static_cast<BasicCollection
*>(pForStk
->refEnd
.get());
3179 SbxArrayRef xItemArray
= pCollection
->xItemArray
;
3180 sal_Int32 nCount
= xItemArray
->Count();
3181 if( pForStk
->nCurCollectionIndex
< nCount
)
3183 SbxVariable
* pRes
= xItemArray
->Get(pForStk
->nCurCollectionIndex
);
3184 pForStk
->nCurCollectionIndex
++;
3185 (*pForStk
->refVar
) = *pRes
;
3193 case ForType::EachXEnumeration
:
3195 SbiForStack
* p
= pForStk
;
3196 if (!p
->xEnumeration
)
3198 SbxBase::SetError(ERRCODE_BASIC_CONVERSION
);
3199 pForStk
->eForType
= ForType::Error
; // terminate loop at the next iteration
3201 else if (p
->xEnumeration
->hasMoreElements())
3203 Any aElem
= p
->xEnumeration
->nextElement();
3204 SbxVariableRef xVar
= new SbxVariable( SbxVARIANT
);
3205 unoToSbxValue( xVar
.get(), aElem
);
3206 (*pForStk
->refVar
) = *xVar
;
3214 // tdf#130307 - support for each loop for objects exposing XIndexAccess
3215 case ForType::EachXIndexAccess
:
3217 SbiForStack
* p
= pForStk
;
3218 if (!p
->xIndexAccess
)
3220 SbxBase::SetError(ERRCODE_BASIC_CONVERSION
);
3221 pForStk
->eForType
= ForType::Error
; // terminate loop at the next iteration
3223 else if (pForStk
->nCurCollectionIndex
< p
->xIndexAccess
->getCount())
3225 Any aElem
= p
->xIndexAccess
->getByIndex(pForStk
->nCurCollectionIndex
);
3226 pForStk
->nCurCollectionIndex
++;
3227 SbxVariableRef xVar
= new SbxVariable(SbxVARIANT
);
3228 unoToSbxValue(xVar
.get(), aElem
);
3229 (*pForStk
->refVar
) = *xVar
;
3237 case ForType::Error
:
3239 // We are in Resume Next mode after failed loop initialization
3241 Error(ERRCODE_BASIC_BAD_PARAMETER
);
3252 // Tos+1 <= Tos+2 <= Tos, 2xremove (+Target)
3254 void SbiRuntime::StepCASETO( sal_uInt32 nOp1
)
3256 if (!refCaseStk
.is() || !refCaseStk
->Count())
3257 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
3260 SbxVariableRef xTo
= PopVar();
3261 SbxVariableRef xFrom
= PopVar();
3262 SbxVariableRef xCase
= refCaseStk
->Get(refCaseStk
->Count() - 1);
3263 if( *xCase
>= *xFrom
&& *xCase
<= *xTo
)
3269 void SbiRuntime::StepERRHDL( sal_uInt32 nOp1
)
3271 const sal_uInt8
* p
= pCode
;
3275 pInst
->aErrorMsg
.clear();
3276 pInst
->nErr
= ERRCODE_NONE
;
3278 nError
= ERRCODE_NONE
;
3279 SbxErrObject::getUnoErrObject()->Clear();
3282 // Resume after errors (+0=statement, 1=next or Label)
3284 void SbiRuntime::StepRESUME( sal_uInt32 nOp1
)
3286 // #32714 Resume without error? -> error
3289 Error( ERRCODE_BASIC_BAD_RESUME
);
3294 // set Code-pointer to the next statement
3296 pCode
= pMod
->FindNextStmnt( pErrCode
, n1
, n2
, true, pImg
);
3300 if ( pError
) // current in error handler ( and got a Resume Next statement )
3301 SbxErrObject::getUnoErrObject()->Clear();
3305 pInst
->aErrorMsg
.clear();
3306 pInst
->nErr
= ERRCODE_NONE
;
3308 nError
= ERRCODE_NONE
;
3312 // close channel (+channel, 0=all)
3313 void SbiRuntime::StepCLOSE( sal_uInt32 nOp1
)
3320 err
= pIosys
->GetError();
3326 err
= pIosys
->GetError();
3330 // output character (+char)
3332 void SbiRuntime::StepPRCHAR( sal_uInt32 nOp1
)
3334 OUString
s(static_cast<sal_Unicode
>(nOp1
));
3336 Error( pIosys
->GetError() );
3339 // check whether TOS is a certain object class (+StringID)
3341 bool SbiRuntime::implIsClass( SbxObject
const * pObj
, const OUString
& aClass
)
3345 if( !aClass
.isEmpty() )
3347 bRet
= pObj
->IsClass( aClass
);
3349 bRet
= aClass
.equalsIgnoreAsciiCase( "object" );
3352 const OUString
& aObjClass
= pObj
->GetClassName();
3353 SbModule
* pClassMod
= GetSbData()->pClassFac
->FindClass( aObjClass
);
3356 SbClassData
* pClassData
= pClassMod
->pClassData
.get();
3357 if (pClassData
!= nullptr )
3359 SbxVariable
* pClassVar
= pClassData
->mxIfaces
->Find( aClass
, SbxClassType::DontCare
);
3360 bRet
= (pClassVar
!= nullptr);
3368 bool SbiRuntime::checkClass_Impl( const SbxVariableRef
& refVal
,
3369 const OUString
& aClass
, bool bRaiseErrors
, bool bDefault
)
3371 bool bOk
= bDefault
;
3373 SbxDataType t
= refVal
->GetType();
3374 SbxVariable
* pVal
= refVal
.get();
3375 // we don't know the type of uno properties that are (maybevoid)
3376 if ( t
== SbxEMPTY
)
3378 if ( auto pProp
= dynamic_cast<SbUnoProperty
*>( refVal
.get() ) )
3380 t
= pProp
->getRealType();
3383 if( t
== SbxOBJECT
|| bVBAEnabled
)
3385 SbxObject
* pObj
= dynamic_cast<SbxObject
*>(pVal
);
3388 pObj
= dynamic_cast<SbxObject
*>(refVal
->GetObject());
3392 if( !implIsClass( pObj
, aClass
) )
3394 SbUnoObject
* pUnoObj(nullptr);
3395 if (bVBAEnabled
|| CodeCompleteOptions::IsExtendedTypeDeclaration())
3397 pUnoObj
= dynamic_cast<SbUnoObject
*>(pObj
);
3401 bOk
= checkUnoObjectType(*pUnoObj
, aClass
);
3404 if ( !bOk
&& bRaiseErrors
)
3405 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
3411 SbClassModuleObject
* pClassModuleObject
= dynamic_cast<SbClassModuleObject
*>( pObj
);
3412 if( pClassModuleObject
!= nullptr )
3413 pClassModuleObject
->triggerInitializeEvent();
3420 Error( ERRCODE_BASIC_NEEDS_OBJECT
);
3426 void SbiRuntime::StepSETCLASS_impl( sal_uInt32 nOp1
, bool bHandleDflt
)
3428 SbxVariableRef refVal
= PopVar();
3429 SbxVariableRef refVar
= PopVar();
3430 OUString
aClass( pImg
->GetString( static_cast<short>( nOp1
) ) );
3432 bool bOk
= checkClass_Impl( refVal
, aClass
, true, true );
3435 StepSET_Impl( refVal
, refVar
, bHandleDflt
); // don't do handle default prop for a "proper" set
3439 void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1
)
3441 StepSETCLASS_impl( nOp1
, false );
3444 void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1
)
3446 StepSETCLASS_impl( nOp1
, true );
3449 void SbiRuntime::StepTESTCLASS( sal_uInt32 nOp1
)
3451 SbxVariableRef xObjVal
= PopVar();
3452 OUString
aClass( pImg
->GetString( static_cast<short>( nOp1
) ) );
3453 bool bDefault
= !bVBAEnabled
;
3454 bool bOk
= checkClass_Impl( xObjVal
, aClass
, false, bDefault
);
3456 SbxVariable
* pRet
= new SbxVariable
;
3457 pRet
->PutBool( bOk
);
3461 // define library for following declare-call
3463 void SbiRuntime::StepLIB( sal_uInt32 nOp1
)
3465 aLibName
= pImg
->GetString( static_cast<short>( nOp1
) );
3468 // TOS is incremented by BASE, BASE is pushed before (+BASE)
3469 // This opcode is pushed before DIM/REDIM-commands,
3470 // if there's been only one index named.
3472 void SbiRuntime::StepBASED( sal_uInt32 nOp1
)
3474 SbxVariable
* p1
= new SbxVariable
;
3475 SbxVariableRef x2
= PopVar();
3477 // #109275 Check compatibility mode
3478 bool bCompatible
= ((nOp1
& 0x8000) != 0);
3479 sal_uInt16 uBase
= static_cast<sal_uInt16
>(nOp1
& 1); // Can only be 0 or 1
3480 p1
->PutInteger( uBase
);
3483 // tdf#85371 - grant explicitly write access to the dimension variable
3484 // since in Star/OpenOffice Basic the upper index border is affected,
3485 // and the dimension variable could be the name of the method itself.
3486 ScopedWritableGuard
aGuard(x2
, x2
.get() == pMeth
);
3487 x2
->Compute( SbxPLUS
, *p1
);
3489 PushVar( x2
.get() ); // first the Expr
3490 PushVar( p1
); // then the Base
3493 // the bits in the String-ID:
3494 // 0x8000 - Argv is reserved
3496 SbxVariable
* SbiRuntime::FindElement( SbxObject
* pObj
, sal_uInt32 nOp1
, sal_uInt32 nOp2
,
3497 ErrCode nNotFound
, bool bLocal
, bool bStatic
)
3499 bool bIsVBAInterOp
= SbiRuntime::isVBAEnabled();
3502 StarBASIC
* pMSOMacroRuntimeLib
= GetSbData()->pMSOMacroRuntimLib
;
3503 if( pMSOMacroRuntimeLib
!= nullptr )
3505 pMSOMacroRuntimeLib
->ResetFlag( SbxFlagBits::ExtSearch
);
3509 SbxVariable
* pElem
= nullptr;
3512 Error( ERRCODE_BASIC_NO_OBJECT
);
3513 pElem
= new SbxVariable
;
3517 bool bFatalError
= false;
3518 SbxDataType t
= static_cast<SbxDataType
>(nOp2
);
3519 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
& 0x7FFF ) ) );
3520 // Hacky capture of Evaluate [] syntax
3521 // this should be tackled I feel at the pcode level
3522 if ( bIsVBAInterOp
&& aName
.startsWith("[") )
3524 // emulate pcode here
3526 // pseudo StepLOADSC
3527 OUString sArg
= aName
.copy( 1, aName
.getLength() - 2 );
3528 SbxVariable
* p
= new SbxVariable
;
3529 p
->PutString( sArg
);
3532 nOp1
= nOp1
| 0x8000; // indicate params are present
3537 if ( bStatic
&& pMeth
)
3539 pElem
= pMeth
->GetStatics()->Find( aName
, SbxClassType::DontCare
);
3544 pElem
= refLocals
->Find( aName
, SbxClassType::DontCare
);
3549 bool bSave
= rBasic
.bNoRtl
;
3550 rBasic
.bNoRtl
= true;
3551 pElem
= pObj
->Find( aName
, SbxClassType::DontCare
);
3553 // #110004, #112015: Make private really private
3554 if( bLocal
&& pElem
) // Local as flag for global search
3556 if( pElem
->IsSet( SbxFlagBits::Private
) )
3558 SbiInstance
* pInst_
= GetSbData()->pInst
;
3559 if( pInst_
&& pInst_
->IsCompatibility() && pObj
!= pElem
->GetParent() )
3561 pElem
= nullptr; // Found but in wrong module!
3563 // Interfaces: Use SbxFlagBits::ExtFound
3566 rBasic
.bNoRtl
= bSave
;
3568 // is it a global uno-identifier?
3569 if( bLocal
&& !pElem
)
3571 bool bSetName
= true; // preserve normal behaviour
3573 // i#i68894# if VBAInterOp favour searching vba globals
3574 // over searching for uno classes
3577 // Try Find in VBA symbols space
3578 pElem
= rBasic
.VBAFind( aName
, SbxClassType::DontCare
);
3581 bSetName
= false; // don't overwrite uno name
3585 pElem
= VBAConstantHelper::instance().getVBAConstant( aName
);
3591 // #72382 ATTENTION! ALWAYS returns a result now
3592 // because of unknown modules!
3593 SbUnoClass
* pUnoClass
= findUnoClass( aName
);
3596 pElem
= new SbxVariable( t
);
3597 SbxValues
aRes( SbxOBJECT
);
3598 aRes
.pObj
= pUnoClass
;
3599 pElem
->SbxVariable::Put( aRes
);
3603 // #62939 If a uno-class has been found, the wrapper
3604 // object has to be held, because the uno-class, e. g.
3605 // "stardiv", has to be read out of the registry
3606 // every time again otherwise
3609 // #63774 May not be saved too!!!
3610 pElem
->SetFlag( SbxFlagBits::DontStore
);
3611 pElem
->SetFlag( SbxFlagBits::NoModify
);
3613 // #72382 save locally, all variables that have been declared
3614 // implicit would become global automatically otherwise!
3617 pElem
->SetName( aName
);
3619 refLocals
->Put(pElem
, refLocals
->Count());
3625 // not there and not in the object?
3626 // don't establish if that thing has parameters!
3632 // else, if there are parameters, use different error code
3633 if( !bLocal
|| pImg
->IsFlag( SbiImageFlags::EXPLICIT
) )
3635 // #39108 if explicit and as ELEM always a fatal error
3639 if( !( nOp1
& 0x8000 ) && nNotFound
== ERRCODE_BASIC_PROC_UNDEFINED
)
3641 nNotFound
= ERRCODE_BASIC_VAR_UNDEFINED
;
3646 // #39108 use dummy variable instead of fatal error
3647 if( !xDummyVar
.is() )
3649 xDummyVar
= new SbxVariable( SbxVARIANT
);
3651 pElem
= xDummyVar
.get();
3655 Error( nNotFound
, aName
);
3661 pElem
= StepSTATIC_Impl( aName
, t
, 0 );
3665 pElem
= new SbxVariable( t
);
3666 if( t
!= SbxVARIANT
)
3668 pElem
->SetFlag( SbxFlagBits::Fixed
);
3670 pElem
->SetName( aName
);
3671 refLocals
->Put(pElem
, refLocals
->Count());
3676 // #39108 Args can already be deleted!
3679 SetupArgs( pElem
, nOp1
);
3681 // because a particular call-type is requested
3682 if (SbxMethod
* pMethod
= dynamic_cast<SbxMethod
*>(pElem
))
3684 // shall the type be converted?
3685 SbxDataType t2
= pElem
->GetType();
3687 if( (pElem
->GetFlags() & SbxFlagBits::Fixed
) == SbxFlagBits::NONE
)
3689 if( t
!= SbxVARIANT
&& t
!= t2
&&
3690 t
>= SbxINTEGER
&& t
<= SbxSTRING
)
3692 pElem
->SetType( t
);
3696 // assign pElem to a Ref, to delete a temp-var if applicable
3697 SbxVariableRef xDeleteRef
= pElem
;
3699 // remove potential rests of the last call of the SbxMethod
3700 // free Write before, so that there's no error
3701 SbxFlagBits nSavFlags
= pElem
->GetFlags();
3702 pElem
->SetFlag( SbxFlagBits::ReadWrite
| SbxFlagBits::NoBroadcast
);
3703 pElem
->SbxValue::Clear();
3704 pElem
->SetFlags( nSavFlags
);
3706 // don't touch before setting, as e. g. LEFT()
3707 // has to know the difference between Left$() and Left()
3709 // because the methods' parameters are cut away in PopVar()
3710 SbxVariable
* pNew
= new SbxMethod(*pMethod
);
3711 //OLD: SbxVariable* pNew = new SbxVariable( *pElem );
3713 pElem
->SetParameters(nullptr);
3714 pNew
->SetFlag( SbxFlagBits::ReadWrite
);
3718 pElem
->SetType( t2
);
3722 // consider index-access for UnoObjects
3723 // definitely we want this for VBA where properties are often
3724 // collections ( which need index access ), but lets only do
3725 // this if we actually have params following
3726 else if( bVBAEnabled
&& dynamic_cast<const SbUnoProperty
*>( pElem
) != nullptr && pElem
->GetParameters() )
3728 SbxVariableRef xDeleteRef
= pElem
;
3730 // dissolve the notify while copying variable
3731 SbxVariable
* pNew
= new SbxVariable( *pElem
);
3732 pElem
->SetParameters( nullptr );
3736 return CheckArray( pElem
);
3739 // for current scope (e. g. query from BASIC-IDE)
3740 SbxBase
* SbiRuntime::FindElementExtern( const OUString
& rName
)
3742 // don't expect pMeth to be != 0, as there are none set
3743 // in the RunInit yet
3745 SbxVariable
* pElem
= nullptr;
3746 if( !pMod
|| rName
.isEmpty() )
3750 if( refLocals
.is() )
3752 pElem
= refLocals
->Find( rName
, SbxClassType::DontCare
);
3754 if ( !pElem
&& pMeth
)
3756 const OUString aMethName
= pMeth
->GetName();
3757 // tdf#57308 - check if the name is the current method instance
3758 if (pMeth
->GetName() == rName
)
3764 // for statics, set the method's name in front
3765 pElem
= pMod
->Find(aMethName
+ ":" + rName
, SbxClassType::DontCare
);
3770 // search in parameter list
3771 if( !pElem
&& pMeth
)
3773 SbxInfo
* pInfo
= pMeth
->GetInfo();
3774 if( pInfo
&& refParams
.is() )
3776 sal_uInt32 nParamCount
= refParams
->Count();
3777 assert(nParamCount
<= std::numeric_limits
<sal_uInt16
>::max());
3779 const SbxParamInfo
* pParam
= pInfo
->GetParam( j
);
3782 if( pParam
->aName
.equalsIgnoreAsciiCase( rName
) )
3784 if( j
>= nParamCount
)
3786 // Parameter is missing
3787 pElem
= new SbxVariable( SbxSTRING
);
3788 pElem
->PutString( "<missing parameter>");
3792 pElem
= refParams
->Get(j
);
3796 pParam
= pInfo
->GetParam( ++j
);
3804 bool bSave
= rBasic
.bNoRtl
;
3805 rBasic
.bNoRtl
= true;
3806 pElem
= pMod
->Find( rName
, SbxClassType::DontCare
);
3807 rBasic
.bNoRtl
= bSave
;
3813 void SbiRuntime::SetupArgs( SbxVariable
* p
, sal_uInt32 nOp1
)
3819 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
3821 bool bHasNamed
= false;
3823 sal_uInt32 nArgCount
= refArgv
->Count();
3824 for( i
= 1 ; i
< nArgCount
; i
++ )
3826 if (!refArgv
->GetAlias(i
).isEmpty())
3828 bHasNamed
= true; break;
3833 SbxInfo
* pInfo
= p
->GetInfo();
3836 bool bError_
= true;
3838 SbUnoMethod
* pUnoMethod
= dynamic_cast<SbUnoMethod
*>( p
);
3839 SbUnoProperty
* pUnoProperty
= dynamic_cast<SbUnoProperty
*>( p
);
3840 if( pUnoMethod
|| pUnoProperty
)
3842 SbUnoObject
* pParentUnoObj
= dynamic_cast<SbUnoObject
*>( p
->GetParent() );
3845 Any aUnoAny
= pParentUnoObj
->getUnoAny();
3846 Reference
< XInvocation
> xInvocation
;
3847 aUnoAny
>>= xInvocation
;
3848 if( xInvocation
.is() ) // TODO: if( xOLEAutomation.is() )
3852 sal_uInt32 nCurPar
= 1;
3853 AutomationNamedArgsSbxArray
* pArg
=
3854 new AutomationNamedArgsSbxArray( nArgCount
);
3855 OUString
* pNames
= pArg
->getNames().getArray();
3856 for( i
= 1 ; i
< nArgCount
; i
++ )
3858 SbxVariable
* pVar
= refArgv
->Get(i
);
3859 OUString aName
= refArgv
->GetAlias(i
);
3860 if (!aName
.isEmpty())
3864 pArg
->Put(pVar
, nCurPar
++);
3870 else if( bVBAEnabled
&& p
->GetType() == SbxOBJECT
&& (dynamic_cast<const SbxMethod
*>( p
) == nullptr || !p
->IsBroadcaster()) )
3872 // Check for default method with named parameters
3873 SbxBaseRef xObj
= p
->GetObject();
3874 if (SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>( xObj
.get() ))
3876 Any aAny
= pUnoObj
->getUnoAny();
3878 if( aAny
.getValueType().getTypeClass() == TypeClass_INTERFACE
)
3880 Reference
< XDefaultMethod
> xDfltMethod( aAny
, UNO_QUERY
);
3882 OUString sDefaultMethod
;
3883 if ( xDfltMethod
.is() )
3885 sDefaultMethod
= xDfltMethod
->getDefaultMethodName();
3887 if ( !sDefaultMethod
.isEmpty() )
3889 SbxVariable
* meth
= pUnoObj
->Find( sDefaultMethod
, SbxClassType::Method
);
3890 if( meth
!= nullptr )
3892 pInfo
= meth
->GetInfo();
3904 Error( ERRCODE_BASIC_NO_NAMED_ARGS
);
3909 sal_uInt32 nCurPar
= 1;
3910 SbxArray
* pArg
= new SbxArray
;
3911 for( i
= 1 ; i
< nArgCount
; i
++ )
3913 SbxVariable
* pVar
= refArgv
->Get(i
);
3914 OUString aName
= refArgv
->GetAlias(i
);
3915 if (!aName
.isEmpty())
3917 // nCurPar is set to the found parameter
3919 const SbxParamInfo
* pParam
= pInfo
->GetParam( j
);
3922 if( pParam
->aName
.equalsIgnoreAsciiCase( aName
) )
3927 pParam
= pInfo
->GetParam( ++j
);
3931 Error( ERRCODE_BASIC_NAMED_NOT_FOUND
); break;
3934 pArg
->Put(pVar
, nCurPar
++);
3939 // own var as parameter 0
3941 p
->SetParameters( refArgv
.get() );
3946 p
->SetParameters( nullptr );
3950 // getting an array element
3952 SbxVariable
* SbiRuntime::CheckArray( SbxVariable
* pElem
)
3955 if( ( pElem
->GetType() & SbxARRAY
) && refRedim
.get() != pElem
)
3957 SbxBase
* pElemObj
= pElem
->GetObject();
3958 SbxDimArray
* pDimArray
= dynamic_cast<SbxDimArray
*>( pElemObj
);
3959 pPar
= pElem
->GetParameters();
3962 // parameters may be missing, if an array is
3963 // passed as an argument
3965 pElem
= pDimArray
->Get( pPar
);
3969 SbxArray
* pArray
= dynamic_cast<SbxArray
*>( pElemObj
);
3974 Error( ERRCODE_BASIC_OUT_OF_RANGE
);
3975 pElem
= new SbxVariable
;
3979 pElem
= pArray
->Get(pPar
->Get(1)->GetInteger());
3984 // #42940, set parameter 0 to NULL so that var doesn't contain itself
3987 pPar
->Put(nullptr, 0);
3990 // consider index-access for UnoObjects
3991 else if( pElem
->GetType() == SbxOBJECT
&&
3992 dynamic_cast<const SbxMethod
*>( pElem
) == nullptr &&
3993 ( !bVBAEnabled
|| dynamic_cast<const SbxProperty
*>( pElem
) == nullptr ) )
3995 pPar
= pElem
->GetParameters();
3998 // is it a uno-object?
3999 SbxBaseRef pObj
= pElem
->GetObject();
4002 if (SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>( pObj
.get()))
4004 Any aAny
= pUnoObj
->getUnoAny();
4006 if( aAny
.getValueType().getTypeClass() == TypeClass_INTERFACE
)
4008 Reference
< XIndexAccess
> xIndexAccess( aAny
, UNO_QUERY
);
4011 if( xIndexAccess
.is() )
4013 sal_uInt32 nParamCount
= pPar
->Count() - 1;
4014 if( nParamCount
!= 1 )
4016 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4021 sal_Int32 nIndex
= pPar
->Get(1)->GetLong();
4022 Reference
< XInterface
> xRet
;
4025 Any aAny2
= xIndexAccess
->getByIndex( nIndex
);
4028 catch (const IndexOutOfBoundsException
&)
4030 // usually expect converting problem
4031 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE
);
4034 // #57847 always create a new variable, else error
4035 // due to PutObject(NULL) at ReadOnly-properties
4036 pElem
= new SbxVariable( SbxVARIANT
);
4041 // #67173 don't specify a name so that the real class name is entered
4042 SbxObjectRef xWrapper
= static_cast<SbxObject
*>(new SbUnoObject( OUString(), aAny
));
4043 pElem
->PutObject( xWrapper
.get() );
4047 pElem
->PutObject( nullptr );
4053 // check if there isn't a default member between the current variable
4054 // and the params, e.g.
4055 // Dim rst1 As New ADODB.Recordset
4057 // val = rst1("FirstName")
4058 // has the default 'Fields' member between rst1 and '("FirstName")'
4060 SbxVariable
* pDflt
= getDefaultProp( pElem
);
4063 pDflt
->Broadcast( SfxHintId::BasicDataWanted
);
4064 SbxBaseRef pDfltObj
= pDflt
->GetObject();
4067 if (SbUnoObject
* pSbObj
= dynamic_cast<SbUnoObject
*>(pDfltObj
.get()))
4070 Any aUnoAny
= pUnoObj
->getUnoAny();
4072 if( aUnoAny
.getValueType().getTypeClass() == TypeClass_INTERFACE
)
4078 OUString sDefaultMethod
;
4080 Reference
< XDefaultMethod
> xDfltMethod( x
, UNO_QUERY
);
4082 if ( xDfltMethod
.is() )
4084 sDefaultMethod
= xDfltMethod
->getDefaultMethodName();
4086 else if( xIndexAccess
.is() )
4088 sDefaultMethod
= "getByIndex";
4090 if ( !sDefaultMethod
.isEmpty() )
4092 SbxVariable
* meth
= pUnoObj
->Find( sDefaultMethod
, SbxClassType::Method
);
4093 SbxVariableRef refTemp
= meth
;
4096 meth
->SetParameters( pPar
);
4097 SbxVariable
* pNew
= new SbxMethod( *static_cast<SbxMethod
*>(meth
) );
4104 // #42940, set parameter 0 to NULL so that var doesn't contain itself
4105 pPar
->Put(nullptr, 0);
4107 else if (BasicCollection
* pCol
= dynamic_cast<BasicCollection
*>(pObj
.get()))
4109 pElem
= new SbxVariable( SbxVARIANT
);
4110 pPar
->Put(pElem
, 0);
4111 pCol
->CollItem( pPar
);
4114 else if( bVBAEnabled
) // !pObj
4116 SbxArray
* pParam
= pElem
->GetParameters();
4117 if( pParam
!= nullptr && !pElem
->IsSet( SbxFlagBits::VarToDim
) )
4119 Error( ERRCODE_BASIC_NO_OBJECT
);
4128 // loading an element from the runtime-library (+StringID+type)
4130 void SbiRuntime::StepRTL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4132 PushVar( FindElement( rBasic
.pRtl
.get(), nOp1
, nOp2
, ERRCODE_BASIC_PROC_UNDEFINED
, false ) );
4135 void SbiRuntime::StepFIND_Impl( SbxObject
* pObj
, sal_uInt32 nOp1
, sal_uInt32 nOp2
,
4136 ErrCode nNotFound
, bool bStatic
)
4138 if( !refLocals
.is() )
4140 refLocals
= new SbxArray
;
4142 PushVar( FindElement( pObj
, nOp1
, nOp2
, nNotFound
, true/*bLocal*/, bStatic
) );
4144 // loading a local/global variable (+StringID+type)
4146 void SbiRuntime::StepFIND( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4148 StepFIND_Impl( pMod
, nOp1
, nOp2
, ERRCODE_BASIC_PROC_UNDEFINED
);
4151 // Search inside a class module (CM) to enable global search in time
4152 void SbiRuntime::StepFIND_CM( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4155 SbClassModuleObject
* pClassModuleObject
= dynamic_cast<SbClassModuleObject
*>( pMod
);
4156 if( pClassModuleObject
)
4158 pMod
->SetFlag( SbxFlagBits::GlobalSearch
);
4160 StepFIND_Impl( pMod
, nOp1
, nOp2
, ERRCODE_BASIC_PROC_UNDEFINED
);
4162 if( pClassModuleObject
)
4164 pMod
->ResetFlag( SbxFlagBits::GlobalSearch
);
4168 void SbiRuntime::StepFIND_STATIC( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4170 StepFIND_Impl( pMod
, nOp1
, nOp2
, ERRCODE_BASIC_PROC_UNDEFINED
, true );
4173 // loading an object-element (+StringID+type)
4174 // the object lies on TOS
4176 void SbiRuntime::StepELEM( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4178 SbxVariableRef pObjVar
= PopVar();
4180 SbxObject
* pObj
= dynamic_cast<SbxObject
*>( pObjVar
.get() );
4183 SbxBase
* pObjVarObj
= pObjVar
->GetObject();
4184 pObj
= dynamic_cast<SbxObject
*>( pObjVarObj
);
4187 // #56368 save reference at StepElem, otherwise objects could
4188 // lose their reference too early in qualification chains like
4189 // ActiveComponent.Selection(0).Text
4190 // #74254 now per list
4193 aRefSaved
.emplace_back(pObj
);
4195 PushVar( FindElement( pObj
, nOp1
, nOp2
, ERRCODE_BASIC_NO_METHOD
, false ) );
4198 /** Loading of a parameter (+offset+type)
4199 If the data type is wrong, create a copy and search for optionals including
4200 the default value. The data type SbxEMPTY shows that no parameters are given.
4201 Get( 0 ) may be EMPTY
4204 the index of the current parameter being processed,
4205 where the entry of the index 0 is for the return value.
4208 the data type of the parameter.
4210 void SbiRuntime::StepPARAM( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4212 sal_uInt16 nIdx
= static_cast<sal_uInt16
>( nOp1
& 0x7FFF );
4213 SbxDataType eType
= static_cast<SbxDataType
>(nOp2
);
4216 // #57915 solve missing in a cleaner way
4217 sal_uInt32 nParamCount
= refParams
->Count();
4218 if( nIdx
>= nParamCount
)
4220 sal_uInt16 iLoop
= nIdx
;
4221 while( iLoop
>= nParamCount
)
4223 pVar
= new SbxVariable();
4224 pVar
->PutErr( 448 ); // like in VB: Error-Code 448 (ERRCODE_BASIC_NAMED_NOT_FOUND)
4225 // tdf#79426, tdf#125180 - add additional information about a missing parameter
4226 SetIsMissing( pVar
);
4227 refParams
->Put(pVar
, iLoop
);
4231 pVar
= refParams
->Get(nIdx
);
4233 // tdf#79426, tdf#125180 - check for optionals only if the parameter is actually missing
4234 if( pVar
->GetType() == SbxERROR
&& IsMissing( pVar
, 1 ) && nIdx
)
4236 // if there's a parameter missing, it can be OPTIONAL
4240 SbxInfo
* pInfo
= pMeth
->GetInfo();
4243 const SbxParamInfo
* pParam
= pInfo
->GetParam( nIdx
);
4244 if( pParam
&& ( pParam
->nFlags
& SbxFlagBits::Optional
) )
4246 // tdf#136143 - reset SbxFlagBits::Fixed in order to prevent type conversion errors
4247 pVar
->ResetFlag( SbxFlagBits::Fixed
);
4249 sal_uInt16 nDefaultId
= static_cast<sal_uInt16
>(pParam
->nUserData
& 0x0ffff);
4250 if( nDefaultId
> 0 )
4252 // tdf#143707 - check if the data type character was added after the string
4253 // termination symbol, and convert the variable if it was present. The
4254 // data type character was added in basic/source/comp/symtbl.cxx.
4255 SbxDataType eTypeStr
;
4256 OUString aDefaultStr
= pImg
->GetString( nDefaultId
, &eTypeStr
);
4257 pVar
= new SbxVariable(pParam
-> eType
);
4258 pVar
->PutString( aDefaultStr
);
4259 if (eTypeStr
!= SbxSTRING
)
4260 pVar
->Convert(eTypeStr
);
4261 refParams
->Put(pVar
, nIdx
);
4263 else if ( SbiRuntime::isVBAEnabled() && eType
!= SbxVARIANT
)
4265 // tdf#36737 - initialize the parameter with the default value of its type
4266 pVar
= new SbxVariable( pParam
->eType
);
4267 refParams
->Put(pVar
, nIdx
);
4275 Error( ERRCODE_BASIC_NOT_OPTIONAL
);
4278 else if( eType
!= SbxVARIANT
&& static_cast<SbxDataType
>(pVar
->GetType() & 0x0FFF ) != eType
)
4280 // tdf#43003 - convert parameter to the requested type
4281 pVar
->Convert(eType
);
4283 SetupArgs( pVar
, nOp1
);
4284 PushVar( CheckArray( pVar
) );
4287 // Case-Test (+True-Target+Test-Opcode)
4289 void SbiRuntime::StepCASEIS( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4291 if (!refCaseStk
.is() || !refCaseStk
->Count())
4293 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
4297 SbxVariableRef xComp
= PopVar();
4298 SbxVariableRef xCase
= refCaseStk
->Get(refCaseStk
->Count() - 1);
4299 if( xCase
->Compare( static_cast<SbxOperator
>(nOp2
), *xComp
) )
4306 // call of a DLL-procedure (+StringID+type)
4307 // the StringID's MSB shows that Argv is occupied
4309 void SbiRuntime::StepCALL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4311 OUString aName
= pImg
->GetString( static_cast<short>( nOp1
& 0x7FFF ) );
4312 SbxArray
* pArgs
= nullptr;
4315 pArgs
= refArgv
.get();
4317 DllCall( aName
, aLibName
, pArgs
, static_cast<SbxDataType
>(nOp2
), false );
4325 // call of a DLL-procedure after CDecl (+StringID+type)
4327 void SbiRuntime::StepCALLC( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4329 OUString aName
= pImg
->GetString( static_cast<short>( nOp1
& 0x7FFF ) );
4330 SbxArray
* pArgs
= nullptr;
4333 pArgs
= refArgv
.get();
4335 DllCall( aName
, aLibName
, pArgs
, static_cast<SbxDataType
>(nOp2
), true );
4344 // beginning of a statement (+Line+Col)
4346 void SbiRuntime::StepSTMNT( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4348 // If the Expr-Stack at the beginning of a statement contains a variable,
4349 // some fool has called X as a function, although it's a variable!
4350 bool bFatalExpr
= false;
4351 OUString sUnknownMethodName
;
4358 SbxVariable
* p
= refExprStk
->Get(0);
4359 if( p
->GetRefCount() > 1 &&
4360 refLocals
.is() && refLocals
->Find( p
->GetName(), p
->GetClass() ) )
4362 sUnknownMethodName
= p
->GetName();
4371 // We have to cancel hard here because line and column
4372 // would be wrong later otherwise!
4375 StarBASIC::FatalError( ERRCODE_BASIC_NO_METHOD
, sUnknownMethodName
);
4379 sal_uInt16 nOld
= nLine
;
4380 nLine
= static_cast<short>( nOp1
);
4382 // #29955 & 0xFF, to filter out for-loop-level
4383 nCol1
= static_cast<short>( nOp2
& 0xFF );
4385 // find the next STMNT-command to set the final column
4386 // of this statement
4390 const sal_uInt8
* p
= pMod
->FindNextStmnt( pCode
, n1
, n2
);
4395 // #29955 & 0xFF, to filter out for-loop-level
4396 nCol2
= (n2
& 0xFF) - 1;
4400 // #29955 correct for-loop-level, #67452 NOT in the error-handler
4403 // (there's a difference here in case of a jump out of a loop)
4404 sal_uInt16 nExpectedForLevel
= static_cast<sal_uInt16
>( nOp2
/ 0x100 );
4405 if( !pGosubStk
.empty() )
4407 nExpectedForLevel
= nExpectedForLevel
+ pGosubStk
.back().nStartForLvl
;
4410 // if the actual for-level is too small it'd jump out
4411 // of a loop -> corrected
4412 while( nForLvl
> nExpectedForLevel
)
4418 // 16.10.96: #31460 new concept for StepInto/Over/Out
4419 // see explanation at _ImplGetBreakCallLevel
4420 if( pInst
->nCallLvl
<= pInst
->nBreakCallLvl
)
4422 StarBASIC
* pStepBasic
= GetCurrentBasic( &rBasic
);
4423 BasicDebugFlags nNewFlags
= pStepBasic
->StepPoint( nLine
, nCol1
, nCol2
);
4425 pInst
->CalcBreakCallLevel( nNewFlags
);
4428 // break points only at STMNT-commands in a new line!
4429 else if( ( nOp1
!= nOld
)
4430 && ( nFlags
& BasicDebugFlags::Break
)
4431 && pMod
->IsBP( static_cast<sal_uInt16
>( nOp1
) ) )
4433 StarBASIC
* pBreakBasic
= GetCurrentBasic( &rBasic
);
4434 BasicDebugFlags nNewFlags
= pBreakBasic
->BreakPoint( nLine
, nCol1
, nCol2
);
4436 pInst
->CalcBreakCallLevel( nNewFlags
);
4440 // (+StreamMode+Flags)
4441 // Stack: block length
4445 void SbiRuntime::StepOPEN( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4447 SbxVariableRef pName
= PopVar();
4448 SbxVariableRef pChan
= PopVar();
4449 SbxVariableRef pLen
= PopVar();
4450 short nBlkLen
= pLen
->GetInteger();
4451 short nChan
= pChan
->GetInteger();
4452 OString
aName(OUStringToOString(pName
->GetOUString(), osl_getThreadTextEncoding()));
4453 pIosys
->Open( nChan
, aName
, static_cast<StreamMode
>( nOp1
),
4454 static_cast<SbiStreamFlags
>( nOp2
), nBlkLen
);
4455 Error( pIosys
->GetError() );
4458 // create object (+StringID+StringID)
4460 void SbiRuntime::StepCREATE( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4462 OUString
aClass( pImg
->GetString( static_cast<short>( nOp2
) ) );
4463 SbxObjectRef pObj
= SbxBase::CreateObject( aClass
);
4466 Error( ERRCODE_BASIC_INVALID_OBJECT
);
4470 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4471 pObj
->SetName( aName
);
4472 // the object must be able to call the BASIC
4473 pObj
->SetParent( &rBasic
);
4474 SbxVariableRef pNew
= new SbxVariable
;
4475 pNew
->PutObject( pObj
.get() );
4476 PushVar( pNew
.get() );
4480 void SbiRuntime::StepDCREATE( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4482 StepDCREATE_IMPL( nOp1
, nOp2
);
4485 void SbiRuntime::StepDCREATE_REDIMP( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4487 StepDCREATE_IMPL( nOp1
, nOp2
);
4490 // #56204 create object array (+StringID+StringID), DCREATE == Dim-Create
4491 void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4493 SbxVariableRef refVar
= PopVar();
4497 // fill the array with instances of the requested class
4498 SbxBase
* pObj
= refVar
->GetObject();
4501 StarBASIC::Error( ERRCODE_BASIC_INVALID_OBJECT
);
4505 SbxDimArray
* pArray
= dynamic_cast<SbxDimArray
*>(pObj
);
4509 const sal_Int32 nDims
= pArray
->GetDims();
4510 sal_Int32 nTotalSize
= nDims
> 0 ? 1 : 0;
4512 // must be a one-dimensional array
4513 sal_Int32 nLower
, nUpper
;
4514 for( sal_Int32 i
= 0 ; i
< nDims
; ++i
)
4516 pArray
->GetDim(i
+ 1, nLower
, nUpper
);
4517 const sal_Int32 nSize
= nUpper
- nLower
+ 1;
4518 nTotalSize
*= nSize
;
4521 // Optimization: pre-allocate underlying container
4523 pArray
->SbxArray::GetRef(nTotalSize
- 1);
4525 // First, fill those parts of the array that are preserved
4526 bool bWasError
= false;
4527 const bool bRestored
= implRestorePreservedArray(pArray
, refRedimpArray
, &bWasError
);
4529 nTotalSize
= 0; // on error, don't create objects
4531 // create objects and insert them into the array
4532 OUString
aClass( pImg
->GetString( static_cast<short>( nOp2
) ) );
4534 for( sal_Int32 i
= 0 ; i
< nTotalSize
; ++i
)
4536 if (!bRestored
|| !pArray
->SbxArray::GetRef(i
)) // For those left unset after preserve
4538 SbxObjectRef pClassObj
= SbxBase::CreateObject(aClass
);
4541 Error(ERRCODE_BASIC_INVALID_OBJECT
);
4546 if (aName
.isEmpty())
4547 aName
= pImg
->GetString(static_cast<short>(nOp1
));
4548 pClassObj
->SetName(aName
);
4549 // the object must be able to call the basic
4550 pClassObj
->SetParent(&rBasic
);
4551 pArray
->SbxArray::Put(pClassObj
.get(), i
);
4557 void SbiRuntime::StepTCREATE( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4559 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4560 OUString
aClass( pImg
->GetString( static_cast<short>( nOp2
) ) );
4562 SbxObjectRef pCopyObj
= createUserTypeImpl( aClass
);
4565 pCopyObj
->SetName( aName
);
4567 SbxVariableRef pNew
= new SbxVariable
;
4568 pNew
->PutObject( pCopyObj
.get() );
4569 pNew
->SetDeclareClassName( aClass
);
4570 PushVar( pNew
.get() );
4573 void SbiRuntime::implHandleSbxFlags( SbxVariable
* pVar
, SbxDataType t
, sal_uInt32 nOp2
)
4575 bool bWithEvents
= ((t
& 0xff) == SbxOBJECT
&& (nOp2
& SBX_TYPE_WITH_EVENTS_FLAG
) != 0);
4578 pVar
->SetFlag( SbxFlagBits::WithEvents
);
4580 bool bDimAsNew
= ((nOp2
& SBX_TYPE_DIM_AS_NEW_FLAG
) != 0);
4583 pVar
->SetFlag( SbxFlagBits::DimAsNew
);
4585 bool bFixedString
= ((t
& 0xff) == SbxSTRING
&& (nOp2
& SBX_FIXED_LEN_STRING_FLAG
) != 0);
4588 sal_uInt16 nCount
= static_cast<sal_uInt16
>( nOp2
>> 17 ); // len = all bits above 0x10000
4589 OUStringBuffer aBuf
;
4590 comphelper::string::padToLength(aBuf
, nCount
);
4591 pVar
->PutString(aBuf
.makeStringAndClear());
4594 bool bVarToDim
= ((nOp2
& SBX_TYPE_VAR_TO_DIM_FLAG
) != 0);
4597 pVar
->SetFlag( SbxFlagBits::VarToDim
);
4601 // establishing a local variable (+StringID+type)
4603 void SbiRuntime::StepLOCAL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4605 if( !refLocals
.is() )
4607 refLocals
= new SbxArray
;
4609 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4610 if( refLocals
->Find( aName
, SbxClassType::DontCare
) == nullptr )
4612 SbxDataType t
= static_cast<SbxDataType
>(nOp2
& 0xffff);
4613 SbxVariable
* p
= new SbxVariable( t
);
4614 p
->SetName( aName
);
4615 implHandleSbxFlags( p
, t
, nOp2
);
4616 refLocals
->Put(p
, refLocals
->Count());
4620 // establishing a module-global variable (+StringID+type)
4622 void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1
, sal_uInt32 nOp2
, bool bUsedForClassModule
)
4624 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4625 SbxDataType t
= static_cast<SbxDataType
>(nOp2
& 0xffff);
4626 bool bFlag
= pMod
->IsSet( SbxFlagBits::NoModify
);
4627 pMod
->SetFlag( SbxFlagBits::NoModify
);
4628 SbxVariableRef p
= pMod
->Find( aName
, SbxClassType::Property
);
4631 pMod
->Remove (p
.get());
4633 SbProperty
* pProp
= pMod
->GetProperty( aName
, t
);
4634 if( !bUsedForClassModule
)
4636 pProp
->SetFlag( SbxFlagBits::Private
);
4640 pMod
->ResetFlag( SbxFlagBits::NoModify
);
4644 pProp
->SetFlag( SbxFlagBits::DontStore
);
4645 // from 2.7.1996: HACK because of 'reference can't be saved'
4646 pProp
->SetFlag( SbxFlagBits::NoModify
);
4648 implHandleSbxFlags( pProp
, t
, nOp2
);
4652 void SbiRuntime::StepPUBLIC( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4654 StepPUBLIC_Impl( nOp1
, nOp2
, false );
4657 void SbiRuntime::StepPUBLIC_P( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4659 // Creates module variable that isn't reinitialised when
4660 // between invocations ( for VBASupport & document basic only )
4661 if( pMod
->pImage
->bFirstInit
)
4663 bool bUsedForClassModule
= pImg
->IsFlag( SbiImageFlags::CLASSMODULE
);
4664 StepPUBLIC_Impl( nOp1
, nOp2
, bUsedForClassModule
);
4668 // establishing a global variable (+StringID+type)
4670 void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4672 if( pImg
->IsFlag( SbiImageFlags::CLASSMODULE
) )
4674 StepPUBLIC_Impl( nOp1
, nOp2
, true );
4676 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4677 SbxDataType t
= static_cast<SbxDataType
>(nOp2
& 0xffff);
4679 // Store module scope variables at module scope
4680 // in non vba mode these are stored at the library level :/
4681 // not sure if this really should not be enabled for ALL basic
4682 SbxObject
* pStorage
= &rBasic
;
4683 if ( SbiRuntime::isVBAEnabled() )
4686 pMod
->AddVarName( aName
);
4689 bool bFlag
= pStorage
->IsSet( SbxFlagBits::NoModify
);
4690 rBasic
.SetFlag( SbxFlagBits::NoModify
);
4691 SbxVariableRef p
= pStorage
->Find( aName
, SbxClassType::Property
);
4694 pStorage
->Remove (p
.get());
4696 p
= pStorage
->Make( aName
, SbxClassType::Property
, t
);
4699 pStorage
->ResetFlag( SbxFlagBits::NoModify
);
4703 p
->SetFlag( SbxFlagBits::DontStore
);
4704 // from 2.7.1996: HACK because of 'reference can't be saved'
4705 p
->SetFlag( SbxFlagBits::NoModify
);
4710 // Creates global variable that isn't reinitialised when
4711 // basic is restarted, P=PERSIST (+StringID+Typ)
4713 void SbiRuntime::StepGLOBAL_P( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4715 if( pMod
->pImage
->bFirstInit
)
4717 StepGLOBAL( nOp1
, nOp2
);
4722 // Searches for global variable, behavior depends on the fact
4723 // if the variable is initialised for the first time
4725 void SbiRuntime::StepFIND_G( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4727 if( pMod
->pImage
->bFirstInit
)
4729 // Behave like always during first init
4730 StepFIND( nOp1
, nOp2
);
4734 // Return dummy variable
4735 SbxDataType t
= static_cast<SbxDataType
>(nOp2
);
4736 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
& 0x7FFF ) ) );
4738 SbxVariable
* pDummyVar
= new SbxVariable( t
);
4739 pDummyVar
->SetName( aName
);
4740 PushVar( pDummyVar
);
4745 SbxVariable
* SbiRuntime::StepSTATIC_Impl(
4746 OUString
const & aName
, SbxDataType t
, sal_uInt32 nOp2
)
4748 SbxVariable
* p
= nullptr;
4751 SbxArray
* pStatics
= pMeth
->GetStatics();
4752 if( pStatics
&& ( pStatics
->Find( aName
, SbxClassType::DontCare
) == nullptr ) )
4754 p
= new SbxVariable( t
);
4755 if( t
!= SbxVARIANT
)
4757 p
->SetFlag( SbxFlagBits::Fixed
);
4759 p
->SetName( aName
);
4760 implHandleSbxFlags( p
, t
, nOp2
);
4761 pStatics
->Put(p
, pStatics
->Count());
4766 // establishing a static variable (+StringID+type)
4767 void SbiRuntime::StepSTATIC( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4769 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4770 SbxDataType t
= static_cast<SbxDataType
>(nOp2
& 0xffff);
4771 StepSTATIC_Impl( aName
, t
, nOp2
);
4774 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */