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>
36 #include <sal/log.hxx>
38 #include <tools/wldcrd.hxx>
39 #include <tools/diagnose_ex.h>
41 #include <vcl/svapp.hxx>
42 #include <vcl/settings.hxx>
44 #include <rtl/instance.hxx>
45 #include <rtl/math.hxx>
46 #include <rtl/ustrbuf.hxx>
47 #include <rtl/character.hxx>
49 #include <svl/zforlist.hxx>
51 #include <i18nutil/searchopt.hxx>
52 #include <unotools/syslocale.hxx>
53 #include <unotools/textsearch.hxx>
55 #include <basic/sbuno.hxx>
57 #include <codegen.hxx>
58 #include "comenumwrapper.hxx"
59 #include "ddectrl.hxx"
61 #include <errobject.hxx>
64 #include <opcodes.hxx>
65 #include <runtime.hxx>
67 #include <sbintern.hxx>
69 #include <sbunoobj.hxx>
70 #include <basic/codecompletecache.hxx>
73 using com::sun::star::uno::Reference
;
75 using namespace com::sun::star::uno
;
76 using namespace com::sun::star::container
;
77 using namespace com::sun::star::lang
;
78 using namespace com::sun::star::beans
;
79 using namespace com::sun::star::script
;
81 using namespace ::com::sun::star
;
83 static void lcl_clearImpl( SbxVariableRef
const & refVar
, SbxDataType
const & eType
);
84 static void lcl_eraseImpl( SbxVariableRef
const & refVar
, bool bVBAEnabled
);
86 bool SbiRuntime::isVBAEnabled()
89 SbiInstance
* pInst
= GetSbData()->pInst
;
90 if ( pInst
&& GetSbData()->pInst
->pRun
)
91 bResult
= pInst
->pRun
->bVBAEnabled
;
95 void StarBASIC::SetVBAEnabled( bool bEnabled
)
99 bVBAEnabled
= bEnabled
;
103 bool StarBASIC::isVBAEnabled() const
107 if( SbiRuntime::isVBAEnabled() )
114 struct SbiArgv
{ // Argv stack:
115 SbxArrayRef refArgv
; // Argv
118 SbiArgv(SbxArrayRef
const & refArgv_
, short nArgc_
) :
123 struct SbiGosub
{ // GOSUB-Stack:
124 const sal_uInt8
* pCode
; // Return-Pointer
125 sal_uInt16 nStartForLvl
; // #118235: For Level in moment of gosub
127 SbiGosub(const sal_uInt8
* pCode_
, sal_uInt16 nStartForLvl_
) :
129 nStartForLvl(nStartForLvl_
) {}
132 SbiRuntime::pStep0
SbiRuntime::aStep0
[] = { // all opcodes without operands
133 &SbiRuntime::StepNOP
,
134 &SbiRuntime::StepEXP
,
135 &SbiRuntime::StepMUL
,
136 &SbiRuntime::StepDIV
,
137 &SbiRuntime::StepMOD
,
138 &SbiRuntime::StepPLUS
,
139 &SbiRuntime::StepMINUS
,
140 &SbiRuntime::StepNEG
,
147 &SbiRuntime::StepIDIV
,
148 &SbiRuntime::StepAND
,
150 &SbiRuntime::StepXOR
,
151 &SbiRuntime::StepEQV
,
152 &SbiRuntime::StepIMP
,
153 &SbiRuntime::StepNOT
,
154 &SbiRuntime::StepCAT
,
156 &SbiRuntime::StepLIKE
,
159 &SbiRuntime::StepARGC
, // establish new Argv
160 &SbiRuntime::StepARGV
, // TOS ==> current Argv
161 &SbiRuntime::StepINPUT
, // Input ==> TOS
162 &SbiRuntime::StepLINPUT
, // Line Input ==> TOS
163 &SbiRuntime::StepGET
, // touch TOS
164 &SbiRuntime::StepSET
, // save object TOS ==> TOS-1
165 &SbiRuntime::StepPUT
, // TOS ==> TOS-1
166 &SbiRuntime::StepPUTC
, // TOS ==> TOS-1, then ReadOnly
167 &SbiRuntime::StepDIM
, // DIM
168 &SbiRuntime::StepREDIM
, // REDIM
169 &SbiRuntime::StepREDIMP
, // REDIM PRESERVE
170 &SbiRuntime::StepERASE
, // delete TOS
172 &SbiRuntime::StepSTOP
, // program end
173 &SbiRuntime::StepINITFOR
, // initialize FOR-Variable
174 &SbiRuntime::StepNEXT
, // increment FOR-Variable
175 &SbiRuntime::StepCASE
, // beginning CASE
176 &SbiRuntime::StepENDCASE
, // end CASE
177 &SbiRuntime::StepSTDERROR
, // standard error handling
178 &SbiRuntime::StepNOERROR
, // no error handling
179 &SbiRuntime::StepLEAVE
, // leave UP
181 &SbiRuntime::StepCHANNEL
, // TOS = channel number
182 &SbiRuntime::StepPRINT
, // print TOS
183 &SbiRuntime::StepPRINTF
, // print TOS in field
184 &SbiRuntime::StepWRITE
, // write TOS
185 &SbiRuntime::StepRENAME
, // Rename Tos+1 to Tos
186 &SbiRuntime::StepPROMPT
, // define Input Prompt from TOS
187 &SbiRuntime::StepRESTART
, // Set restart point
188 &SbiRuntime::StepCHANNEL0
, // set E/A-channel 0
189 &SbiRuntime::StepEMPTY
, // empty expression on stack
190 &SbiRuntime::StepERROR
, // TOS = error code
191 &SbiRuntime::StepLSET
, // save object TOS ==> TOS-1
192 &SbiRuntime::StepRSET
, // save object TOS ==> TOS-1
193 &SbiRuntime::StepREDIMP_ERASE
,// Copy array object for REDIMP
194 &SbiRuntime::StepINITFOREACH
,// Init for each loop
195 &SbiRuntime::StepVBASET
,// vba-like set statement
196 &SbiRuntime::StepERASE_CLEAR
,// vba-like set statement
197 &SbiRuntime::StepARRAYACCESS
,// access TOS as array
198 &SbiRuntime::StepBYVAL
, // access TOS as array
201 SbiRuntime::pStep1
SbiRuntime::aStep1
[] = { // all opcodes with one operand
202 &SbiRuntime::StepLOADNC
, // loading a numeric constant (+ID)
203 &SbiRuntime::StepLOADSC
, // loading a string constant (+ID)
204 &SbiRuntime::StepLOADI
, // Immediate Load (+value)
205 &SbiRuntime::StepARGN
, // save a named Args in Argv (+StringID)
206 &SbiRuntime::StepPAD
, // bring string to a definite length (+length)
208 &SbiRuntime::StepJUMP
, // jump (+Target)
209 &SbiRuntime::StepJUMPT
, // evaluate TOS, conditional jump (+Target)
210 &SbiRuntime::StepJUMPF
, // evaluate TOS, conditional jump (+Target)
211 &SbiRuntime::StepONJUMP
, // evaluate TOS, jump into JUMP-table (+MaxVal)
212 &SbiRuntime::StepGOSUB
, // UP-call (+Target)
213 &SbiRuntime::StepRETURN
, // UP-return (+0 or Target)
214 &SbiRuntime::StepTESTFOR
, // check FOR-variable, increment (+Endlabel)
215 &SbiRuntime::StepCASETO
, // Tos+1 <= Case <= Tos), 2xremove (+Target)
216 &SbiRuntime::StepERRHDL
, // error handler (+Offset)
217 &SbiRuntime::StepRESUME
, // resume after errors (+0 or 1 or Label)
219 &SbiRuntime::StepCLOSE
, // (+channel/0)
220 &SbiRuntime::StepPRCHAR
, // (+char)
222 &SbiRuntime::StepSETCLASS
, // check set + class names (+StringId)
223 &SbiRuntime::StepTESTCLASS
, // Check TOS class (+StringId)
224 &SbiRuntime::StepLIB
, // lib for declare-call (+StringId)
225 &SbiRuntime::StepBASED
, // TOS is incremented by BASE, BASE is pushed before
226 &SbiRuntime::StepARGTYP
, // convert last parameter in Argv (+Type)
227 &SbiRuntime::StepVBASETCLASS
,// vba-like set statement
230 SbiRuntime::pStep2
SbiRuntime::aStep2
[] = {// all opcodes with two operands
231 &SbiRuntime::StepRTL
, // load from RTL (+StringID+Typ)
232 &SbiRuntime::StepFIND
, // load (+StringID+Typ)
233 &SbiRuntime::StepELEM
, // load element (+StringID+Typ)
234 &SbiRuntime::StepPARAM
, // Parameter (+Offset+Typ)
236 &SbiRuntime::StepCALL
, // Declare-Call (+StringID+Typ)
237 &SbiRuntime::StepCALLC
, // CDecl-Declare-Call (+StringID+Typ)
238 &SbiRuntime::StepCASEIS
, // Case-Test (+Test-Opcode+False-Target)
240 &SbiRuntime::StepSTMNT
, // beginning of a statement (+Line+Col)
242 &SbiRuntime::StepOPEN
, // (+StreamMode+Flags)
244 &SbiRuntime::StepLOCAL
, // define local variable (+StringId+Typ)
245 &SbiRuntime::StepPUBLIC
, // module global variable (+StringID+Typ)
246 &SbiRuntime::StepGLOBAL
, // define global variable (+StringID+Typ)
247 &SbiRuntime::StepCREATE
, // create object (+StringId+StringId)
248 &SbiRuntime::StepSTATIC
, // static variable (+StringId+StringId)
249 &SbiRuntime::StepTCREATE
, // user-defined objects (+StringId+StringId)
250 &SbiRuntime::StepDCREATE
, // create object-array (+StringID+StringID)
251 &SbiRuntime::StepGLOBAL_P
, // define global variable which is not overwritten
252 // by the Basic on a restart (+StringID+Typ)
253 &SbiRuntime::StepFIND_G
, // finds global variable with special treatment because of _GLOBAL_P
254 &SbiRuntime::StepDCREATE_REDIMP
, // redimension object array (+StringID+StringID)
255 &SbiRuntime::StepFIND_CM
, // Search inside a class module (CM) to enable global search in time
256 &SbiRuntime::StepPUBLIC_P
, // Search inside a class module (CM) to enable global search in time
257 &SbiRuntime::StepFIND_STATIC
, // Search inside a class module (CM) to enable global search in time
263 SbiRTLData::SbiRTLData()
265 nDirFlags
= SbAttributes::NONE
;
269 SbiRTLData::~SbiRTLData()
275 // 16.10.96: #31460 new concept for StepInto/Over/Out
276 // The decision whether StepPoint shall be called is done with the help of
277 // the CallLevel. It's stopped when the current CallLevel is <= nBreakCallLvl.
278 // The current CallLevel can never be smaller than 1, as it's also incremented
279 // during the call of a method (also main). Therefore a BreakCallLvl from 0
280 // means that the program isn't stopped at all.
281 // (also have a look at: step2.cxx, SbiRuntime::StepSTMNT() )
284 void SbiInstance::CalcBreakCallLevel( BasicDebugFlags nFlags
)
287 nFlags
&= ~BasicDebugFlags::Break
;
290 if (nFlags
== BasicDebugFlags::StepInto
) {
291 nRet
= nCallLvl
+ 1; // CallLevel+1 is also stopped
292 } else if (nFlags
== (BasicDebugFlags::StepOver
| BasicDebugFlags::StepInto
)) {
293 nRet
= nCallLvl
; // current CallLevel is stopped
294 } else if (nFlags
== BasicDebugFlags::StepOut
) {
295 nRet
= nCallLvl
- 1; // smaller CallLevel is stopped
297 // Basic-IDE returns 0 instead of BasicDebugFlags::Continue, so also default=continue
298 nRet
= 0; // CallLevel is always > 0 -> no StepPoint
300 nBreakCallLvl
= nRet
; // take result
303 SbiInstance::SbiInstance( StarBASIC
* p
)
304 : pIosys(new SbiIoSystem
)
305 , pDdeCtrl(new SbiDdeControl
)
307 , meFormatterLangType(LANGUAGE_DONTKNOW
)
308 , meFormatterDateOrder(DateOrder::YMD
)
315 , bCompatibility(false)
322 SbiInstance::~SbiInstance()
326 SbiRuntime
* p
= pRun
->pNext
;
333 int nSize
= ComponentVector
.size();
336 for( int i
= nSize
- 1 ; i
>= 0 ; --i
)
338 Reference
< XComponent
> xDlgComponent
= ComponentVector
[i
];
339 if( xDlgComponent
.is() )
340 xDlgComponent
->dispose();
344 catch( const Exception
& )
346 TOOLS_WARN_EXCEPTION("basic", "SbiInstance::~SbiInstance: caught an exception while disposing the components" );
350 SbiDllMgr
* SbiInstance::GetDllMgr()
354 pDllMgr
.reset(new SbiDllMgr
);
356 return pDllMgr
.get();
359 // #39629 create NumberFormatter with the help of a static method now
360 std::shared_ptr
<SvNumberFormatter
> const & SbiInstance::GetNumberFormatter()
362 LanguageType eLangType
= Application::GetSettings().GetLanguageTag().getLanguageType();
363 SvtSysLocale aSysLocale
;
364 DateOrder eDate
= aSysLocale
.GetLocaleData().getDateOrder();
365 if( pNumberFormatter
)
367 if( eLangType
!= meFormatterLangType
||
368 eDate
!= meFormatterDateOrder
)
370 pNumberFormatter
.reset();
373 meFormatterLangType
= eLangType
;
374 meFormatterDateOrder
= eDate
;
375 if( !pNumberFormatter
)
377 pNumberFormatter
= PrepareNumberFormatter( nStdDateIdx
, nStdTimeIdx
, nStdDateTimeIdx
,
378 &meFormatterLangType
, &meFormatterDateOrder
);
380 return pNumberFormatter
;
383 // #39629 offer NumberFormatter static too
384 std::shared_ptr
<SvNumberFormatter
> SbiInstance::PrepareNumberFormatter( sal_uInt32
&rnStdDateIdx
,
385 sal_uInt32
&rnStdTimeIdx
, sal_uInt32
&rnStdDateTimeIdx
,
386 LanguageType
const * peFormatterLangType
, DateOrder
const * peFormatterDateOrder
)
388 LanguageType eLangType
;
389 if( peFormatterLangType
)
391 eLangType
= *peFormatterLangType
;
395 eLangType
= Application::GetSettings().GetLanguageTag().getLanguageType();
398 if( peFormatterDateOrder
)
400 eDate
= *peFormatterDateOrder
;
404 SvtSysLocale aSysLocale
;
405 eDate
= aSysLocale
.GetLocaleData().getDateOrder();
408 std::shared_ptr
<SvNumberFormatter
> pNumberFormatter(
409 new SvNumberFormatter( comphelper::getProcessComponentContext(), eLangType
));
411 // Several parser methods pass SvNumberFormatter::IsNumberFormat() a number
412 // format index to parse against. Tell the formatter the proper date
413 // evaluation order, which also determines the date acceptance patterns to
414 // use if a format was passed. NF_EVALDATEFORMAT_FORMAT restricts to the
415 // format's locale's date patterns/order (no init/system locale match
416 // tried) and falls back to NF_EVALDATEFORMAT_INTL if no specific (i.e. 0)
417 // (or an unknown) format index was passed.
418 pNumberFormatter
->SetEvalDateFormat( NF_EVALDATEFORMAT_FORMAT
);
420 sal_Int32 nCheckPos
= 0;
421 SvNumFormatType nType
;
422 rnStdTimeIdx
= pNumberFormatter
->GetStandardFormat( SvNumFormatType::TIME
, eLangType
);
424 // the formatter's standard templates have only got a two-digit date
425 // -> registering an own format
427 // HACK, because the numberformatter doesn't swap the place holders
428 // for month, day and year according to the system setting.
429 // Problem: Print Year(Date) under engl. BS
430 // also have a look at: basic/source/sbx/sbxdate.cxx
436 case DateOrder::MDY
: aDateStr
= "MM/DD/YYYY"; break;
437 case DateOrder::DMY
: aDateStr
= "DD/MM/YYYY"; break;
438 case DateOrder::YMD
: aDateStr
= "YYYY/MM/DD"; break;
440 OUString
aStr( aDateStr
); // PutandConvertEntry() modifies string!
441 pNumberFormatter
->PutandConvertEntry( aStr
, nCheckPos
, nType
,
442 rnStdDateIdx
, LANGUAGE_ENGLISH_US
, eLangType
, true);
444 aDateStr
+= " HH:MM:SS";
446 pNumberFormatter
->PutandConvertEntry( aStr
, nCheckPos
, nType
,
447 rnStdDateTimeIdx
, LANGUAGE_ENGLISH_US
, eLangType
, true);
448 return pNumberFormatter
;
452 // Let engine run. If Flags == BasicDebugFlags::Continue, take Flags over
454 void SbiInstance::Stop()
456 for( SbiRuntime
* p
= pRun
; p
; p
= p
->pNext
)
462 // Allows Basic IDE to set watch mode to suppress errors
463 static bool bWatchMode
= false;
465 void setBasicWatchMode( bool bOn
)
470 void SbiInstance::Error( ErrCode n
)
472 Error( n
, OUString() );
475 void SbiInstance::Error( ErrCode n
, const OUString
& rMsg
)
484 void SbiInstance::ErrorVB( sal_Int32 nVBNumber
, const OUString
& rMsg
)
488 ErrCode n
= StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16
>( nVBNumber
) );
491 n
= ErrCode(nVBNumber
); // force orig number, probably should have a specific table of vb ( localized ) errors
494 SbiRuntime::translateErrorToVba( n
, aErrorMsg
);
496 pRun
->Error( ERRCODE_BASIC_COMPAT
, true/*bVBATranslationAlreadyDone*/ );
500 void SbiInstance::setErrorVB( sal_Int32 nVBNumber
)
502 ErrCode n
= StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16
>( nVBNumber
) );
505 n
= ErrCode(nVBNumber
); // force orig number, probably should have a specific table of vb ( localized ) errors
507 aErrorMsg
= OUString();
508 SbiRuntime::translateErrorToVba( n
, aErrorMsg
);
514 void SbiInstance::FatalError( ErrCode n
)
516 pRun
->FatalError( n
);
519 void SbiInstance::FatalError( ErrCode _errCode
, const OUString
& _details
)
521 pRun
->FatalError( _errCode
, _details
);
524 void SbiInstance::Abort()
526 StarBASIC
* pErrBasic
= GetCurrentBasic( pBasic
);
527 pErrBasic
->RTError( nErr
, aErrorMsg
, pRun
->nLine
, pRun
->nCol1
, pRun
->nCol2
);
531 // can be unequal to pRTBasic
532 StarBASIC
* GetCurrentBasic( StarBASIC
* pRTBasic
)
534 StarBASIC
* pCurBasic
= pRTBasic
;
535 SbModule
* pActiveModule
= StarBASIC::GetActiveModule();
538 SbxObject
* pParent
= pActiveModule
->GetParent();
539 if (StarBASIC
*pBasic
= dynamic_cast<StarBASIC
*>(pParent
))
545 SbModule
* SbiInstance::GetActiveModule()
549 return pRun
->GetModule();
557 SbMethod
* SbiInstance::GetCaller( sal_uInt16 nLevel
)
559 SbiRuntime
* p
= pRun
;
560 while( nLevel
-- && p
)
564 return p
? p
->GetCaller() : nullptr;
569 // Attention: pMeth can also be NULL (on a call of the init-code)
571 SbiRuntime::SbiRuntime( SbModule
* pm
, SbMethod
* pe
, sal_uInt32 nStart
)
572 : rBasic( *static_cast<StarBASIC
*>(pm
->pParent
) ), pInst( GetSbData()->pInst
),
573 pMod( pm
), pMeth( pe
), pImg( pMod
->pImage
), mpExtCaller(nullptr), m_nLastTime(0)
575 nFlags
= pe
? pe
->GetDebugFlags() : BasicDebugFlags::NONE
;
576 pIosys
= pInst
->GetIoSystem();
584 pStmnt
= reinterpret_cast<const sal_uInt8
*>(pImg
->GetCode()) + nStart
;
594 nError
= ERRCODE_NONE
;
597 refExprStk
= new SbxArray
;
598 SetVBAEnabled( pMod
->IsVBACompat() );
599 SetParameters( pe
? pe
->GetParameters() : nullptr );
602 SbiRuntime::~SbiRuntime()
608 void SbiRuntime::SetVBAEnabled(bool bEnabled
)
610 bVBAEnabled
= bEnabled
;
615 mpExtCaller
= pMeth
->mCaller
;
620 mpExtCaller
= nullptr;
624 // Construction of the parameter list. All ByRef-parameters are directly
625 // taken over; copies of ByVal-parameters are created. If a particular
626 // data type is requested, it is converted.
628 void SbiRuntime::SetParameters( SbxArray
* pParams
)
630 refParams
= new SbxArray
;
631 // for the return value
632 refParams
->Put( pMeth
, 0 );
634 SbxInfo
* pInfo
= pMeth
? pMeth
->GetInfo() : nullptr;
635 sal_uInt16 nParamCount
= pParams
? pParams
->Count() : 1;
636 if( nParamCount
> 1 )
638 for( sal_uInt16 i
= 1 ; i
< nParamCount
; i
++ )
640 const SbxParamInfo
* p
= pInfo
? pInfo
->GetParam( i
) : nullptr;
642 // #111897 ParamArray
643 if( p
&& (p
->nUserData
& PARAM_INFO_PARAMARRAY
) != 0 )
645 SbxDimArray
* pArray
= new SbxDimArray( SbxVARIANT
);
646 sal_uInt16 nParamArrayParamCount
= nParamCount
- i
;
647 pArray
->unoAddDim( 0, nParamArrayParamCount
- 1 );
648 for (sal_uInt16 j
= i
; j
< nParamCount
; ++j
)
650 SbxVariable
* v
= pParams
->Get( j
);
652 aDimIndex
[0] = j
- i
;
653 pArray
->Put(v
, aDimIndex
);
655 SbxVariable
* pArrayVar
= new SbxVariable( SbxVARIANT
);
656 pArrayVar
->SetFlag( SbxFlagBits::ReadWrite
);
657 pArrayVar
->PutObject( pArray
);
658 refParams
->Put( pArrayVar
, i
);
660 // Block ParamArray for missing parameter
665 SbxVariable
* v
= pParams
->Get( i
);
666 // methods are always byval!
667 bool bByVal
= dynamic_cast<const SbxMethod
*>(v
) != nullptr;
668 SbxDataType t
= v
->GetType();
669 bool bTargetTypeIsArray
= false;
672 bByVal
|= ( p
->eType
& SbxBYREF
) == 0;
673 t
= static_cast<SbxDataType
>( p
->eType
& 0x0FFF );
675 if( !bByVal
&& t
!= SbxVARIANT
&&
676 (!v
->IsFixed() || static_cast<SbxDataType
>(v
->GetType() & 0x0FFF ) != t
) )
681 bTargetTypeIsArray
= (p
->nUserData
& PARAM_INFO_WITHBRACKETS
) != 0;
685 if( bTargetTypeIsArray
)
689 SbxVariable
* v2
= new SbxVariable( t
);
690 v2
->SetFlag( SbxFlagBits::ReadWrite
);
692 refParams
->Put( v2
, i
);
696 if( t
!= SbxVARIANT
&& t
!= ( v
->GetType() & 0x0FFF ) )
698 if( p
&& (p
->eType
& SbxARRAY
) )
700 Error( ERRCODE_BASIC_CONVERSION
);
707 refParams
->Put( v
, i
);
711 refParams
->PutAlias( p
->aName
, i
);
716 // ParamArray for missing parameter
719 // #111897 Check first missing parameter for ParamArray
720 const SbxParamInfo
* p
= pInfo
->GetParam( nParamCount
);
721 if( p
&& (p
->nUserData
& PARAM_INFO_PARAMARRAY
) != 0 )
723 SbxDimArray
* pArray
= new SbxDimArray( SbxVARIANT
);
724 pArray
->unoAddDim( 0, -1 );
725 SbxVariable
* pArrayVar
= new SbxVariable( SbxVARIANT
);
726 pArrayVar
->SetFlag( SbxFlagBits::ReadWrite
);
727 pArrayVar
->PutObject( pArray
);
728 refParams
->Put( pArrayVar
, nParamCount
);
736 bool SbiRuntime::Step()
740 // in any case check casually!
741 if( !( ++nOps
& 0xF ) && pInst
->IsReschedule() )
743 sal_uInt32 nTime
= osl_getGlobalTimer();
744 if (nTime
- m_nLastTime
> 5 ) // 20 ms
746 Application::Reschedule();
751 // #i48868 blocked by next call level?
754 if( pInst
->IsReschedule() )
756 Application::Reschedule();
760 SbiOpcode eOp
= static_cast<SbiOpcode
>( *pCode
++ );
761 sal_uInt32 nOp1
, nOp2
;
762 if (eOp
<= SbiOpcode::SbOP0_END
)
764 (this->*( aStep0
[ int(eOp
) ] ) )();
766 else if (eOp
>= SbiOpcode::SbOP1_START
&& eOp
<= SbiOpcode::SbOP1_END
)
768 nOp1
= *pCode
++; nOp1
|= *pCode
++ << 8; nOp1
|= *pCode
++ << 16; nOp1
|= *pCode
++ << 24;
770 (this->*( aStep1
[ int(eOp
) - int(SbiOpcode::SbOP1_START
) ] ) )( nOp1
);
772 else if (eOp
>= SbiOpcode::SbOP2_START
&& eOp
<= SbiOpcode::SbOP2_END
)
774 nOp1
= *pCode
++; nOp1
|= *pCode
++ << 8; nOp1
|= *pCode
++ << 16; nOp1
|= *pCode
++ << 24;
775 nOp2
= *pCode
++; nOp2
|= *pCode
++ << 8; nOp2
|= *pCode
++ << 16; nOp2
|= *pCode
++ << 24;
776 (this->*( aStep2
[ int(eOp
) - int(SbiOpcode::SbOP2_START
) ] ) )( nOp1
, nOp2
);
780 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
783 ErrCode nErrCode
= SbxBase::GetError();
784 Error( nErrCode
.IgnoreWarning() );
786 // from 13.2.1997, new error handling:
787 // ATTENTION: nError can be set already even if !nErrCode
788 // since nError can now also be set from other RT-instances
792 SbxBase::ResetError();
795 // from 15.3.96: display errors only if BASIC is still active
796 // (especially not after compiler errors at the runtime)
799 ErrCode err
= nError
;
801 nError
= ERRCODE_NONE
;
806 // An error occurred in an error handler
807 // force parent handler ( if there is one )
808 // to handle the error
809 bool bLetParentHandleThis
= false;
811 // in the error handler? so std-error
816 if( !bError
) // On Error Resume Next
820 else if( pError
) // On Error Goto ...
826 bLetParentHandleThis
= true;
831 bLetParentHandleThis
= true;
832 pError
= nullptr; //terminate the handler
834 if ( bLetParentHandleThis
)
836 // from 13.2.1997, new error handling:
837 // consider superior error handlers
839 // there's no error handler -> find one farther above
840 SbiRuntime
* pRtErrHdl
= nullptr;
841 SbiRuntime
* pRt
= this;
842 while( (pRt
= pRt
->pNext
) != nullptr )
844 if( !pRt
->bError
|| pRt
->pError
!= nullptr )
854 // manipulate all the RTs that are below in the call-stack
859 if( pRt
!= pRtErrHdl
)
871 // no error-hdl found -> old behaviour
882 void SbiRuntime::Error( ErrCode n
, bool bVBATranslationAlreadyDone
)
887 if( isVBAEnabled() && !bVBATranslationAlreadyDone
)
889 OUString aMsg
= pInst
->GetErrorMsg();
890 sal_Int32 nVBAErrorNumber
= translateErrorToVba( nError
, aMsg
);
891 SbxVariable
* pSbxErrObjVar
= SbxErrObject::getErrObject().get();
892 SbxErrObject
* pGlobErr
= static_cast< SbxErrObject
* >( pSbxErrObjVar
);
893 if( pGlobErr
!= nullptr )
895 pGlobErr
->setNumberAndDescription( nVBAErrorNumber
, aMsg
);
897 pInst
->aErrorMsg
= aMsg
;
898 nError
= ERRCODE_BASIC_COMPAT
;
903 void SbiRuntime::Error( ErrCode _errCode
, const OUString
& _details
)
907 // Not correct for class module usage, remove for now
908 //OSL_WARN_IF( pInst->pRun != this, "basic", "SbiRuntime::Error: can't propagate the error message details!" );
909 if ( pInst
->pRun
== this )
911 pInst
->Error( _errCode
, _details
);
912 //OSL_WARN_IF( nError != _errCode, "basic", "SbiRuntime::Error: the instance is expected to propagate the error code back to me!" );
921 void SbiRuntime::FatalError( ErrCode n
)
927 void SbiRuntime::FatalError( ErrCode _errCode
, const OUString
& _details
)
930 Error( _errCode
, _details
);
933 sal_Int32
SbiRuntime::translateErrorToVba( ErrCode nError
, OUString
& rMsg
)
935 // If a message is defined use that ( in preference to
936 // the defined one for the error ) NB #TODO
937 // if there is an error defined it more than likely
938 // is not the one you want ( some are the same though )
939 // we really need a new vba compatible error list
940 if ( rMsg
.isEmpty() )
942 StarBASIC::MakeErrorText( nError
, rMsg
);
943 rMsg
= StarBASIC::GetErrorText();
944 if ( rMsg
.isEmpty() ) // no message for err no, need localized resource here
946 rMsg
= "Internal Object Error:";
949 // no num? most likely then it *is* really a vba err
950 sal_uInt16 nVBErrorCode
= StarBASIC::GetVBErrorCode( nError
);
951 sal_Int32 nVBAErrorNumber
= ( nVBErrorCode
== 0 ) ? sal_uInt32(nError
) : nVBErrorCode
;
952 return nVBAErrorNumber
;
957 // The expression-stack is available for the continuous evaluation
960 void SbiRuntime::PushVar( SbxVariable
* pVar
)
964 refExprStk
->Put( pVar
, nExprLvl
++ );
968 SbxVariableRef
SbiRuntime::PopVar()
973 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
974 return new SbxVariable
;
977 SbxVariableRef xVar
= refExprStk
->Get( --nExprLvl
);
978 SAL_INFO_IF( xVar
->GetName() == "Cells", "basic", "PopVar: Name equals 'Cells'" );
979 // methods hold themselves in parameter 0
980 if( dynamic_cast<const SbxMethod
*>(xVar
.get()) != nullptr )
982 xVar
->SetParameters(nullptr);
987 void SbiRuntime::ClearExprStack()
989 // Attention: Clear() doesn't suffice as methods must be deleted
997 // Take variable from the expression-stack without removing it
1000 SbxVariable
* SbiRuntime::GetTOS()
1002 short n
= nExprLvl
- 1;
1006 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
1007 return new SbxVariable
;
1010 return refExprStk
->Get( static_cast<sal_uInt16
>(n
) );
1014 void SbiRuntime::TOSMakeTemp()
1016 SbxVariable
* p
= refExprStk
->Get( nExprLvl
- 1 );
1017 if ( p
->GetType() == SbxEMPTY
)
1019 p
->Broadcast( SfxHintId::BasicDataWanted
);
1022 SbxVariable
* pDflt
= nullptr;
1023 if ( bVBAEnabled
&& ( p
->GetType() == SbxOBJECT
|| p
->GetType() == SbxVARIANT
) && ((pDflt
= getDefaultProp(p
)) != nullptr) )
1025 pDflt
->Broadcast( SfxHintId::BasicDataWanted
);
1026 // replacing new p on stack causes object pointed by
1027 // pDft->pParent to be deleted, when p2->Compute() is
1028 // called below pParent is accessed (but it's deleted)
1029 // so set it to NULL now
1030 pDflt
->SetParent( nullptr );
1031 p
= new SbxVariable( *pDflt
);
1032 p
->SetFlag( SbxFlagBits::ReadWrite
);
1033 refExprStk
->Put( p
, nExprLvl
- 1 );
1035 else if( p
->GetRefCount() != 1 )
1037 SbxVariable
* pNew
= new SbxVariable( *p
);
1038 pNew
->SetFlag( SbxFlagBits::ReadWrite
);
1039 refExprStk
->Put( pNew
, nExprLvl
- 1 );
1043 // the GOSUB-stack collects return-addresses for GOSUBs
1044 void SbiRuntime::PushGosub( const sal_uInt8
* pc
)
1046 if( pGosubStk
.size() >= MAXRECURSION
)
1048 StarBASIC::FatalError( ERRCODE_BASIC_STACK_OVERFLOW
);
1050 pGosubStk
.emplace_back(pc
, nForLvl
);
1053 void SbiRuntime::PopGosub()
1055 if( pGosubStk
.empty() )
1057 Error( ERRCODE_BASIC_NO_GOSUB
);
1061 pCode
= pGosubStk
.back().pCode
;
1062 pGosubStk
.pop_back();
1066 // the Argv-stack collects current argument-vectors
1068 void SbiRuntime::PushArgv()
1070 pArgvStk
.emplace_back(refArgv
, nArgc
);
1075 void SbiRuntime::PopArgv()
1077 if( !pArgvStk
.empty() )
1079 refArgv
= pArgvStk
.back().refArgv
;
1080 nArgc
= pArgvStk
.back().nArgc
;
1081 pArgvStk
.pop_back();
1086 void SbiRuntime::ClearArgvStack()
1088 while( !pArgvStk
.empty() )
1094 // Push of the for-stack. The stack has increment, end, begin and variable.
1095 // After the creation of the stack-element the stack's empty.
1097 void SbiRuntime::PushFor()
1099 SbiForStack
* p
= new SbiForStack
;
1100 p
->eForType
= ForType::To
;
1104 p
->refInc
= PopVar();
1105 p
->refEnd
= PopVar();
1106 SbxVariableRef xBgn
= PopVar();
1107 p
->refVar
= PopVar();
1108 *(p
->refVar
) = *xBgn
;
1112 void SbiRuntime::PushForEach()
1114 SbiForStack
* p
= new SbiForStack
;
1118 SbxVariableRef xObjVar
= PopVar();
1119 SbxBase
* pObj
= xObjVar
.is() ? xObjVar
->GetObject() : nullptr;
1120 if( pObj
== nullptr )
1122 Error( ERRCODE_BASIC_NO_OBJECT
);
1126 bool bError_
= false;
1127 if (SbxDimArray
* pArray
= dynamic_cast<SbxDimArray
*>(pObj
))
1129 p
->eForType
= ForType::EachArray
;
1130 p
->refEnd
= reinterpret_cast<SbxVariable
*>(pArray
);
1132 short nDims
= pArray
->GetDims();
1133 p
->pArrayLowerBounds
.reset( new sal_Int32
[nDims
] );
1134 p
->pArrayUpperBounds
.reset( new sal_Int32
[nDims
] );
1135 p
->pArrayCurIndices
.reset( new sal_Int32
[nDims
] );
1136 sal_Int32 lBound
, uBound
;
1137 for( short i
= 0 ; i
< nDims
; i
++ )
1139 pArray
->GetDim32( i
+1, lBound
, uBound
);
1140 p
->pArrayCurIndices
[i
] = p
->pArrayLowerBounds
[i
] = lBound
;
1141 p
->pArrayUpperBounds
[i
] = uBound
;
1144 else if (BasicCollection
* pCollection
= dynamic_cast<BasicCollection
*>(pObj
))
1146 p
->eForType
= ForType::EachCollection
;
1147 p
->refEnd
= pCollection
;
1148 p
->nCurCollectionIndex
= 0;
1150 else if (SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>(pObj
))
1152 // XEnumerationAccess?
1153 Any aAny
= pUnoObj
->getUnoAny();
1154 Reference
< XEnumerationAccess
> xEnumerationAccess
;
1155 if( aAny
>>= xEnumerationAccess
)
1157 p
->xEnumeration
= xEnumerationAccess
->createEnumeration();
1158 p
->eForType
= ForType::EachXEnumeration
;
1160 else if ( isVBAEnabled() && pUnoObj
->isNativeCOMObject() )
1162 uno::Reference
< script::XInvocation
> xInvocation
;
1163 if ( ( aAny
>>= xInvocation
) && xInvocation
.is() )
1167 p
->xEnumeration
= new ComEnumerationWrapper( xInvocation
);
1168 p
->eForType
= ForType::EachXEnumeration
;
1170 catch(const uno::Exception
& )
1173 if ( !p
->xEnumeration
.is() )
1190 Error( ERRCODE_BASIC_CONVERSION
);
1194 // Container variable
1195 p
->refVar
= PopVar();
1200 void SbiRuntime::PopFor()
1204 SbiForStack
* p
= pForStk
;
1212 void SbiRuntime::ClearForStack()
1220 SbiForStack
* SbiRuntime::FindForStackItemForCollection( class BasicCollection
const * pCollection
)
1222 for (SbiForStack
*p
= pForStk
; p
; p
= p
->pNext
)
1224 SbxVariable
* pVar
= p
->refEnd
.is() ? p
->refEnd
.get() : nullptr;
1225 if( p
->eForType
== ForType::EachCollection
1227 && dynamic_cast<BasicCollection
*>( pVar
) == pCollection
)
1239 void SbiRuntime::DllCall
1240 ( const OUString
& aFuncName
,
1241 const OUString
& aDLLName
,
1242 SbxArray
* pArgs
, // parameter (from index 1, can be NULL)
1243 SbxDataType eResType
, // return value
1244 bool bCDecl
) // true: according to C-conventions
1246 // NOT YET IMPLEMENTED
1248 SbxVariable
* pRes
= new SbxVariable( eResType
);
1249 SbiDllMgr
* pDllMgr
= pInst
->GetDllMgr();
1250 ErrCode nErr
= pDllMgr
->Call( aFuncName
, aDLLName
, pArgs
, *pRes
, bCDecl
);
1258 bool SbiRuntime::IsImageFlag( SbiImageFlags n
) const
1260 return pImg
->IsFlag( n
);
1263 sal_uInt16
SbiRuntime::GetBase() const
1265 return pImg
->GetBase();
1268 void SbiRuntime::StepNOP()
1271 void SbiRuntime::StepArith( SbxOperator eOp
)
1273 SbxVariableRef p1
= PopVar();
1275 SbxVariable
* p2
= GetTOS();
1277 p2
->ResetFlag( SbxFlagBits::Fixed
);
1278 p2
->Compute( eOp
, *p1
);
1280 checkArithmeticOverflow( p2
);
1283 void SbiRuntime::StepUnary( SbxOperator eOp
)
1286 SbxVariable
* p
= GetTOS();
1287 p
->Compute( eOp
, *p
);
1290 void SbiRuntime::StepCompare( SbxOperator eOp
)
1292 SbxVariableRef p1
= PopVar();
1293 SbxVariableRef p2
= PopVar();
1295 // Make sure objects with default params have
1296 // values ( and type ) set as appropriate
1297 SbxDataType p1Type
= p1
->GetType();
1298 SbxDataType p2Type
= p2
->GetType();
1299 if ( p1Type
== SbxEMPTY
)
1301 p1
->Broadcast( SfxHintId::BasicDataWanted
);
1302 p1Type
= p1
->GetType();
1304 if ( p2Type
== SbxEMPTY
)
1306 p2
->Broadcast( SfxHintId::BasicDataWanted
);
1307 p2Type
= p2
->GetType();
1309 if ( p1Type
== p2Type
)
1311 // if both sides are an object and have default props
1312 // then we need to use the default props
1313 // we don't need to worry if only one side ( lhs, rhs ) is an
1314 // object ( object side will get coerced to correct type in
1316 if ( p1Type
== SbxOBJECT
)
1318 SbxVariable
* pDflt
= getDefaultProp( p1
.get() );
1322 p1
->Broadcast( SfxHintId::BasicDataWanted
);
1324 pDflt
= getDefaultProp( p2
.get() );
1328 p2
->Broadcast( SfxHintId::BasicDataWanted
);
1333 static SbxVariable
* pTRUE
= nullptr;
1334 static SbxVariable
* pFALSE
= nullptr;
1335 // why do this on non-windows ?
1336 // why do this at all ?
1337 // I dumbly follow the pattern :-/
1338 if ( bVBAEnabled
&& ( p1
->IsNull() || p2
->IsNull() ) )
1340 static SbxVariable
* pNULL
= [&]() {
1341 SbxVariable
* p
= new SbxVariable
;
1348 else if( p2
->Compare( eOp
, *p1
) )
1352 pTRUE
= new SbxVariable
;
1353 pTRUE
->PutBool( true );
1354 pTRUE
->AddFirstRef();
1362 pFALSE
= new SbxVariable
;
1363 pFALSE
->PutBool( false );
1364 pFALSE
->AddFirstRef();
1370 void SbiRuntime::StepEXP() { StepArith( SbxEXP
); }
1371 void SbiRuntime::StepMUL() { StepArith( SbxMUL
); }
1372 void SbiRuntime::StepDIV() { StepArith( SbxDIV
); }
1373 void SbiRuntime::StepIDIV() { StepArith( SbxIDIV
); }
1374 void SbiRuntime::StepMOD() { StepArith( SbxMOD
); }
1375 void SbiRuntime::StepPLUS() { StepArith( SbxPLUS
); }
1376 void SbiRuntime::StepMINUS() { StepArith( SbxMINUS
); }
1377 void SbiRuntime::StepCAT() { StepArith( SbxCAT
); }
1378 void SbiRuntime::StepAND() { StepArith( SbxAND
); }
1379 void SbiRuntime::StepOR() { StepArith( SbxOR
); }
1380 void SbiRuntime::StepXOR() { StepArith( SbxXOR
); }
1381 void SbiRuntime::StepEQV() { StepArith( SbxEQV
); }
1382 void SbiRuntime::StepIMP() { StepArith( SbxIMP
); }
1384 void SbiRuntime::StepNEG() { StepUnary( SbxNEG
); }
1385 void SbiRuntime::StepNOT() { StepUnary( SbxNOT
); }
1387 void SbiRuntime::StepEQ() { StepCompare( SbxEQ
); }
1388 void SbiRuntime::StepNE() { StepCompare( SbxNE
); }
1389 void SbiRuntime::StepLT() { StepCompare( SbxLT
); }
1390 void SbiRuntime::StepGT() { StepCompare( SbxGT
); }
1391 void SbiRuntime::StepLE() { StepCompare( SbxLE
); }
1392 void SbiRuntime::StepGE() { StepCompare( SbxGE
); }
1396 bool NeedEsc(sal_Unicode cCode
)
1398 if(!rtl::isAscii(cCode
))
1420 OUString
VBALikeToRegexp(const OUString
&rIn
)
1422 OUStringBuffer sResult
;
1423 const sal_Unicode
*start
= rIn
.getStr();
1424 const sal_Unicode
*end
= start
+ rIn
.getLength();
1428 sResult
.append('^');
1435 sResult
.append('.');
1439 sResult
.append(".*");
1443 sResult
.append("[0-9]");
1447 sResult
.append('\\');
1448 sResult
.append(*start
++);
1451 sResult
.append(*start
++);
1453 while (start
< end
&& !seenright
)
1460 sResult
.append('\\');
1461 sResult
.append(*start
);
1464 sResult
.append(*start
);
1468 sResult
.append('^');
1471 if (NeedEsc(*start
))
1473 sResult
.append('\\');
1475 sResult
.append(*start
);
1482 if (NeedEsc(*start
))
1484 sResult
.append('\\');
1486 sResult
.append(*start
++);
1490 sResult
.append('$');
1492 return sResult
.makeStringAndClear();
1496 void SbiRuntime::StepLIKE()
1498 SbxVariableRef refVar1
= PopVar();
1499 SbxVariableRef refVar2
= PopVar();
1501 OUString pattern
= VBALikeToRegexp(refVar1
->GetOUString());
1502 OUString value
= refVar2
->GetOUString();
1504 i18nutil::SearchOptions2 aSearchOpt
;
1506 aSearchOpt
.AlgorithmType2
= css::util::SearchAlgorithms2::REGEXP
;
1508 aSearchOpt
.Locale
= Application::GetSettings().GetLanguageTag().getLocale();
1509 aSearchOpt
.searchString
= pattern
;
1511 bool bTextMode(true);
1512 bool bCompatibility
= ( GetSbData()->pInst
&& GetSbData()->pInst
->IsCompatibility() );
1513 if( bCompatibility
)
1515 bTextMode
= IsImageFlag( SbiImageFlags::COMPARETEXT
);
1519 aSearchOpt
.transliterateFlags
|= TransliterationFlags::IGNORE_CASE
;
1521 SbxVariable
* pRes
= new SbxVariable
;
1522 utl::TextSearch
aSearch( aSearchOpt
);
1523 sal_Int32 nStart
=0, nEnd
=value
.getLength();
1524 bool bRes
= aSearch
.SearchForward(value
, &nStart
, &nEnd
);
1525 pRes
->PutBool( bRes
);
1530 // TOS and TOS-1 are both object variables and contain the same pointer
1532 void SbiRuntime::StepIS()
1534 SbxVariableRef refVar1
= PopVar();
1535 SbxVariableRef refVar2
= PopVar();
1537 SbxDataType eType1
= refVar1
->GetType();
1538 SbxDataType eType2
= refVar2
->GetType();
1539 if ( eType1
== SbxEMPTY
)
1541 refVar1
->Broadcast( SfxHintId::BasicDataWanted
);
1542 eType1
= refVar1
->GetType();
1544 if ( eType2
== SbxEMPTY
)
1546 refVar2
->Broadcast( SfxHintId::BasicDataWanted
);
1547 eType2
= refVar2
->GetType();
1550 bool bRes
= ( eType1
== SbxOBJECT
&& eType2
== SbxOBJECT
);
1551 if ( bVBAEnabled
&& !bRes
)
1553 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
1555 bRes
= ( bRes
&& refVar1
->GetObject() == refVar2
->GetObject() );
1556 SbxVariable
* pRes
= new SbxVariable
;
1557 pRes
->PutBool( bRes
);
1561 // update the value of TOS
1563 void SbiRuntime::StepGET()
1565 SbxVariable
* p
= GetTOS();
1566 p
->Broadcast( SfxHintId::BasicDataWanted
);
1569 // #67607 copy Uno-Structs
1570 static bool checkUnoStructCopy( bool bVBA
, SbxVariableRef
const & refVal
, SbxVariableRef
const & refVar
)
1572 SbxDataType eVarType
= refVar
->GetType();
1573 SbxDataType eValType
= refVal
->GetType();
1575 if ( ( bVBA
&& ( eVarType
== SbxEMPTY
) ) || !refVar
->CanWrite() )
1578 if ( eValType
!= SbxOBJECT
)
1580 // we seem to be duplicating parts of SbxValue=operator, maybe we should just move this to
1581 // there :-/ not sure if for every '=' we would want struct handling
1582 if( eVarType
!= SbxOBJECT
)
1584 if ( refVar
->IsFixed() )
1587 // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure
1588 else if( dynamic_cast<const SbProcedureProperty
*>( refVar
.get() ) != nullptr )
1591 SbxObjectRef xValObj
= static_cast<SbxObject
*>(refVal
->GetObject());
1592 if( !xValObj
.is() || dynamic_cast<const SbUnoAnyObject
*>( xValObj
.get() ) != nullptr )
1595 SbUnoObject
* pUnoVal
= dynamic_cast<SbUnoObject
*>( xValObj
.get() );
1596 SbUnoStructRefObject
* pUnoStructVal
= dynamic_cast<SbUnoStructRefObject
*>( xValObj
.get() );
1598 // make doubly sure value is either a Uno object or
1600 if ( pUnoVal
|| pUnoStructVal
)
1601 aAny
= pUnoVal
? pUnoVal
->getUnoAny() : pUnoStructVal
->getUnoAny();
1604 if ( aAny
.getValueType().getTypeClass() == TypeClass_STRUCT
)
1606 refVar
->SetType( SbxOBJECT
);
1607 ErrCode eOldErr
= SbxBase::GetError();
1608 // There are some circumstances when calling GetObject
1609 // will trigger an error, we need to squash those here.
1610 // Alternatively it is possible that the same scenario
1611 // could overwrite and existing error. Lets prevent that
1612 SbxObjectRef xVarObj
= static_cast<SbxObject
*>(refVar
->GetObject());
1613 if ( eOldErr
!= ERRCODE_NONE
)
1614 SbxBase::SetError( eOldErr
);
1616 SbxBase::ResetError();
1618 SbUnoStructRefObject
* pUnoStructObj
= dynamic_cast<SbUnoStructRefObject
*>( xVarObj
.get() );
1620 OUString sClassName
= pUnoVal
? pUnoVal
->GetClassName() : pUnoStructVal
->GetClassName();
1621 OUString sName
= pUnoVal
? pUnoVal
->GetName() : pUnoStructVal
->GetName();
1623 if ( pUnoStructObj
)
1625 StructRefInfo aInfo
= pUnoStructObj
->getStructInfo();
1626 aInfo
.setValue( aAny
);
1630 SbUnoObject
* pNewUnoObj
= new SbUnoObject( sName
, aAny
);
1631 // #70324: adopt ClassName
1632 pNewUnoObj
->SetClassName( sClassName
);
1633 refVar
->PutObject( pNewUnoObj
);
1641 // laying down TOS in TOS-1
1643 void SbiRuntime::StepPUT()
1645 SbxVariableRef refVal
= PopVar();
1646 SbxVariableRef refVar
= PopVar();
1647 // store on its own method (inside a function)?
1648 bool bFlagsChanged
= false;
1649 SbxFlagBits n
= SbxFlagBits::NONE
;
1650 if( refVar
.get() == pMeth
)
1652 bFlagsChanged
= true;
1653 n
= refVar
->GetFlags();
1654 refVar
->SetFlag( SbxFlagBits::Write
);
1657 // if left side arg is an object or variant and right handside isn't
1658 // either an object or a variant then try and see if a default
1660 // to use e.g. Range{"A1") = 34
1661 // could equate to Range("A1").Value = 34
1664 // yet more hacking at this, I feel we don't quite have the correct
1665 // heuristics for dealing with obj1 = obj2 ( where obj2 ( and maybe
1666 // obj1 ) has default member/property ) ) It seems that default props
1667 // aren't dealt with if the object is a member of some parent object
1668 bool bObjAssign
= false;
1669 if ( refVar
->GetType() == SbxEMPTY
)
1670 refVar
->Broadcast( SfxHintId::BasicDataWanted
);
1671 if ( refVar
->GetType() == SbxOBJECT
)
1673 if ( dynamic_cast<const SbxMethod
*>(refVar
.get()) != nullptr || ! refVar
->GetParent() )
1675 SbxVariable
* pDflt
= getDefaultProp( refVar
.get() );
1683 if ( refVal
->GetType() == SbxOBJECT
&& !bObjAssign
&& ( dynamic_cast<const SbxMethod
*>(refVal
.get()) != nullptr || ! refVal
->GetParent() ) )
1685 SbxVariable
* pDflt
= getDefaultProp( refVal
.get() );
1691 if ( !checkUnoStructCopy( bVBAEnabled
, refVal
, refVar
) )
1695 refVar
->SetFlags( n
);
1699 // VBA Dim As New behavior handling, save init object information
1700 struct DimAsNewRecoverItem
1702 OUString m_aObjClass
;
1703 OUString m_aObjName
;
1704 SbxObject
* m_pObjParent
;
1705 SbModule
* m_pClassModule
;
1707 DimAsNewRecoverItem()
1708 : m_pObjParent( nullptr )
1709 , m_pClassModule( nullptr )
1712 DimAsNewRecoverItem( const OUString
& rObjClass
, const OUString
& rObjName
,
1713 SbxObject
* pObjParent
, SbModule
* pClassModule
)
1714 : m_aObjClass( rObjClass
)
1715 , m_aObjName( rObjName
)
1716 , m_pObjParent( pObjParent
)
1717 , m_pClassModule( pClassModule
)
1723 struct SbxVariablePtrHash
1725 size_t operator()( SbxVariable
* pVar
) const
1726 { return reinterpret_cast<size_t>(pVar
); }
1729 typedef std::unordered_map
< SbxVariable
*, DimAsNewRecoverItem
,
1730 SbxVariablePtrHash
> DimAsNewRecoverHash
;
1732 class GaDimAsNewRecoverHash
: public rtl::Static
<DimAsNewRecoverHash
, GaDimAsNewRecoverHash
> {};
1734 void removeDimAsNewRecoverItem( SbxVariable
* pVar
)
1736 DimAsNewRecoverHash
&rDimAsNewRecoverHash
= GaDimAsNewRecoverHash::get();
1737 DimAsNewRecoverHash::iterator it
= rDimAsNewRecoverHash
.find( pVar
);
1738 if( it
!= rDimAsNewRecoverHash
.end() )
1740 rDimAsNewRecoverHash
.erase( it
);
1745 // saving object variable
1746 // not-object variables will cause errors
1748 static const char pCollectionStr
[] = "Collection";
1750 void SbiRuntime::StepSET_Impl( SbxVariableRef
& refVal
, SbxVariableRef
& refVar
, bool bHandleDefaultProp
)
1752 // #67733 types with array-flag are OK too
1754 // Check var, !object is no error for sure if, only if type is fixed
1755 SbxDataType eVarType
= refVar
->GetType();
1756 if( !bHandleDefaultProp
&& eVarType
!= SbxOBJECT
&& !(eVarType
& SbxARRAY
) && refVar
->IsFixed() )
1758 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
1762 // Check value, !object is no error for sure if, only if type is fixed
1763 SbxDataType eValType
= refVal
->GetType();
1764 if( !bHandleDefaultProp
&& eValType
!= SbxOBJECT
&& !(eValType
& SbxARRAY
) && refVal
->IsFixed() )
1766 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
1770 // Getting in here causes problems with objects with default properties
1771 // if they are SbxEMPTY I guess
1772 if ( !bHandleDefaultProp
|| eValType
== SbxOBJECT
)
1774 // activate GetObject for collections on refVal
1775 SbxBase
* pObjVarObj
= refVal
->GetObject();
1778 SbxVariableRef refObjVal
= dynamic_cast<SbxObject
*>( pObjVarObj
);
1780 if( refObjVal
.is() )
1784 else if( !(eValType
& SbxARRAY
) )
1791 // #52896 refVal can be invalid here, if uno-sequences - or more
1792 // general arrays - are assigned to variables that are declared
1796 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
1800 bool bFlagsChanged
= false;
1801 SbxFlagBits n
= SbxFlagBits::NONE
;
1802 if( refVar
.get() == pMeth
)
1804 bFlagsChanged
= true;
1805 n
= refVar
->GetFlags();
1806 refVar
->SetFlag( SbxFlagBits::Write
);
1808 SbProcedureProperty
* pProcProperty
= dynamic_cast<SbProcedureProperty
*>( refVar
.get() );
1811 pProcProperty
->setSet( true );
1813 if ( bHandleDefaultProp
)
1815 // get default properties for lhs & rhs where necessary
1816 // SbxVariable* defaultProp = NULL; unused variable
1817 // LHS try determine if a default prop exists
1818 // again like in StepPUT (see there too ) we are tweaking the
1819 // heuristics again for when to assign an object reference or
1820 // use default members if they exist
1821 // #FIXME we really need to get to the bottom of this mess
1822 bool bObjAssign
= false;
1823 if ( refVar
->GetType() == SbxOBJECT
)
1825 if ( dynamic_cast<const SbxMethod
*>(refVar
.get()) != nullptr || ! refVar
->GetParent() )
1827 SbxVariable
* pDflt
= getDefaultProp( refVar
.get() );
1836 // RHS only get a default prop is the rhs has one
1837 if ( refVal
->GetType() == SbxOBJECT
)
1839 // check if lhs is a null object
1840 // if it is then use the object not the default property
1841 SbxObject
* pObj
= dynamic_cast<SbxObject
*>( refVar
.get() );
1843 // calling GetObject on a SbxEMPTY variable raises
1844 // object not set errors, make sure it's an Object
1845 if ( !pObj
&& refVar
->GetType() == SbxOBJECT
)
1847 SbxBase
* pObjVarObj
= refVar
->GetObject();
1848 pObj
= dynamic_cast<SbxObject
*>( pObjVarObj
);
1850 SbxVariable
* pDflt
= nullptr;
1851 if ( pObj
&& !bObjAssign
)
1853 // lhs is either a valid object || or has a defaultProp
1854 pDflt
= getDefaultProp( refVal
.get() );
1863 // Handle Dim As New
1864 bool bDimAsNew
= bVBAEnabled
&& refVar
->IsSet( SbxFlagBits::DimAsNew
);
1865 SbxBaseRef xPrevVarObj
;
1868 xPrevVarObj
= refVar
->GetObject();
1870 // Handle withevents
1871 bool bWithEvents
= refVar
->IsSet( SbxFlagBits::WithEvents
);
1874 Reference
< XInterface
> xComListener
;
1876 SbxBase
* pObj
= refVal
->GetObject();
1877 SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>( pObj
);
1878 if( pUnoObj
!= nullptr )
1880 Any aControlAny
= pUnoObj
->getUnoAny();
1881 OUString aDeclareClassName
= refVar
->GetDeclareClassName();
1882 OUString aPrefix
= refVar
->GetName();
1883 SbxObjectRef xScopeObj
= refVar
->GetParent();
1884 xComListener
= createComListener( aControlAny
, aDeclareClassName
, aPrefix
, xScopeObj
);
1886 refVal
->SetDeclareClassName( aDeclareClassName
);
1887 refVal
->SetComListener( xComListener
, &rBasic
); // Hold reference
1892 // lhs is a property who's value is currently (Empty e.g. no broadcast yet)
1893 // in this case if there is a default prop involved the value of the
1894 // default property may in fact be void so the type will also be SbxEMPTY
1895 // in this case we do not want to call checkUnoStructCopy 'cause that will
1896 // cause an error also
1897 if ( !checkUnoStructCopy( bHandleDefaultProp
, refVal
, refVar
) )
1903 if( dynamic_cast<const SbxObject
*>( refVar
.get() ) == nullptr )
1905 SbxBase
* pValObjBase
= refVal
->GetObject();
1906 if( pValObjBase
== nullptr )
1908 if( xPrevVarObj
.is() )
1910 // Object is overwritten with NULL, instantiate init object
1911 DimAsNewRecoverHash
&rDimAsNewRecoverHash
= GaDimAsNewRecoverHash::get();
1912 DimAsNewRecoverHash::iterator it
= rDimAsNewRecoverHash
.find( refVar
.get() );
1913 if( it
!= rDimAsNewRecoverHash
.end() )
1915 const DimAsNewRecoverItem
& rItem
= it
->second
;
1916 if( rItem
.m_pClassModule
!= nullptr )
1918 SbClassModuleObject
* pNewObj
= new SbClassModuleObject( rItem
.m_pClassModule
);
1919 pNewObj
->SetName( rItem
.m_aObjName
);
1920 pNewObj
->SetParent( rItem
.m_pObjParent
);
1921 refVar
->PutObject( pNewObj
);
1923 else if( rItem
.m_aObjClass
.equalsIgnoreAsciiCase( pCollectionStr
) )
1925 BasicCollection
* pNewCollection
= new BasicCollection( pCollectionStr
);
1926 pNewCollection
->SetName( rItem
.m_aObjName
);
1927 pNewCollection
->SetParent( rItem
.m_pObjParent
);
1928 refVar
->PutObject( pNewCollection
);
1935 // Does old value exist?
1936 bool bFirstInit
= !xPrevVarObj
.is();
1939 // Store information to instantiate object later
1940 SbxObject
* pValObj
= dynamic_cast<SbxObject
*>( pValObjBase
);
1941 if( pValObj
!= nullptr )
1943 OUString aObjClass
= pValObj
->GetClassName();
1945 SbClassModuleObject
* pClassModuleObj
= dynamic_cast<SbClassModuleObject
*>( pValObjBase
);
1946 DimAsNewRecoverHash
&rDimAsNewRecoverHash
= GaDimAsNewRecoverHash::get();
1947 if( pClassModuleObj
!= nullptr )
1949 SbModule
* pClassModule
= pClassModuleObj
->getClassModule();
1950 rDimAsNewRecoverHash
[refVar
.get()] =
1951 DimAsNewRecoverItem( aObjClass
, pValObj
->GetName(), pValObj
->GetParent(), pClassModule
);
1953 else if( aObjClass
.equalsIgnoreAsciiCase( "Collection" ) )
1955 rDimAsNewRecoverHash
[refVar
.get()] =
1956 DimAsNewRecoverItem( aObjClass
, pValObj
->GetName(), pValObj
->GetParent(), nullptr );
1966 refVar
->SetFlags( n
);
1971 void SbiRuntime::StepSET()
1973 SbxVariableRef refVal
= PopVar();
1974 SbxVariableRef refVar
= PopVar();
1975 StepSET_Impl( refVal
, refVar
, bVBAEnabled
); // this is really assignment
1978 void SbiRuntime::StepVBASET()
1980 SbxVariableRef refVal
= PopVar();
1981 SbxVariableRef refVar
= PopVar();
1982 // don't handle default property
1983 StepSET_Impl( refVal
, refVar
); // set obj = something
1987 void SbiRuntime::StepLSET()
1989 SbxVariableRef refVal
= PopVar();
1990 SbxVariableRef refVar
= PopVar();
1991 if( refVar
->GetType() != SbxSTRING
||
1992 refVal
->GetType() != SbxSTRING
)
1994 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
1998 SbxFlagBits n
= refVar
->GetFlags();
1999 if( refVar
.get() == pMeth
)
2001 refVar
->SetFlag( SbxFlagBits::Write
);
2003 OUString aRefVarString
= refVar
->GetOUString();
2004 OUString aRefValString
= refVal
->GetOUString();
2006 sal_Int32 nVarStrLen
= aRefVarString
.getLength();
2007 sal_Int32 nValStrLen
= aRefValString
.getLength();
2009 if( nVarStrLen
> nValStrLen
)
2011 OUStringBuffer
buf(aRefValString
);
2012 comphelper::string::padToLength(buf
, nVarStrLen
, ' ');
2013 aNewStr
= buf
.makeStringAndClear();
2017 aNewStr
= aRefValString
.copy( 0, nVarStrLen
);
2020 refVar
->PutString(aNewStr
);
2021 refVar
->SetFlags( n
);
2025 void SbiRuntime::StepRSET()
2027 SbxVariableRef refVal
= PopVar();
2028 SbxVariableRef refVar
= PopVar();
2029 if( refVar
->GetType() != SbxSTRING
|| refVal
->GetType() != SbxSTRING
)
2031 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
2035 SbxFlagBits n
= refVar
->GetFlags();
2036 if( refVar
.get() == pMeth
)
2038 refVar
->SetFlag( SbxFlagBits::Write
);
2040 OUString aRefVarString
= refVar
->GetOUString();
2041 OUString aRefValString
= refVal
->GetOUString();
2042 sal_Int32 nVarStrLen
= aRefVarString
.getLength();
2043 sal_Int32 nValStrLen
= aRefValString
.getLength();
2045 OUStringBuffer
aNewStr(nVarStrLen
);
2046 if (nVarStrLen
> nValStrLen
)
2048 comphelper::string::padToLength(aNewStr
, nVarStrLen
- nValStrLen
, ' ');
2049 aNewStr
.append(aRefValString
);
2053 aNewStr
.append(std::u16string_view(aRefValString
).substr(0, nVarStrLen
));
2055 refVar
->PutString(aNewStr
.makeStringAndClear());
2057 refVar
->SetFlags( n
);
2061 // laying down TOS in TOS-1, then set ReadOnly-Bit
2063 void SbiRuntime::StepPUTC()
2065 SbxVariableRef refVal
= PopVar();
2066 SbxVariableRef refVar
= PopVar();
2067 refVar
->SetFlag( SbxFlagBits::Write
);
2069 refVar
->ResetFlag( SbxFlagBits::Write
);
2070 refVar
->SetFlag( SbxFlagBits::Const
);
2074 // TOS = variable for the array with dimension information as parameter
2076 void SbiRuntime::StepDIM()
2078 SbxVariableRef refVar
= PopVar();
2082 // #56204 swap out DIM-functionality into a help method (step0.cxx)
2083 void SbiRuntime::DimImpl(const SbxVariableRef
& refVar
)
2085 // If refDim then this DIM statement is terminating a ReDIM and
2086 // previous StepERASE_CLEAR for an array, the following actions have
2087 // been delayed from ( StepERASE_CLEAR ) 'till here
2088 if ( refRedim
.is() )
2090 if ( !refRedimpArray
.is() ) // only erase the array not ReDim Preserve
2092 lcl_eraseImpl( refVar
, bVBAEnabled
);
2094 SbxDataType eType
= refVar
->GetType();
2095 lcl_clearImpl( refVar
, eType
);
2098 SbxArray
* pDims
= refVar
->GetParameters();
2099 // must have an even number of arguments
2100 // have in mind that Arg[0] does not count!
2101 if( pDims
&& !( pDims
->Count() & 1 ) )
2103 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2107 SbxDataType eType
= refVar
->IsFixed() ? refVar
->GetType() : SbxVARIANT
;
2108 SbxDimArray
* pArray
= new SbxDimArray( eType
);
2109 // allow arrays without dimension information, too (VB-compatible)
2112 refVar
->ResetFlag( SbxFlagBits::VarToDim
);
2114 for( sal_uInt16 i
= 1; i
< pDims
->Count(); )
2116 sal_Int32 lb
= pDims
->Get( i
++ )->GetLong();
2117 sal_Int32 ub
= pDims
->Get( i
++ )->GetLong();
2120 Error( ERRCODE_BASIC_OUT_OF_RANGE
);
2123 pArray
->AddDim32( lb
, ub
);
2126 pArray
->setHasFixedSize( true );
2132 // #62867 On creating an array of the length 0, create
2133 // a dimension (like for Uno-Sequences of the length 0)
2134 pArray
->unoAddDim( 0, -1 );
2136 SbxFlagBits nSavFlags
= refVar
->GetFlags();
2137 refVar
->ResetFlag( SbxFlagBits::Fixed
);
2138 refVar
->PutObject( pArray
);
2139 refVar
->SetFlags( nSavFlags
);
2140 refVar
->SetParameters( nullptr );
2145 // TOS = variable for the array
2146 // argv = dimension information
2148 void SbiRuntime::StepREDIM()
2150 // Nothing different than dim at the moment because
2151 // a double dim is already recognized by the compiler.
2156 // Helper function for StepREDIMP
2157 static void implCopyDimArray( SbxDimArray
* pNewArray
, SbxDimArray
* pOldArray
, short nMaxDimIndex
,
2158 short nActualDim
, sal_Int32
* pActualIndices
, sal_Int32
* pLowerBounds
, sal_Int32
* pUpperBounds
)
2160 sal_Int32
& ri
= pActualIndices
[nActualDim
];
2161 for( ri
= pLowerBounds
[nActualDim
] ; ri
<= pUpperBounds
[nActualDim
] ; ri
++ )
2163 if( nActualDim
< nMaxDimIndex
)
2165 implCopyDimArray( pNewArray
, pOldArray
, nMaxDimIndex
, nActualDim
+ 1,
2166 pActualIndices
, pLowerBounds
, pUpperBounds
);
2170 SbxVariable
* pSource
= pOldArray
->Get32( pActualIndices
);
2171 SbxVariable
* pDest
= pNewArray
->Get32( pActualIndices
);
2172 if( pSource
&& pDest
)
2181 // TOS = variable for the array
2182 // argv = dimension information
2184 void SbiRuntime::StepREDIMP()
2186 SbxVariableRef refVar
= PopVar();
2189 // Now check, if we can copy from the old array
2190 if( refRedimpArray
.is() )
2192 SbxBase
* pElemObj
= refVar
->GetObject();
2193 SbxDimArray
* pNewArray
= dynamic_cast<SbxDimArray
*>( pElemObj
);
2194 SbxDimArray
* pOldArray
= static_cast<SbxDimArray
*>(refRedimpArray
.get());
2197 short nDimsNew
= pNewArray
->GetDims();
2198 short nDimsOld
= pOldArray
->GetDims();
2199 short nDims
= nDimsNew
;
2201 if( nDimsOld
!= nDimsNew
)
2203 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE
);
2207 // Store dims to use them for copying later
2208 std::unique_ptr
<sal_Int32
[]> pLowerBounds(new sal_Int32
[nDims
]);
2209 std::unique_ptr
<sal_Int32
[]> pUpperBounds(new sal_Int32
[nDims
]);
2210 std::unique_ptr
<sal_Int32
[]> pActualIndices(new sal_Int32
[nDims
]);
2213 for( short i
= 1 ; i
<= nDims
; i
++ )
2215 sal_Int32 lBoundNew
, uBoundNew
;
2216 sal_Int32 lBoundOld
, uBoundOld
;
2217 pNewArray
->GetDim32( i
, lBoundNew
, uBoundNew
);
2218 pOldArray
->GetDim32( i
, lBoundOld
, uBoundOld
);
2219 lBoundNew
= std::max( lBoundNew
, lBoundOld
);
2220 uBoundNew
= std::min( uBoundNew
, uBoundOld
);
2222 pActualIndices
[j
] = pLowerBounds
[j
] = lBoundNew
;
2223 pUpperBounds
[j
] = uBoundNew
;
2225 // Copy data from old array by going recursively through all dimensions
2226 // (It would be faster to work on the flat internal data array of an
2227 // SbyArray but this solution is clearer and easier)
2228 implCopyDimArray( pNewArray
, pOldArray
, nDims
- 1,
2229 0, pActualIndices
.get(), pLowerBounds
.get(), pUpperBounds
.get() );
2232 refRedimpArray
= nullptr;
2239 // TOS = Array-Variable, Reference to array is copied
2240 // Variable is cleared as in ERASE
2242 void SbiRuntime::StepREDIMP_ERASE()
2244 SbxVariableRef refVar
= PopVar();
2246 SbxDataType eType
= refVar
->GetType();
2247 if( eType
& SbxARRAY
)
2249 SbxBase
* pElemObj
= refVar
->GetObject();
2250 SbxDimArray
* pDimArray
= dynamic_cast<SbxDimArray
*>( pElemObj
);
2253 refRedimpArray
= pDimArray
;
2257 else if( refVar
->IsFixed() )
2263 refVar
->SetType( SbxEMPTY
);
2267 static void lcl_clearImpl( SbxVariableRef
const & refVar
, SbxDataType
const & eType
)
2269 SbxFlagBits nSavFlags
= refVar
->GetFlags();
2270 refVar
->ResetFlag( SbxFlagBits::Fixed
);
2271 refVar
->SetType( SbxDataType(eType
& 0x0FFF) );
2272 refVar
->SetFlags( nSavFlags
);
2276 static void lcl_eraseImpl( SbxVariableRef
const & refVar
, bool bVBAEnabled
)
2278 SbxDataType eType
= refVar
->GetType();
2279 if( eType
& SbxARRAY
)
2283 SbxBase
* pElemObj
= refVar
->GetObject();
2284 SbxDimArray
* pDimArray
= dynamic_cast<SbxDimArray
*>( pElemObj
);
2287 if ( pDimArray
->hasFixedSize() )
2289 // Clear all Value(s)
2290 pDimArray
->SbxArray::Clear();
2294 pDimArray
->Clear(); // clear dims and values
2299 SbxArray
* pArray
= dynamic_cast<SbxArray
*>( pElemObj
);
2308 // Arrays have on an erase to VB quite a complex behaviour. Here are
2309 // only the type problems at REDIM (#26295) removed at first:
2310 // Set type hard onto the array-type, because a variable with array is
2311 // SbxOBJECT. At REDIM there's an SbxOBJECT-array generated then and
2312 // the original type is lost -> runtime error
2313 lcl_clearImpl( refVar
, eType
);
2316 else if( refVar
->IsFixed() )
2322 refVar
->SetType( SbxEMPTY
);
2329 void SbiRuntime::StepERASE()
2331 SbxVariableRef refVar
= PopVar();
2332 lcl_eraseImpl( refVar
, bVBAEnabled
);
2335 void SbiRuntime::StepERASE_CLEAR()
2337 refRedim
= PopVar();
2340 void SbiRuntime::StepARRAYACCESS()
2344 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2346 SbxVariableRef refVar
= PopVar();
2347 refVar
->SetParameters( refArgv
.get() );
2349 PushVar( CheckArray( refVar
.get() ) );
2352 void SbiRuntime::StepBYVAL()
2354 // Copy variable on stack to break call by reference
2355 SbxVariableRef pVar
= PopVar();
2356 SbxDataType t
= pVar
->GetType();
2358 SbxVariable
* pCopyVar
= new SbxVariable( t
);
2359 pCopyVar
->SetFlag( SbxFlagBits::ReadWrite
);
2362 PushVar( pCopyVar
);
2365 // establishing an argv
2366 // nOp1 stays as it is -> 1st element is the return value
2368 void SbiRuntime::StepARGC()
2371 refArgv
= new SbxArray
;
2375 // storing an argument in Argv
2377 void SbiRuntime::StepARGV()
2381 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2385 SbxVariableRef pVal
= PopVar();
2387 // Before fix of #94916:
2388 if( dynamic_cast<const SbxMethod
*>( pVal
.get() ) != nullptr
2389 || dynamic_cast<const SbUnoProperty
*>( pVal
.get() ) != nullptr
2390 || dynamic_cast<const SbProcedureProperty
*>( pVal
.get() ) != nullptr )
2392 // evaluate methods and properties!
2393 SbxVariable
* pRes
= new SbxVariable( *pVal
);
2396 refArgv
->Put( pVal
.get(), nArgc
++ );
2400 // Input to Variable. The variable is on TOS and is
2401 // is removed afterwards.
2402 void SbiRuntime::StepINPUT()
2409 while( ( err
= pIosys
->GetError() ) == ERRCODE_NONE
)
2411 ch
= pIosys
->Read();
2412 if( ch
!= ' ' && ch
!= '\t' && ch
!= '\n' )
2419 // Scan until comma or whitespace
2420 char sep
= ( ch
== '"' ) ? ch
: 0;
2423 ch
= pIosys
->Read();
2425 while( ( err
= pIosys
->GetError() ) == ERRCODE_NONE
)
2429 ch
= pIosys
->Read();
2435 else if( !sep
&& (ch
== ',' || ch
== '\n') )
2440 ch
= pIosys
->Read();
2443 if( ch
== ' ' || ch
== '\t' )
2445 while( ( err
= pIosys
->GetError() ) == ERRCODE_NONE
)
2447 if( ch
!= ' ' && ch
!= '\t' && ch
!= '\n' )
2451 ch
= pIosys
->Read();
2457 s
= sin
.makeStringAndClear();
2458 SbxVariableRef pVar
= GetTOS();
2459 // try to fill the variable with a numeric value first,
2460 // then with a string value
2461 if( !pVar
->IsFixed() || pVar
->IsNumeric() )
2463 sal_uInt16 nLen
= 0;
2464 if( !pVar
->Scan( s
, &nLen
) )
2466 err
= SbxBase::GetError();
2467 SbxBase::ResetError();
2469 // the value has to be scanned in completely
2470 else if( nLen
!= s
.getLength() && !pVar
->PutString( s
) )
2472 err
= SbxBase::GetError();
2473 SbxBase::ResetError();
2475 else if( nLen
!= s
.getLength() && pVar
->IsNumeric() )
2477 err
= SbxBase::GetError();
2478 SbxBase::ResetError();
2481 err
= ERRCODE_BASIC_CONVERSION
;
2487 pVar
->PutString( s
);
2488 err
= SbxBase::GetError();
2489 SbxBase::ResetError();
2492 if( err
== ERRCODE_BASIC_USER_ABORT
)
2498 if( pRestart
&& !pIosys
->GetChannel() )
2513 // Line Input to Variable. The variable is on TOS and is
2514 // deleted afterwards.
2516 void SbiRuntime::StepLINPUT()
2519 pIosys
->Read( aInput
);
2520 Error( pIosys
->GetError() );
2521 SbxVariableRef p
= PopVar();
2522 p
->PutString(OStringToOUString(aInput
, osl_getThreadTextEncoding()));
2527 void SbiRuntime::StepSTOP()
2533 void SbiRuntime::StepINITFOR()
2538 void SbiRuntime::StepINITFOREACH()
2543 // increment FOR-variable
2545 void SbiRuntime::StepNEXT()
2549 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2552 if( pForStk
->eForType
== ForType::To
)
2554 pForStk
->refVar
->Compute( SbxPLUS
, *pForStk
->refInc
);
2558 // beginning CASE: TOS in CASE-stack
2560 void SbiRuntime::StepCASE()
2562 if( !refCaseStk
.is() )
2564 refCaseStk
= new SbxArray
;
2566 SbxVariableRef xVar
= PopVar();
2567 refCaseStk
->Put( xVar
.get(), refCaseStk
->Count() );
2570 // end CASE: free variable
2572 void SbiRuntime::StepENDCASE()
2574 if( !refCaseStk
.is() || !refCaseStk
->Count() )
2576 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2580 refCaseStk
->Remove( refCaseStk
->Count() - 1 );
2585 void SbiRuntime::StepSTDERROR()
2587 pError
= nullptr; bError
= true;
2588 pInst
->aErrorMsg
.clear();
2589 pInst
->nErr
= ERRCODE_NONE
;
2591 nError
= ERRCODE_NONE
;
2592 SbxErrObject::getUnoErrObject()->Clear();
2595 void SbiRuntime::StepNOERROR()
2597 pInst
->aErrorMsg
.clear();
2598 pInst
->nErr
= ERRCODE_NONE
;
2600 nError
= ERRCODE_NONE
;
2601 SbxErrObject::getUnoErrObject()->Clear();
2607 void SbiRuntime::StepLEAVE()
2610 // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
2611 if ( bInError
&& pError
)
2613 SbxErrObject::getUnoErrObject()->Clear();
2617 void SbiRuntime::StepCHANNEL() // TOS = channel number
2619 SbxVariableRef pChan
= PopVar();
2620 short nChan
= pChan
->GetInteger();
2621 pIosys
->SetChannel( nChan
);
2622 Error( pIosys
->GetError() );
2625 void SbiRuntime::StepCHANNEL0()
2627 pIosys
->ResetChannel();
2630 void SbiRuntime::StepPRINT() // print TOS
2632 SbxVariableRef p
= PopVar();
2633 OUString s1
= p
->GetOUString();
2635 if( p
->GetType() >= SbxINTEGER
&& p
->GetType() <= SbxDOUBLE
)
2637 s
= " "; // one blank before
2641 Error( pIosys
->GetError() );
2644 void SbiRuntime::StepPRINTF() // print TOS in field
2646 SbxVariableRef p
= PopVar();
2647 OUString s1
= p
->GetOUString();
2649 if( p
->GetType() >= SbxINTEGER
&& p
->GetType() <= SbxDOUBLE
)
2654 comphelper::string::padToLength(s
, 14, ' ');
2655 pIosys
->Write( s
.makeStringAndClear() );
2656 Error( pIosys
->GetError() );
2659 void SbiRuntime::StepWRITE() // write TOS
2661 SbxVariableRef p
= PopVar();
2662 // Does the string have to be encapsulated?
2664 switch (p
->GetType() )
2666 case SbxSTRING
: ch
= '"'; break;
2669 case SbxDATE
: ch
= '#'; break;
2677 s
+= p
->GetOUString();
2683 Error( pIosys
->GetError() );
2686 void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos
2688 SbxVariableRef pTos1
= PopVar();
2689 SbxVariableRef pTos
= PopVar();
2690 OUString aDest
= pTos1
->GetOUString();
2691 OUString aSource
= pTos
->GetOUString();
2695 implStepRenameUCB( aSource
, aDest
);
2699 implStepRenameOSL( aSource
, aDest
);
2705 void SbiRuntime::StepPROMPT()
2707 SbxVariableRef p
= PopVar();
2708 OString
aStr(OUStringToOString(p
->GetOUString(), osl_getThreadTextEncoding()));
2709 pIosys
->SetPrompt( aStr
);
2712 // Set Restart point
2714 void SbiRuntime::StepRESTART()
2719 // empty expression on stack for missing parameter
2721 void SbiRuntime::StepEMPTY()
2723 // #57915 The semantics of StepEMPTY() is the representation of a missing argument.
2724 // This is represented by the value 448 (ERRCODE_BASIC_NAMED_NOT_FOUND) of the type error
2725 // in VB. StepEmpty should now rather be named StepMISSING() but the name is kept
2726 // to simplify matters.
2727 SbxVariableRef xVar
= new SbxVariable( SbxVARIANT
);
2728 xVar
->PutErr( 448 );
2729 PushVar( xVar
.get() );
2734 void SbiRuntime::StepERROR()
2736 SbxVariableRef refCode
= PopVar();
2737 sal_uInt16 n
= refCode
->GetUShort();
2738 ErrCode error
= StarBASIC::GetSfxFromVBError( n
);
2741 pInst
->Error( error
);
2749 // loading a numeric constant (+ID)
2751 void SbiRuntime::StepLOADNC( sal_uInt32 nOp1
)
2753 SbxVariable
* p
= new SbxVariable( SbxDOUBLE
);
2755 // #57844 use localized function
2756 OUString aStr
= pImg
->GetString( static_cast<short>( nOp1
) );
2758 sal_Int32 iComma
= aStr
.indexOf(',');
2761 aStr
= aStr
.replaceAt(iComma
, 1, ".");
2763 double n
= ::rtl::math::stringToDouble( aStr
, '.', ',' );
2769 // loading a string constant (+ID)
2771 void SbiRuntime::StepLOADSC( sal_uInt32 nOp1
)
2773 SbxVariable
* p
= new SbxVariable
;
2774 p
->PutString( pImg
->GetString( static_cast<short>( nOp1
) ) );
2778 // Immediate Load (+value)
2780 void SbiRuntime::StepLOADI( sal_uInt32 nOp1
)
2782 SbxVariable
* p
= new SbxVariable
;
2783 p
->PutInteger( static_cast<sal_Int16
>( nOp1
) );
2787 // store a named argument in Argv (+Arg-no. from 1!)
2789 void SbiRuntime::StepARGN( sal_uInt32 nOp1
)
2792 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2795 OUString
aAlias( pImg
->GetString( static_cast<short>( nOp1
) ) );
2796 SbxVariableRef pVal
= PopVar();
2798 ( dynamic_cast<const SbxMethod
*>( pVal
.get()) != nullptr
2799 || dynamic_cast<const SbUnoProperty
*>( pVal
.get()) != nullptr
2800 || dynamic_cast<const SbProcedureProperty
*>( pVal
.get()) != nullptr ) )
2802 // named variables ( that are Any especially properties ) can be empty at this point and need a broadcast
2803 if ( pVal
->GetType() == SbxEMPTY
)
2804 pVal
->Broadcast( SfxHintId::BasicDataWanted
);
2805 // evaluate methods and properties!
2806 SbxVariable
* pRes
= new SbxVariable( *pVal
);
2809 refArgv
->Put( pVal
.get(), nArgc
);
2810 refArgv
->PutAlias( aAlias
, nArgc
++ );
2814 // converting the type of an argument in Argv for DECLARE-Fkt. (+type)
2816 void SbiRuntime::StepARGTYP( sal_uInt32 nOp1
)
2819 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2822 bool bByVal
= (nOp1
& 0x8000) != 0; // Is BYVAL requested?
2823 SbxDataType t
= static_cast<SbxDataType
>(nOp1
& 0x7FFF);
2824 SbxVariable
* pVar
= refArgv
->Get( refArgv
->Count() - 1 ); // last Arg
2827 if( pVar
->GetRefCount() > 2 ) // 2 is normal for BYVAL
2829 // parameter is a reference
2832 // Call by Value is requested -> create a copy
2833 pVar
= new SbxVariable( *pVar
);
2834 pVar
->SetFlag( SbxFlagBits::ReadWrite
);
2835 refExprStk
->Put( pVar
, refArgv
->Count() - 1 );
2838 pVar
->SetFlag( SbxFlagBits::Reference
); // Ref-Flag for DllMgr
2842 // parameter is NO reference
2844 pVar
->ResetFlag( SbxFlagBits::Reference
); // no reference -> OK
2846 Error( ERRCODE_BASIC_BAD_PARAMETERS
); // reference needed
2849 if( pVar
->GetType() != t
)
2851 // variant for correct conversion
2852 // besides error, if SbxBYREF
2853 pVar
->Convert( SbxVARIANT
);
2859 // bring string to a definite length (+length)
2861 void SbiRuntime::StepPAD( sal_uInt32 nOp1
)
2863 SbxVariable
* p
= GetTOS();
2864 OUString s
= p
->GetOUString();
2865 sal_Int32
nLen(nOp1
);
2866 if( s
.getLength() != nLen
)
2868 OUStringBuffer
aBuf(s
);
2869 if (aBuf
.getLength() > nLen
)
2871 comphelper::string::truncateToLength(aBuf
, nLen
);
2875 comphelper::string::padToLength(aBuf
, nLen
, ' ');
2877 s
= aBuf
.makeStringAndClear();
2883 void SbiRuntime::StepJUMP( sal_uInt32 nOp1
)
2886 // #QUESTION shouldn't this be
2887 // if( (sal_uInt8*)( nOp1+pImagGetCode() ) >= pImg->GetCodeSize() )
2888 if( nOp1
>= pImg
->GetCodeSize() )
2889 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2891 pCode
= reinterpret_cast<const sal_uInt8
*>(pImg
->GetCode()) + nOp1
;
2894 // evaluate TOS, conditional jump (+target)
2896 void SbiRuntime::StepJUMPT( sal_uInt32 nOp1
)
2898 SbxVariableRef p
= PopVar();
2903 // evaluate TOS, conditional jump (+target)
2905 void SbiRuntime::StepJUMPF( sal_uInt32 nOp1
)
2907 SbxVariableRef p
= PopVar();
2908 // In a test e.g. If Null then
2909 // will evaluate Null will act as if False
2910 if( ( bVBAEnabled
&& p
->IsNull() ) || !p
->GetBool() )
2914 // evaluate TOS, jump into JUMP-table (+MaxVal)
2920 // if 0x8000 is set in the operand, push the return address (ON..GOSUB)
2922 void SbiRuntime::StepONJUMP( sal_uInt32 nOp1
)
2924 SbxVariableRef p
= PopVar();
2925 sal_Int16 n
= p
->GetInteger();
2929 PushGosub( pCode
+ 5 * nOp1
);
2931 if( n
< 1 || static_cast<sal_uInt32
>(n
) > nOp1
)
2932 n
= static_cast<sal_Int16
>( nOp1
+ 1 );
2933 nOp1
= static_cast<sal_uInt32
>( reinterpret_cast<const char*>(pCode
) - pImg
->GetCode() ) + 5 * --n
;
2937 // UP-call (+target)
2939 void SbiRuntime::StepGOSUB( sal_uInt32 nOp1
)
2942 if( nOp1
>= pImg
->GetCodeSize() )
2943 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2944 pCode
= reinterpret_cast<const sal_uInt8
*>(pImg
->GetCode()) + nOp1
;
2947 // UP-return (+0 or target)
2949 void SbiRuntime::StepRETURN( sal_uInt32 nOp1
)
2956 // check FOR-variable (+Endlabel)
2958 void SbiRuntime::StepTESTFOR( sal_uInt32 nOp1
)
2962 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
2966 bool bEndLoop
= false;
2967 switch( pForStk
->eForType
)
2971 SbxOperator eOp
= ( pForStk
->refInc
->GetDouble() < 0 ) ? SbxLT
: SbxGT
;
2972 if( pForStk
->refVar
->Compare( eOp
, *pForStk
->refEnd
) )
2976 case ForType::EachArray
:
2978 SbiForStack
* p
= pForStk
;
2979 if( p
->pArrayCurIndices
== nullptr )
2985 SbxDimArray
* pArray
= reinterpret_cast<SbxDimArray
*>(p
->refEnd
.get());
2986 short nDims
= pArray
->GetDims();
2989 if( nDims
== 1 && p
->pArrayLowerBounds
[0] > p
->pArrayUpperBounds
[0] )
2994 SbxVariable
* pVal
= pArray
->Get32( p
->pArrayCurIndices
.get() );
2995 *(p
->refVar
) = *pVal
;
2997 bool bFoundNext
= false;
2998 for( short i
= 0 ; i
< nDims
; i
++ )
3000 if( p
->pArrayCurIndices
[i
] < p
->pArrayUpperBounds
[i
] )
3003 p
->pArrayCurIndices
[i
]++;
3004 for( short j
= i
- 1 ; j
>= 0 ; j
-- )
3005 p
->pArrayCurIndices
[j
] = p
->pArrayLowerBounds
[j
];
3011 p
->pArrayCurIndices
.reset();
3016 case ForType::EachCollection
:
3018 BasicCollection
* pCollection
= static_cast<BasicCollection
*>(pForStk
->refEnd
.get());
3019 SbxArrayRef xItemArray
= pCollection
->xItemArray
;
3020 sal_Int32 nCount
= xItemArray
->Count32();
3021 if( pForStk
->nCurCollectionIndex
< nCount
)
3023 SbxVariable
* pRes
= xItemArray
->Get32( pForStk
->nCurCollectionIndex
);
3024 pForStk
->nCurCollectionIndex
++;
3025 (*pForStk
->refVar
) = *pRes
;
3033 case ForType::EachXEnumeration
:
3035 SbiForStack
* p
= pForStk
;
3036 if( p
->xEnumeration
->hasMoreElements() )
3038 Any aElem
= p
->xEnumeration
->nextElement();
3039 SbxVariableRef xVar
= new SbxVariable( SbxVARIANT
);
3040 unoToSbxValue( xVar
.get(), aElem
);
3041 (*pForStk
->refVar
) = *xVar
;
3057 // Tos+1 <= Tos+2 <= Tos, 2xremove (+Target)
3059 void SbiRuntime::StepCASETO( sal_uInt32 nOp1
)
3061 if( !refCaseStk
.is() || !refCaseStk
->Count() )
3062 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
3065 SbxVariableRef xTo
= PopVar();
3066 SbxVariableRef xFrom
= PopVar();
3067 SbxVariableRef xCase
= refCaseStk
->Get( refCaseStk
->Count() - 1 );
3068 if( *xCase
>= *xFrom
&& *xCase
<= *xTo
)
3074 void SbiRuntime::StepERRHDL( sal_uInt32 nOp1
)
3076 const sal_uInt8
* p
= pCode
;
3080 pInst
->aErrorMsg
.clear();
3081 pInst
->nErr
= ERRCODE_NONE
;
3083 nError
= ERRCODE_NONE
;
3084 SbxErrObject::getUnoErrObject()->Clear();
3087 // Resume after errors (+0=statement, 1=next or Label)
3089 void SbiRuntime::StepRESUME( sal_uInt32 nOp1
)
3091 // #32714 Resume without error? -> error
3094 Error( ERRCODE_BASIC_BAD_RESUME
);
3099 // set Code-pointer to the next statement
3101 pCode
= pMod
->FindNextStmnt( pErrCode
, n1
, n2
, true, pImg
);
3105 if ( pError
) // current in error handler ( and got a Resume Next statement )
3106 SbxErrObject::getUnoErrObject()->Clear();
3110 pInst
->aErrorMsg
.clear();
3111 pInst
->nErr
= ERRCODE_NONE
;
3113 nError
= ERRCODE_NONE
;
3117 // close channel (+channel, 0=all)
3118 void SbiRuntime::StepCLOSE( sal_uInt32 nOp1
)
3125 err
= pIosys
->GetError();
3131 err
= pIosys
->GetError();
3135 // output character (+char)
3137 void SbiRuntime::StepPRCHAR( sal_uInt32 nOp1
)
3139 OUString
s(static_cast<sal_Unicode
>(nOp1
));
3141 Error( pIosys
->GetError() );
3144 // check whether TOS is a certain object class (+StringID)
3146 bool SbiRuntime::implIsClass( SbxObject
const * pObj
, const OUString
& aClass
)
3150 if( !aClass
.isEmpty() )
3152 bRet
= pObj
->IsClass( aClass
);
3154 bRet
= aClass
.equalsIgnoreAsciiCase( "object" );
3157 const OUString
& aObjClass
= pObj
->GetClassName();
3158 SbModule
* pClassMod
= GetSbData()->pClassFac
->FindClass( aObjClass
);
3159 SbClassData
* pClassData
;
3160 if( pClassMod
&& (pClassData
=pClassMod
->pClassData
.get()) != nullptr )
3162 SbxVariable
* pClassVar
= pClassData
->mxIfaces
->Find( aClass
, SbxClassType::DontCare
);
3163 bRet
= (pClassVar
!= nullptr);
3170 bool SbiRuntime::checkClass_Impl( const SbxVariableRef
& refVal
,
3171 const OUString
& aClass
, bool bRaiseErrors
, bool bDefault
)
3173 bool bOk
= bDefault
;
3175 SbxDataType t
= refVal
->GetType();
3176 SbxVariable
* pVal
= refVal
.get();
3177 // we don't know the type of uno properties that are (maybevoid)
3178 if ( t
== SbxEMPTY
)
3180 if ( auto pProp
= dynamic_cast<SbUnoProperty
*>( refVal
.get() ) )
3182 t
= pProp
->getRealType();
3185 if( t
== SbxOBJECT
|| bVBAEnabled
)
3187 SbxObject
* pObj
= dynamic_cast<SbxObject
*>(pVal
);
3190 pObj
= dynamic_cast<SbxObject
*>(refVal
->GetObject());
3194 if( !implIsClass( pObj
, aClass
) )
3196 SbUnoObject
* pUnoObj(nullptr);
3197 if (bVBAEnabled
|| CodeCompleteOptions::IsExtendedTypeDeclaration())
3199 pUnoObj
= dynamic_cast<SbUnoObject
*>(pObj
);
3203 bOk
= checkUnoObjectType(*pUnoObj
, aClass
);
3206 if ( !bOk
&& bRaiseErrors
)
3207 Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT
);
3213 SbClassModuleObject
* pClassModuleObject
= dynamic_cast<SbClassModuleObject
*>( pObj
);
3214 if( pClassModuleObject
!= nullptr )
3215 pClassModuleObject
->triggerInitializeEvent();
3222 Error( ERRCODE_BASIC_NEEDS_OBJECT
);
3228 void SbiRuntime::StepSETCLASS_impl( sal_uInt32 nOp1
, bool bHandleDflt
)
3230 SbxVariableRef refVal
= PopVar();
3231 SbxVariableRef refVar
= PopVar();
3232 OUString
aClass( pImg
->GetString( static_cast<short>( nOp1
) ) );
3234 bool bOk
= checkClass_Impl( refVal
, aClass
, true, true );
3237 StepSET_Impl( refVal
, refVar
, bHandleDflt
); // don't do handle default prop for a "proper" set
3241 void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1
)
3243 StepSETCLASS_impl( nOp1
, false );
3246 void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1
)
3248 StepSETCLASS_impl( nOp1
, true );
3251 void SbiRuntime::StepTESTCLASS( sal_uInt32 nOp1
)
3253 SbxVariableRef xObjVal
= PopVar();
3254 OUString
aClass( pImg
->GetString( static_cast<short>( nOp1
) ) );
3255 bool bDefault
= !bVBAEnabled
;
3256 bool bOk
= checkClass_Impl( xObjVal
, aClass
, false, bDefault
);
3258 SbxVariable
* pRet
= new SbxVariable
;
3259 pRet
->PutBool( bOk
);
3263 // define library for following declare-call
3265 void SbiRuntime::StepLIB( sal_uInt32 nOp1
)
3267 aLibName
= pImg
->GetString( static_cast<short>( nOp1
) );
3270 // TOS is incremented by BASE, BASE is pushed before (+BASE)
3271 // This opcode is pushed before DIM/REDIM-commands,
3272 // if there's been only one index named.
3274 void SbiRuntime::StepBASED( sal_uInt32 nOp1
)
3276 SbxVariable
* p1
= new SbxVariable
;
3277 SbxVariableRef x2
= PopVar();
3279 // #109275 Check compatibility mode
3280 bool bCompatible
= ((nOp1
& 0x8000) != 0);
3281 sal_uInt16 uBase
= static_cast<sal_uInt16
>(nOp1
& 1); // Can only be 0 or 1
3282 p1
->PutInteger( uBase
);
3284 x2
->Compute( SbxPLUS
, *p1
);
3285 PushVar( x2
.get() ); // first the Expr
3286 PushVar( p1
); // then the Base
3289 // the bits in the String-ID:
3290 // 0x8000 - Argv is reserved
3292 SbxVariable
* SbiRuntime::FindElement( SbxObject
* pObj
, sal_uInt32 nOp1
, sal_uInt32 nOp2
,
3293 ErrCode nNotFound
, bool bLocal
, bool bStatic
)
3295 bool bIsVBAInterOp
= SbiRuntime::isVBAEnabled();
3298 StarBASIC
* pMSOMacroRuntimeLib
= GetSbData()->pMSOMacroRuntimLib
;
3299 if( pMSOMacroRuntimeLib
!= nullptr )
3301 pMSOMacroRuntimeLib
->ResetFlag( SbxFlagBits::ExtSearch
);
3305 SbxVariable
* pElem
= nullptr;
3308 Error( ERRCODE_BASIC_NO_OBJECT
);
3309 pElem
= new SbxVariable
;
3313 bool bFatalError
= false;
3314 SbxDataType t
= static_cast<SbxDataType
>(nOp2
);
3315 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
& 0x7FFF ) ) );
3316 // Hacky capture of Evaluate [] syntax
3317 // this should be tackled I feel at the pcode level
3318 if ( bIsVBAInterOp
&& aName
.startsWith("[") )
3320 // emulate pcode here
3322 // pseudo StepLOADSC
3323 OUString sArg
= aName
.copy( 1, aName
.getLength() - 2 );
3324 SbxVariable
* p
= new SbxVariable
;
3325 p
->PutString( sArg
);
3328 nOp1
= nOp1
| 0x8000; // indicate params are present
3333 if ( bStatic
&& pMeth
)
3335 pElem
= pMeth
->GetStatics()->Find( aName
, SbxClassType::DontCare
);
3340 pElem
= refLocals
->Find( aName
, SbxClassType::DontCare
);
3345 bool bSave
= rBasic
.bNoRtl
;
3346 rBasic
.bNoRtl
= true;
3347 pElem
= pObj
->Find( aName
, SbxClassType::DontCare
);
3349 // #110004, #112015: Make private really private
3350 if( bLocal
&& pElem
) // Local as flag for global search
3352 if( pElem
->IsSet( SbxFlagBits::Private
) )
3354 SbiInstance
* pInst_
= GetSbData()->pInst
;
3355 if( pInst_
&& pInst_
->IsCompatibility() && pObj
!= pElem
->GetParent() )
3357 pElem
= nullptr; // Found but in wrong module!
3359 // Interfaces: Use SbxFlagBits::ExtFound
3362 rBasic
.bNoRtl
= bSave
;
3364 // is it a global uno-identifier?
3365 if( bLocal
&& !pElem
)
3367 bool bSetName
= true; // preserve normal behaviour
3369 // i#i68894# if VBAInterOp favour searching vba globals
3370 // over searching for uno classes
3373 // Try Find in VBA symbols space
3374 pElem
= rBasic
.VBAFind( aName
, SbxClassType::DontCare
);
3377 bSetName
= false; // don't overwrite uno name
3381 pElem
= VBAConstantHelper::instance().getVBAConstant( aName
);
3387 // #72382 ATTENTION! ALWAYS returns a result now
3388 // because of unknown modules!
3389 SbUnoClass
* pUnoClass
= findUnoClass( aName
);
3392 pElem
= new SbxVariable( t
);
3393 SbxValues
aRes( SbxOBJECT
);
3394 aRes
.pObj
= pUnoClass
;
3395 pElem
->SbxVariable::Put( aRes
);
3399 // #62939 If a uno-class has been found, the wrapper
3400 // object has to be held, because the uno-class, e. g.
3401 // "stardiv", has to be read out of the registry
3402 // every time again otherwise
3405 // #63774 May not be saved too!!!
3406 pElem
->SetFlag( SbxFlagBits::DontStore
);
3407 pElem
->SetFlag( SbxFlagBits::NoModify
);
3409 // #72382 save locally, all variables that have been declared
3410 // implicit would become global automatically otherwise!
3413 pElem
->SetName( aName
);
3415 refLocals
->Put( pElem
, refLocals
->Count() );
3421 // not there and not in the object?
3422 // don't establish if that thing has parameters!
3428 // else, if there are parameters, use different error code
3429 if( !bLocal
|| pImg
->IsFlag( SbiImageFlags::EXPLICIT
) )
3431 // #39108 if explicit and as ELEM always a fatal error
3435 if( !( nOp1
& 0x8000 ) && nNotFound
== ERRCODE_BASIC_PROC_UNDEFINED
)
3437 nNotFound
= ERRCODE_BASIC_VAR_UNDEFINED
;
3442 // #39108 use dummy variable instead of fatal error
3443 if( !xDummyVar
.is() )
3445 xDummyVar
= new SbxVariable( SbxVARIANT
);
3447 pElem
= xDummyVar
.get();
3451 Error( nNotFound
, aName
);
3457 pElem
= StepSTATIC_Impl( aName
, t
, 0 );
3461 pElem
= new SbxVariable( t
);
3462 if( t
!= SbxVARIANT
)
3464 pElem
->SetFlag( SbxFlagBits::Fixed
);
3466 pElem
->SetName( aName
);
3467 refLocals
->Put( pElem
, refLocals
->Count() );
3472 // #39108 Args can already be deleted!
3475 SetupArgs( pElem
, nOp1
);
3477 // because a particular call-type is requested
3478 if (SbxMethod
* pMethod
= dynamic_cast<SbxMethod
*>(pElem
))
3480 // shall the type be converted?
3481 SbxDataType t2
= pElem
->GetType();
3483 if( (pElem
->GetFlags() & SbxFlagBits::Fixed
) == SbxFlagBits::NONE
)
3485 if( t
!= SbxVARIANT
&& t
!= t2
&&
3486 t
>= SbxINTEGER
&& t
<= SbxSTRING
)
3488 pElem
->SetType( t
);
3492 // assign pElem to a Ref, to delete a temp-var if applicable
3493 SbxVariableRef refTemp
= pElem
;
3495 // remove potential rests of the last call of the SbxMethod
3496 // free Write before, so that there's no error
3497 SbxFlagBits nSavFlags
= pElem
->GetFlags();
3498 pElem
->SetFlag( SbxFlagBits::ReadWrite
| SbxFlagBits::NoBroadcast
);
3499 pElem
->SbxValue::Clear();
3500 pElem
->SetFlags( nSavFlags
);
3502 // don't touch before setting, as e. g. LEFT()
3503 // has to know the difference between Left$() and Left()
3505 // because the methods' parameters are cut away in PopVar()
3506 SbxVariable
* pNew
= new SbxMethod(*pMethod
);
3507 //OLD: SbxVariable* pNew = new SbxVariable( *pElem );
3509 pElem
->SetParameters(nullptr);
3510 pNew
->SetFlag( SbxFlagBits::ReadWrite
);
3514 pElem
->SetType( t2
);
3518 // consider index-access for UnoObjects
3519 // definitely we want this for VBA where properties are often
3520 // collections ( which need index access ), but lets only do
3521 // this if we actually have params following
3522 else if( bVBAEnabled
&& dynamic_cast<const SbUnoProperty
*>( pElem
) != nullptr && pElem
->GetParameters() )
3524 SbxVariableRef refTemp
= pElem
;
3526 // dissolve the notify while copying variable
3527 SbxVariable
* pNew
= new SbxVariable( *pElem
);
3528 pElem
->SetParameters( nullptr );
3532 return CheckArray( pElem
);
3535 // for current scope (e. g. query from BASIC-IDE)
3536 SbxBase
* SbiRuntime::FindElementExtern( const OUString
& rName
)
3538 // don't expect pMeth to be != 0, as there are none set
3539 // in the RunInit yet
3541 SbxVariable
* pElem
= nullptr;
3542 if( !pMod
|| rName
.isEmpty() )
3546 if( refLocals
.is() )
3548 pElem
= refLocals
->Find( rName
, SbxClassType::DontCare
);
3550 if ( !pElem
&& pMeth
)
3552 // for statics, set the method's name in front
3553 OUString aMethName
= pMeth
->GetName() + ":" + rName
;
3554 pElem
= pMod
->Find(aMethName
, SbxClassType::DontCare
);
3557 // search in parameter list
3558 if( !pElem
&& pMeth
)
3560 SbxInfo
* pInfo
= pMeth
->GetInfo();
3561 if( pInfo
&& refParams
.is() )
3563 sal_uInt16 nParamCount
= refParams
->Count();
3565 const SbxParamInfo
* pParam
= pInfo
->GetParam( j
);
3568 if( pParam
->aName
.equalsIgnoreAsciiCase( rName
) )
3570 if( j
>= nParamCount
)
3572 // Parameter is missing
3573 pElem
= new SbxVariable( SbxSTRING
);
3574 pElem
->PutString( "<missing parameter>");
3578 pElem
= refParams
->Get( j
);
3582 pParam
= pInfo
->GetParam( ++j
);
3590 bool bSave
= rBasic
.bNoRtl
;
3591 rBasic
.bNoRtl
= true;
3592 pElem
= pMod
->Find( rName
, SbxClassType::DontCare
);
3593 rBasic
.bNoRtl
= bSave
;
3599 void SbiRuntime::SetupArgs( SbxVariable
* p
, sal_uInt32 nOp1
)
3605 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
3607 bool bHasNamed
= false;
3609 sal_uInt16 nArgCount
= refArgv
->Count();
3610 for( i
= 1 ; i
< nArgCount
; i
++ )
3612 if( !refArgv
->GetAlias(i
).isEmpty() )
3614 bHasNamed
= true; break;
3619 SbxInfo
* pInfo
= p
->GetInfo();
3622 bool bError_
= true;
3624 SbUnoMethod
* pUnoMethod
= dynamic_cast<SbUnoMethod
*>( p
);
3625 SbUnoProperty
* pUnoProperty
= dynamic_cast<SbUnoProperty
*>( p
);
3626 if( pUnoMethod
|| pUnoProperty
)
3628 SbUnoObject
* pParentUnoObj
= dynamic_cast<SbUnoObject
*>( p
->GetParent() );
3631 Any aUnoAny
= pParentUnoObj
->getUnoAny();
3632 Reference
< XInvocation
> xInvocation
;
3633 aUnoAny
>>= xInvocation
;
3634 if( xInvocation
.is() ) // TODO: if( xOLEAutomation.is() )
3638 sal_uInt16 nCurPar
= 1;
3639 AutomationNamedArgsSbxArray
* pArg
=
3640 new AutomationNamedArgsSbxArray( nArgCount
);
3641 OUString
* pNames
= pArg
->getNames().getArray();
3642 for( i
= 1 ; i
< nArgCount
; i
++ )
3644 SbxVariable
* pVar
= refArgv
->Get( i
);
3645 OUString aName
= refArgv
->GetAlias(i
);
3646 if (!aName
.isEmpty())
3650 pArg
->Put( pVar
, nCurPar
++ );
3656 else if( bVBAEnabled
&& p
->GetType() == SbxOBJECT
&& (dynamic_cast<const SbxMethod
*>( p
) == nullptr || !p
->IsBroadcaster()) )
3658 // Check for default method with named parameters
3659 SbxBaseRef xObj
= p
->GetObject();
3660 if (SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>( xObj
.get() ))
3662 Any aAny
= pUnoObj
->getUnoAny();
3664 if( aAny
.getValueType().getTypeClass() == TypeClass_INTERFACE
)
3666 Reference
< XDefaultMethod
> xDfltMethod( aAny
, UNO_QUERY
);
3668 OUString sDefaultMethod
;
3669 if ( xDfltMethod
.is() )
3671 sDefaultMethod
= xDfltMethod
->getDefaultMethodName();
3673 if ( !sDefaultMethod
.isEmpty() )
3675 SbxVariable
* meth
= pUnoObj
->Find( sDefaultMethod
, SbxClassType::Method
);
3676 if( meth
!= nullptr )
3678 pInfo
= meth
->GetInfo();
3690 Error( ERRCODE_BASIC_NO_NAMED_ARGS
);
3695 sal_uInt16 nCurPar
= 1;
3696 SbxArray
* pArg
= new SbxArray
;
3697 for( i
= 1 ; i
< nArgCount
; i
++ )
3699 SbxVariable
* pVar
= refArgv
->Get( i
);
3700 OUString aName
= refArgv
->GetAlias(i
);
3701 if (!aName
.isEmpty())
3703 // nCurPar is set to the found parameter
3705 const SbxParamInfo
* pParam
= pInfo
->GetParam( j
);
3708 if( pParam
->aName
.equalsIgnoreAsciiCase( aName
) )
3713 pParam
= pInfo
->GetParam( ++j
);
3717 Error( ERRCODE_BASIC_NAMED_NOT_FOUND
); break;
3720 pArg
->Put( pVar
, nCurPar
++ );
3725 // own var as parameter 0
3726 refArgv
->Put( p
, 0 );
3727 p
->SetParameters( refArgv
.get() );
3732 p
->SetParameters( nullptr );
3736 // getting an array element
3738 SbxVariable
* SbiRuntime::CheckArray( SbxVariable
* pElem
)
3741 if( ( pElem
->GetType() & SbxARRAY
) && refRedim
.get() != pElem
)
3743 SbxBase
* pElemObj
= pElem
->GetObject();
3744 SbxDimArray
* pDimArray
= dynamic_cast<SbxDimArray
*>( pElemObj
);
3745 pPar
= pElem
->GetParameters();
3748 // parameters may be missing, if an array is
3749 // passed as an argument
3751 pElem
= pDimArray
->Get( pPar
);
3755 SbxArray
* pArray
= dynamic_cast<SbxArray
*>( pElemObj
);
3760 Error( ERRCODE_BASIC_OUT_OF_RANGE
);
3761 pElem
= new SbxVariable
;
3765 pElem
= pArray
->Get( pPar
->Get( 1 )->GetInteger() );
3770 // #42940, set parameter 0 to NULL so that var doesn't contain itself
3773 pPar
->Put( nullptr, 0 );
3776 // consider index-access for UnoObjects
3777 else if( pElem
->GetType() == SbxOBJECT
&&
3778 dynamic_cast<const SbxMethod
*>( pElem
) == nullptr &&
3779 ( !bVBAEnabled
|| dynamic_cast<const SbxProperty
*>( pElem
) == nullptr ) )
3781 pPar
= pElem
->GetParameters();
3784 // is it a uno-object?
3785 SbxBaseRef pObj
= pElem
->GetObject();
3788 if (SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>( pObj
.get()))
3790 Any aAny
= pUnoObj
->getUnoAny();
3792 if( aAny
.getValueType().getTypeClass() == TypeClass_INTERFACE
)
3794 Reference
< XIndexAccess
> xIndexAccess( aAny
, UNO_QUERY
);
3797 if( xIndexAccess
.is() )
3799 sal_uInt32 nParamCount
= static_cast<sal_uInt32
>(pPar
->Count()) - 1;
3800 if( nParamCount
!= 1 )
3802 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3807 sal_Int32 nIndex
= pPar
->Get( 1 )->GetLong();
3808 Reference
< XInterface
> xRet
;
3811 Any aAny2
= xIndexAccess
->getByIndex( nIndex
);
3814 catch (const IndexOutOfBoundsException
&)
3816 // usually expect converting problem
3817 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE
);
3820 // #57847 always create a new variable, else error
3821 // due to PutObject(NULL) at ReadOnly-properties
3822 pElem
= new SbxVariable( SbxVARIANT
);
3827 // #67173 don't specify a name so that the real class name is entered
3828 SbxObjectRef xWrapper
= static_cast<SbxObject
*>(new SbUnoObject( OUString(), aAny
));
3829 pElem
->PutObject( xWrapper
.get() );
3833 pElem
->PutObject( nullptr );
3839 // check if there isn't a default member between the current variable
3840 // and the params, e.g.
3841 // Dim rst1 As New ADODB.Recordset
3843 // val = rst1("FirstName")
3844 // has the default 'Fields' member between rst1 and '("FirstName")'
3846 SbxVariable
* pDflt
= getDefaultProp( pElem
);
3849 pDflt
->Broadcast( SfxHintId::BasicDataWanted
);
3850 SbxBaseRef pDfltObj
= pDflt
->GetObject();
3853 if (SbUnoObject
* pSbObj
= dynamic_cast<SbUnoObject
*>(pDfltObj
.get()))
3856 Any aUnoAny
= pUnoObj
->getUnoAny();
3858 if( aUnoAny
.getValueType().getTypeClass() == TypeClass_INTERFACE
)
3864 OUString sDefaultMethod
;
3866 Reference
< XDefaultMethod
> xDfltMethod( x
, UNO_QUERY
);
3868 if ( xDfltMethod
.is() )
3870 sDefaultMethod
= xDfltMethod
->getDefaultMethodName();
3872 else if( xIndexAccess
.is() )
3874 sDefaultMethod
= "getByIndex";
3876 if ( !sDefaultMethod
.isEmpty() )
3878 SbxVariable
* meth
= pUnoObj
->Find( sDefaultMethod
, SbxClassType::Method
);
3879 SbxVariableRef refTemp
= meth
;
3882 meth
->SetParameters( pPar
);
3883 SbxVariable
* pNew
= new SbxMethod( *static_cast<SbxMethod
*>(meth
) );
3890 // #42940, set parameter 0 to NULL so that var doesn't contain itself
3891 pPar
->Put( nullptr, 0 );
3893 else if (BasicCollection
* pCol
= dynamic_cast<BasicCollection
*>(pObj
.get()))
3895 pElem
= new SbxVariable( SbxVARIANT
);
3896 pPar
->Put( pElem
, 0 );
3897 pCol
->CollItem( pPar
);
3900 else if( bVBAEnabled
) // !pObj
3902 SbxArray
* pParam
= pElem
->GetParameters();
3903 if( pParam
!= nullptr && !pElem
->IsSet( SbxFlagBits::VarToDim
) )
3905 Error( ERRCODE_BASIC_NO_OBJECT
);
3914 // loading an element from the runtime-library (+StringID+type)
3916 void SbiRuntime::StepRTL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
3918 PushVar( FindElement( rBasic
.pRtl
.get(), nOp1
, nOp2
, ERRCODE_BASIC_PROC_UNDEFINED
, false ) );
3921 void SbiRuntime::StepFIND_Impl( SbxObject
* pObj
, sal_uInt32 nOp1
, sal_uInt32 nOp2
,
3922 ErrCode nNotFound
, bool bStatic
)
3924 if( !refLocals
.is() )
3926 refLocals
= new SbxArray
;
3928 PushVar( FindElement( pObj
, nOp1
, nOp2
, nNotFound
, true/*bLocal*/, bStatic
) );
3930 // loading a local/global variable (+StringID+type)
3932 void SbiRuntime::StepFIND( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
3934 StepFIND_Impl( pMod
, nOp1
, nOp2
, ERRCODE_BASIC_PROC_UNDEFINED
);
3937 // Search inside a class module (CM) to enable global search in time
3938 void SbiRuntime::StepFIND_CM( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
3941 SbClassModuleObject
* pClassModuleObject
= dynamic_cast<SbClassModuleObject
*>( pMod
);
3942 if( pClassModuleObject
)
3944 pMod
->SetFlag( SbxFlagBits::GlobalSearch
);
3946 StepFIND_Impl( pMod
, nOp1
, nOp2
, ERRCODE_BASIC_PROC_UNDEFINED
);
3948 if( pClassModuleObject
)
3950 pMod
->ResetFlag( SbxFlagBits::GlobalSearch
);
3954 void SbiRuntime::StepFIND_STATIC( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
3956 StepFIND_Impl( pMod
, nOp1
, nOp2
, ERRCODE_BASIC_PROC_UNDEFINED
, true );
3959 // loading an object-element (+StringID+type)
3960 // the object lies on TOS
3962 void SbiRuntime::StepELEM( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
3964 SbxVariableRef pObjVar
= PopVar();
3966 SbxObject
* pObj
= dynamic_cast<SbxObject
*>( pObjVar
.get() );
3969 SbxBase
* pObjVarObj
= pObjVar
->GetObject();
3970 pObj
= dynamic_cast<SbxObject
*>( pObjVarObj
);
3973 // #56368 save reference at StepElem, otherwise objects could
3974 // lose their reference too early in qualification chains like
3975 // ActiveComponent.Selection(0).Text
3976 // #74254 now per list
3979 aRefSaved
.emplace_back(pObj
);
3981 PushVar( FindElement( pObj
, nOp1
, nOp2
, ERRCODE_BASIC_NO_METHOD
, false ) );
3984 // loading a parameter (+offset+type)
3985 // If the data type is wrong, create a copy.
3986 // The data type SbxEMPTY shows that no parameters are given.
3987 // Get( 0 ) may be EMPTY
3989 void SbiRuntime::StepPARAM( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
3991 sal_uInt16 i
= static_cast<sal_uInt16
>( nOp1
& 0x7FFF );
3992 SbxDataType t
= static_cast<SbxDataType
>(nOp2
);
3995 // #57915 solve missing in a cleaner way
3996 sal_uInt16 nParamCount
= refParams
->Count();
3997 if( i
>= nParamCount
)
3999 sal_Int16 iLoop
= i
;
4000 while( iLoop
>= nParamCount
)
4002 p
= new SbxVariable();
4004 if( SbiRuntime::isVBAEnabled() &&
4005 (t
== SbxOBJECT
|| t
== SbxSTRING
) )
4007 if( t
== SbxOBJECT
)
4009 p
->PutObject( nullptr );
4013 p
->PutString( OUString() );
4018 p
->PutErr( 448 ); // like in VB: Error-Code 448 (ERRCODE_BASIC_NAMED_NOT_FOUND)
4020 refParams
->Put( p
, iLoop
);
4024 p
= refParams
->Get( i
);
4026 if( p
->GetType() == SbxERROR
&& i
)
4028 // if there's a parameter missing, it can be OPTIONAL
4032 SbxInfo
* pInfo
= pMeth
->GetInfo();
4035 const SbxParamInfo
* pParam
= pInfo
->GetParam( i
);
4036 if( pParam
&& ( pParam
->nFlags
& SbxFlagBits::Optional
) )
4039 sal_uInt16 nDefaultId
= static_cast<sal_uInt16
>(pParam
->nUserData
& 0x0ffff);
4040 if( nDefaultId
> 0 )
4042 OUString aDefaultStr
= pImg
->GetString( nDefaultId
);
4043 p
= new SbxVariable(pParam
-> eType
);
4044 p
->PutString( aDefaultStr
);
4045 refParams
->Put( p
, i
);
4053 Error( ERRCODE_BASIC_NOT_OPTIONAL
);
4056 else if( t
!= SbxVARIANT
&& static_cast<SbxDataType
>(p
->GetType() & 0x0FFF ) != t
)
4058 SbxVariable
* q
= new SbxVariable( t
);
4059 aRefSaved
.emplace_back(q
);
4064 refParams
->Put( p
, i
);
4067 SetupArgs( p
, nOp1
);
4068 PushVar( CheckArray( p
) );
4071 // Case-Test (+True-Target+Test-Opcode)
4073 void SbiRuntime::StepCASEIS( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4075 if( !refCaseStk
.is() || !refCaseStk
->Count() )
4077 StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR
);
4081 SbxVariableRef xComp
= PopVar();
4082 SbxVariableRef xCase
= refCaseStk
->Get( refCaseStk
->Count() - 1 );
4083 if( xCase
->Compare( static_cast<SbxOperator
>(nOp2
), *xComp
) )
4090 // call of a DLL-procedure (+StringID+type)
4091 // the StringID's MSB shows that Argv is occupied
4093 void SbiRuntime::StepCALL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4095 OUString aName
= pImg
->GetString( static_cast<short>( nOp1
& 0x7FFF ) );
4096 SbxArray
* pArgs
= nullptr;
4099 pArgs
= refArgv
.get();
4101 DllCall( aName
, aLibName
, pArgs
, static_cast<SbxDataType
>(nOp2
), false );
4109 // call of a DLL-procedure after CDecl (+StringID+type)
4111 void SbiRuntime::StepCALLC( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4113 OUString aName
= pImg
->GetString( static_cast<short>( nOp1
& 0x7FFF ) );
4114 SbxArray
* pArgs
= nullptr;
4117 pArgs
= refArgv
.get();
4119 DllCall( aName
, aLibName
, pArgs
, static_cast<SbxDataType
>(nOp2
), true );
4128 // beginning of a statement (+Line+Col)
4130 void SbiRuntime::StepSTMNT( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4132 // If the Expr-Stack at the beginning of a statement contains a variable,
4133 // some fool has called X as a function, although it's a variable!
4134 bool bFatalExpr
= false;
4135 OUString sUnknownMethodName
;
4142 SbxVariable
* p
= refExprStk
->Get( 0 );
4143 if( p
->GetRefCount() > 1 &&
4144 refLocals
.is() && refLocals
->Find( p
->GetName(), p
->GetClass() ) )
4146 sUnknownMethodName
= p
->GetName();
4155 // We have to cancel hard here because line and column
4156 // would be wrong later otherwise!
4159 StarBASIC::FatalError( ERRCODE_BASIC_NO_METHOD
, sUnknownMethodName
);
4163 sal_uInt16 nOld
= nLine
;
4164 nLine
= static_cast<short>( nOp1
);
4166 // #29955 & 0xFF, to filter out for-loop-level
4167 nCol1
= static_cast<short>( nOp2
& 0xFF );
4169 // find the next STMNT-command to set the final column
4170 // of this statement
4174 const sal_uInt8
* p
= pMod
->FindNextStmnt( pCode
, n1
, n2
);
4179 // #29955 & 0xFF, to filter out for-loop-level
4180 nCol2
= (n2
& 0xFF) - 1;
4184 // #29955 correct for-loop-level, #67452 NOT in the error-handler
4187 // (there's a difference here in case of a jump out of a loop)
4188 sal_uInt16 nExspectedForLevel
= static_cast<sal_uInt16
>( nOp2
/ 0x100 );
4189 if( !pGosubStk
.empty() )
4191 nExspectedForLevel
= nExspectedForLevel
+ pGosubStk
.back().nStartForLvl
;
4194 // if the actual for-level is too small it'd jump out
4195 // of a loop -> corrected
4196 while( nForLvl
> nExspectedForLevel
)
4202 // 16.10.96: #31460 new concept for StepInto/Over/Out
4203 // see explanation at _ImplGetBreakCallLevel
4204 if( pInst
->nCallLvl
<= pInst
->nBreakCallLvl
)
4206 StarBASIC
* pStepBasic
= GetCurrentBasic( &rBasic
);
4207 BasicDebugFlags nNewFlags
= pStepBasic
->StepPoint( nLine
, nCol1
, nCol2
);
4209 pInst
->CalcBreakCallLevel( nNewFlags
);
4212 // break points only at STMNT-commands in a new line!
4213 else if( ( nOp1
!= nOld
)
4214 && ( nFlags
& BasicDebugFlags::Break
)
4215 && pMod
->IsBP( static_cast<sal_uInt16
>( nOp1
) ) )
4217 StarBASIC
* pBreakBasic
= GetCurrentBasic( &rBasic
);
4218 BasicDebugFlags nNewFlags
= pBreakBasic
->BreakPoint( nLine
, nCol1
, nCol2
);
4220 pInst
->CalcBreakCallLevel( nNewFlags
);
4224 // (+StreamMode+Flags)
4225 // Stack: block length
4229 void SbiRuntime::StepOPEN( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4231 SbxVariableRef pName
= PopVar();
4232 SbxVariableRef pChan
= PopVar();
4233 SbxVariableRef pLen
= PopVar();
4234 short nBlkLen
= pLen
->GetInteger();
4235 short nChan
= pChan
->GetInteger();
4236 OString
aName(OUStringToOString(pName
->GetOUString(), osl_getThreadTextEncoding()));
4237 pIosys
->Open( nChan
, aName
, static_cast<StreamMode
>( nOp1
),
4238 static_cast<SbiStreamFlags
>( nOp2
), nBlkLen
);
4239 Error( pIosys
->GetError() );
4242 // create object (+StringID+StringID)
4244 void SbiRuntime::StepCREATE( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4246 OUString
aClass( pImg
->GetString( static_cast<short>( nOp2
) ) );
4247 SbxObject
*pObj
= SbxBase::CreateObject( aClass
);
4250 Error( ERRCODE_BASIC_INVALID_OBJECT
);
4254 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4255 pObj
->SetName( aName
);
4256 // the object must be able to call the BASIC
4257 pObj
->SetParent( &rBasic
);
4258 SbxVariable
* pNew
= new SbxVariable
;
4259 pNew
->PutObject( pObj
);
4264 void SbiRuntime::StepDCREATE( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4266 StepDCREATE_IMPL( nOp1
, nOp2
);
4269 void SbiRuntime::StepDCREATE_REDIMP( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4271 StepDCREATE_IMPL( nOp1
, nOp2
);
4275 // Helper function for StepDCREATE_IMPL / bRedimp = true
4276 static void implCopyDimArray_DCREATE( SbxDimArray
* pNewArray
, SbxDimArray
* pOldArray
, short nMaxDimIndex
,
4277 short nActualDim
, sal_Int32
* pActualIndices
, sal_Int32
* pLowerBounds
, sal_Int32
* pUpperBounds
)
4279 sal_Int32
& ri
= pActualIndices
[nActualDim
];
4280 for( ri
= pLowerBounds
[nActualDim
] ; ri
<= pUpperBounds
[nActualDim
] ; ri
++ )
4282 if( nActualDim
< nMaxDimIndex
)
4284 implCopyDimArray_DCREATE( pNewArray
, pOldArray
, nMaxDimIndex
, nActualDim
+ 1,
4285 pActualIndices
, pLowerBounds
, pUpperBounds
);
4289 SbxVariable
* pSource
= pOldArray
->Get32( pActualIndices
);
4290 pNewArray
->Put32( pSource
, pActualIndices
);
4295 // #56204 create object array (+StringID+StringID), DCREATE == Dim-Create
4296 void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4298 SbxVariableRef refVar
= PopVar();
4302 // fill the array with instances of the requested class
4303 SbxBaseRef xObj
= refVar
->GetObject();
4306 StarBASIC::Error( ERRCODE_BASIC_INVALID_OBJECT
);
4310 SbxDimArray
* pArray
= dynamic_cast<SbxDimArray
*>(xObj
.get());
4313 short nDims
= pArray
->GetDims();
4314 sal_Int32 nTotalSize
= 0;
4316 // must be a one-dimensional array
4317 sal_Int32 nLower
, nUpper
;
4318 for( sal_Int32 i
= 0 ; i
< nDims
; ++i
)
4320 pArray
->GetDim32( i
+1, nLower
, nUpper
);
4321 sal_Int32 nSize
= nUpper
- nLower
+ 1;
4328 nTotalSize
*= nSize
;
4332 // create objects and insert them into the array
4333 OUString
aClass( pImg
->GetString( static_cast<short>( nOp2
) ) );
4334 for( sal_Int32 i
= 0 ; i
< nTotalSize
; ++i
)
4336 SbxObject
*pClassObj
= SbxBase::CreateObject( aClass
);
4339 Error( ERRCODE_BASIC_INVALID_OBJECT
);
4344 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4345 pClassObj
->SetName( aName
);
4346 // the object must be able to call the basic
4347 pClassObj
->SetParent( &rBasic
);
4348 pArray
->SbxArray::Put32( pClassObj
, i
);
4353 SbxDimArray
* pOldArray
= static_cast<SbxDimArray
*>(refRedimpArray
.get());
4354 if( pArray
&& pOldArray
)
4356 short nDimsNew
= pArray
->GetDims();
4357 short nDimsOld
= pOldArray
->GetDims();
4358 short nDims
= nDimsNew
;
4359 bool bRangeError
= false;
4361 // Store dims to use them for copying later
4362 std::unique_ptr
<sal_Int32
[]> pLowerBounds(new sal_Int32
[nDims
]);
4363 std::unique_ptr
<sal_Int32
[]> pUpperBounds(new sal_Int32
[nDims
]);
4364 std::unique_ptr
<sal_Int32
[]> pActualIndices(new sal_Int32
[nDims
]);
4365 if( nDimsOld
!= nDimsNew
)
4372 for( short i
= 1 ; i
<= nDims
; i
++ )
4374 sal_Int32 lBoundNew
, uBoundNew
;
4375 sal_Int32 lBoundOld
, uBoundOld
;
4376 pArray
->GetDim32( i
, lBoundNew
, uBoundNew
);
4377 pOldArray
->GetDim32( i
, lBoundOld
, uBoundOld
);
4379 lBoundNew
= std::max( lBoundNew
, lBoundOld
);
4380 uBoundNew
= std::min( uBoundNew
, uBoundOld
);
4382 pActualIndices
[j
] = pLowerBounds
[j
] = lBoundNew
;
4383 pUpperBounds
[j
] = uBoundNew
;
4389 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE
);
4393 // Copy data from old array by going recursively through all dimensions
4394 // (It would be faster to work on the flat internal data array of an
4395 // SbyArray but this solution is clearer and easier)
4396 implCopyDimArray_DCREATE( pArray
, pOldArray
, nDims
- 1,
4397 0, pActualIndices
.get(), pLowerBounds
.get(), pUpperBounds
.get() );
4399 refRedimpArray
= nullptr;
4403 void SbiRuntime::StepTCREATE( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4405 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4406 OUString
aClass( pImg
->GetString( static_cast<short>( nOp2
) ) );
4408 SbxObject
* pCopyObj
= createUserTypeImpl( aClass
);
4411 pCopyObj
->SetName( aName
);
4413 SbxVariable
* pNew
= new SbxVariable
;
4414 pNew
->PutObject( pCopyObj
);
4415 pNew
->SetDeclareClassName( aClass
);
4419 void SbiRuntime::implHandleSbxFlags( SbxVariable
* pVar
, SbxDataType t
, sal_uInt32 nOp2
)
4421 bool bWithEvents
= ((t
& 0xff) == SbxOBJECT
&& (nOp2
& SBX_TYPE_WITH_EVENTS_FLAG
) != 0);
4424 pVar
->SetFlag( SbxFlagBits::WithEvents
);
4426 bool bDimAsNew
= ((nOp2
& SBX_TYPE_DIM_AS_NEW_FLAG
) != 0);
4429 pVar
->SetFlag( SbxFlagBits::DimAsNew
);
4431 bool bFixedString
= ((t
& 0xff) == SbxSTRING
&& (nOp2
& SBX_FIXED_LEN_STRING_FLAG
) != 0);
4434 sal_uInt16 nCount
= static_cast<sal_uInt16
>( nOp2
>> 17 ); // len = all bits above 0x10000
4435 OUStringBuffer aBuf
;
4436 comphelper::string::padToLength(aBuf
, nCount
);
4437 pVar
->PutString(aBuf
.makeStringAndClear());
4440 bool bVarToDim
= ((nOp2
& SBX_TYPE_VAR_TO_DIM_FLAG
) != 0);
4443 pVar
->SetFlag( SbxFlagBits::VarToDim
);
4447 // establishing a local variable (+StringID+type)
4449 void SbiRuntime::StepLOCAL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4451 if( !refLocals
.is() )
4453 refLocals
= new SbxArray
;
4455 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4456 if( refLocals
->Find( aName
, SbxClassType::DontCare
) == nullptr )
4458 SbxDataType t
= static_cast<SbxDataType
>(nOp2
& 0xffff);
4459 SbxVariable
* p
= new SbxVariable( t
);
4460 p
->SetName( aName
);
4461 implHandleSbxFlags( p
, t
, nOp2
);
4462 refLocals
->Put( p
, refLocals
->Count() );
4466 // establishing a module-global variable (+StringID+type)
4468 void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1
, sal_uInt32 nOp2
, bool bUsedForClassModule
)
4470 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4471 SbxDataType t
= static_cast<SbxDataType
>(nOp2
& 0xffff);
4472 bool bFlag
= pMod
->IsSet( SbxFlagBits::NoModify
);
4473 pMod
->SetFlag( SbxFlagBits::NoModify
);
4474 SbxVariableRef p
= pMod
->Find( aName
, SbxClassType::Property
);
4477 pMod
->Remove (p
.get());
4479 SbProperty
* pProp
= pMod
->GetProperty( aName
, t
);
4480 if( !bUsedForClassModule
)
4482 pProp
->SetFlag( SbxFlagBits::Private
);
4486 pMod
->ResetFlag( SbxFlagBits::NoModify
);
4490 pProp
->SetFlag( SbxFlagBits::DontStore
);
4491 // from 2.7.1996: HACK because of 'reference can't be saved'
4492 pProp
->SetFlag( SbxFlagBits::NoModify
);
4494 implHandleSbxFlags( pProp
, t
, nOp2
);
4498 void SbiRuntime::StepPUBLIC( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4500 StepPUBLIC_Impl( nOp1
, nOp2
, false );
4503 void SbiRuntime::StepPUBLIC_P( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4505 // Creates module variable that isn't reinitialised when
4506 // between invocations ( for VBASupport & document basic only )
4507 if( pMod
->pImage
->bFirstInit
)
4509 bool bUsedForClassModule
= pImg
->IsFlag( SbiImageFlags::CLASSMODULE
);
4510 StepPUBLIC_Impl( nOp1
, nOp2
, bUsedForClassModule
);
4514 // establishing a global variable (+StringID+type)
4516 void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4518 if( pImg
->IsFlag( SbiImageFlags::CLASSMODULE
) )
4520 StepPUBLIC_Impl( nOp1
, nOp2
, true );
4522 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4523 SbxDataType t
= static_cast<SbxDataType
>(nOp2
& 0xffff);
4525 // Store module scope variables at module scope
4526 // in non vba mode these are stored at the library level :/
4527 // not sure if this really should not be enabled for ALL basic
4528 SbxObject
* pStorage
= &rBasic
;
4529 if ( SbiRuntime::isVBAEnabled() )
4532 pMod
->AddVarName( aName
);
4535 bool bFlag
= pStorage
->IsSet( SbxFlagBits::NoModify
);
4536 rBasic
.SetFlag( SbxFlagBits::NoModify
);
4537 SbxVariableRef p
= pStorage
->Find( aName
, SbxClassType::Property
);
4540 pStorage
->Remove (p
.get());
4542 p
= pStorage
->Make( aName
, SbxClassType::Property
, t
);
4545 pStorage
->ResetFlag( SbxFlagBits::NoModify
);
4549 p
->SetFlag( SbxFlagBits::DontStore
);
4550 // from 2.7.1996: HACK because of 'reference can't be saved'
4551 p
->SetFlag( SbxFlagBits::NoModify
);
4556 // Creates global variable that isn't reinitialised when
4557 // basic is restarted, P=PERSIST (+StringID+Typ)
4559 void SbiRuntime::StepGLOBAL_P( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4561 if( pMod
->pImage
->bFirstInit
)
4563 StepGLOBAL( nOp1
, nOp2
);
4568 // Searches for global variable, behavior depends on the fact
4569 // if the variable is initialised for the first time
4571 void SbiRuntime::StepFIND_G( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4573 if( pMod
->pImage
->bFirstInit
)
4575 // Behave like always during first init
4576 StepFIND( nOp1
, nOp2
);
4580 // Return dummy variable
4581 SbxDataType t
= static_cast<SbxDataType
>(nOp2
);
4582 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
& 0x7FFF ) ) );
4584 SbxVariable
* pDummyVar
= new SbxVariable( t
);
4585 pDummyVar
->SetName( aName
);
4586 PushVar( pDummyVar
);
4591 SbxVariable
* SbiRuntime::StepSTATIC_Impl(
4592 OUString
const & aName
, SbxDataType t
, sal_uInt32 nOp2
)
4594 SbxVariable
* p
= nullptr;
4597 SbxArray
* pStatics
= pMeth
->GetStatics();
4598 if( pStatics
&& ( pStatics
->Find( aName
, SbxClassType::DontCare
) == nullptr ) )
4600 p
= new SbxVariable( t
);
4601 if( t
!= SbxVARIANT
)
4603 p
->SetFlag( SbxFlagBits::Fixed
);
4605 p
->SetName( aName
);
4606 implHandleSbxFlags( p
, t
, nOp2
);
4607 pStatics
->Put( p
, pStatics
->Count() );
4612 // establishing a static variable (+StringID+type)
4613 void SbiRuntime::StepSTATIC( sal_uInt32 nOp1
, sal_uInt32 nOp2
)
4615 OUString
aName( pImg
->GetString( static_cast<short>( nOp1
) ) );
4616 SbxDataType t
= static_cast<SbxDataType
>(nOp2
& 0xffff);
4617 StepSTATIC_Impl( aName
, t
, nOp2
);
4620 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */