/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */ /* * This file is part of the LibreOffice project. * * This Source Code Form is subject to the terms of the Mozilla Public * License, v. 2.0. If a copy of the MPL was not distributed with this * file, You can obtain one at http://mozilla.org/MPL/2.0/. * * This file incorporates work covered by the following license notice: * * Licensed to the Apache Software Foundation (ASF) under one or more * contributor license agreements. See the NOTICE file distributed * with this work for additional information regarding copyright * ownership. The ASF licenses this file to you under the Apache * License, Version 2.0 (the "License"); you may not use this file * except in compliance with the License. You may obtain a copy of * the License at http://www.apache.org/licenses/LICENSE-2.0 .
*/
&SbiRuntime::StepLIKE,
&SbiRuntime::StepIS, // load/save
&SbiRuntime::StepARGC, // establish new Argv
&SbiRuntime::StepARGV, // TOS ==> current Argv
&SbiRuntime::StepINPUT, // Input ==> TOS
&SbiRuntime::StepLINPUT, // Line Input ==> TOS
&SbiRuntime::StepGET, // touch TOS
&SbiRuntime::StepSET, // save object TOS ==> TOS-1
&SbiRuntime::StepPUT, // TOS ==> TOS-1
&SbiRuntime::StepPUTC, // TOS ==> TOS-1, then ReadOnly
&SbiRuntime::StepDIM, // DIM
&SbiRuntime::StepREDIM, // REDIM
&SbiRuntime::StepREDIMP, // REDIM PRESERVE
&SbiRuntime::StepERASE, // delete TOS // branch
&SbiRuntime::StepSTOP, // program end
&SbiRuntime::StepINITFOR, // initialize FOR-Variable
&SbiRuntime::StepNEXT, // increment FOR-Variable
&SbiRuntime::StepCASE, // beginning CASE
&SbiRuntime::StepENDCASE, // end CASE
&SbiRuntime::StepSTDERROR, // standard error handling
&SbiRuntime::StepNOERROR, // no error handling
&SbiRuntime::StepLEAVE, // leave UP // E/A
&SbiRuntime::StepCHANNEL, // TOS = channel number
&SbiRuntime::StepPRINT, // print TOS
&SbiRuntime::StepPRINTF, // print TOS in field
&SbiRuntime::StepWRITE, // write TOS
&SbiRuntime::StepRENAME, // Rename Tos+1 to Tos
&SbiRuntime::StepPROMPT, // define Input Prompt from TOS
&SbiRuntime::StepRESTART, // Set restart point
&SbiRuntime::StepCHANNEL0, // set E/A-channel 0
&SbiRuntime::StepEMPTY, // empty expression on stack
&SbiRuntime::StepERROR, // TOS = error code
&SbiRuntime::StepLSET, // save object TOS ==> TOS-1
&SbiRuntime::StepRSET, // save object TOS ==> TOS-1
&SbiRuntime::StepREDIMP_ERASE,// Copy array object for REDIMP
&SbiRuntime::StepINITFOREACH,// Init for each loop
&SbiRuntime::StepVBASET,// vba-like set statement
&SbiRuntime::StepERASE_CLEAR,// vba-like set statement
&SbiRuntime::StepARRAYACCESS,// access TOS as array
&SbiRuntime::StepBYVAL, // access TOS as array
};
const SbiRuntime::pStep1 SbiRuntime::aStep1[] = { // all opcodes with one operand
&SbiRuntime::StepLOADNC, // loading a numeric constant (+ID)
&SbiRuntime::StepLOADSC, // loading a string constant (+ID)
&SbiRuntime::StepLOADI, // Immediate Load (+value)
&SbiRuntime::StepARGN, // save a named Args in Argv (+StringID)
&SbiRuntime::StepPAD, // bring string to a definite length (+length) // branches
&SbiRuntime::StepJUMP, // jump (+Target)
&SbiRuntime::StepJUMPT, // evaluate TOS, conditional jump (+Target)
&SbiRuntime::StepJUMPF, // evaluate TOS, conditional jump (+Target)
&SbiRuntime::StepONJUMP, // evaluate TOS, jump into JUMP-table (+MaxVal)
&SbiRuntime::StepGOSUB, // UP-call (+Target)
&SbiRuntime::StepRETURN, // UP-return (+0 or Target)
&SbiRuntime::StepTESTFOR, // check FOR-variable, increment (+Endlabel)
&SbiRuntime::StepCASETO, // Tos+1 <= Case <= Tos), 2xremove (+Target)
&SbiRuntime::StepERRHDL, // error handler (+Offset)
&SbiRuntime::StepRESUME, // resume after errors (+0 or 1 or Label) // E/A
&SbiRuntime::StepCLOSE, // (+channel/0)
&SbiRuntime::StepPRCHAR, // (+char) // management
&SbiRuntime::StepSETCLASS, // check set + class names (+StringId)
&SbiRuntime::StepTESTCLASS, // Check TOS class (+StringId)
&SbiRuntime::StepLIB, // lib for declare-call (+StringId)
&SbiRuntime::StepBASED, // TOS is incremented by BASE, BASE is pushed before
&SbiRuntime::StepARGTYP, // convert last parameter in Argv (+Type)
&SbiRuntime::StepVBASETCLASS,// vba-like set statement
};
const SbiRuntime::pStep2 SbiRuntime::aStep2[] = {// all opcodes with two operands
&SbiRuntime::StepRTL, // load from RTL (+StringID+Typ)
&SbiRuntime::StepFIND, // load (+StringID+Typ)
&SbiRuntime::StepELEM, // load element (+StringID+Typ)
&SbiRuntime::StepPARAM, // Parameter (+Offset+Typ) // branches
&SbiRuntime::StepCALL, // Declare-Call (+StringID+Typ)
&SbiRuntime::StepCALLC, // CDecl-Declare-Call (+StringID+Typ)
&SbiRuntime::StepCASEIS, // Case-Test (+Test-Opcode+False-Target) // management
&SbiRuntime::StepSTMNT, // beginning of a statement (+Line+Col) // E/A
&SbiRuntime::StepOPEN, // (+StreamMode+Flags) // Objects
&SbiRuntime::StepLOCAL, // define local variable (+StringId+Typ)
&SbiRuntime::StepPUBLIC, // module global variable (+StringID+Typ)
&SbiRuntime::StepGLOBAL, // define global variable (+StringID+Typ)
&SbiRuntime::StepCREATE, // create object (+StringId+StringId)
&SbiRuntime::StepSTATIC, // static variable (+StringId+StringId)
&SbiRuntime::StepTCREATE, // user-defined objects (+StringId+StringId)
&SbiRuntime::StepDCREATE, // create object-array (+StringID+StringID)
&SbiRuntime::StepGLOBAL_P, // define global variable which is not overwritten // by the Basic on a restart (+StringID+Typ)
&SbiRuntime::StepFIND_G, // finds global variable with special treatment because of _GLOBAL_P
&SbiRuntime::StepDCREATE_REDIMP, // redimension object array (+StringID+StringID)
&SbiRuntime::StepFIND_CM, // Search inside a class module (CM) to enable global search in time
&SbiRuntime::StepPUBLIC_P, // Search inside a class module (CM) to enable global search in time
&SbiRuntime::StepFIND_STATIC, // Search inside a class module (CM) to enable global search in time
};
// 16.10.96: #31460 new concept for StepInto/Over/Out // The decision whether StepPoint shall be called is done with the help of // the CallLevel. It's stopped when the current CallLevel is <= nBreakCallLvl. // The current CallLevel can never be smaller than 1, as it's also incremented // during the call of a method (also main). Therefore a BreakCallLvl from 0 // means that the program isn't stopped at all. // (also have a look at: step2.cxx, SbiRuntime::StepSTMNT() )
// Several parser methods pass SvNumberFormatter::IsNumberFormat() a number // format index to parse against. Tell the formatter the proper date // evaluation order, which also determines the date acceptance patterns to // use if a format was passed. NF_EVALDATEFORMAT_FORMAT restricts to the // format's locale's date patterns/order (no init/system locale match // tried) and falls back to NF_EVALDATEFORMAT_INTL if no specific (i.e. 0) // (or an unknown) format index was passed.
pNumberFormatter->SetEvalDateFormat( NF_EVALDATEFORMAT_FORMAT);
// the formatter's standard templates have only got a two-digit date // -> registering an own format
// HACK, because the numberformatter doesn't swap the place holders // for month, day and year according to the system setting. // Problem: Print Year(Date) under engl. BS // also have a look at: basic/source/sbx/sbxdate.cxx
// tdf#79426, tdf#125180 - adds the information about a missing parameter void SbiRuntime::SetIsMissing( SbxVariable* pVar )
{
SbxInfo* pInfo = pVar->GetInfo() ? pVar->GetInfo() : new SbxInfo();
pInfo->AddParam( pVar->GetName(), SbxMISSING, pVar->GetFlags() );
pVar->SetInfo( pInfo );
}
// tdf#79426, tdf#125180 - checks if a variable contains the information about a missing parameter bool SbiRuntime::IsMissing( SbxVariable* pVar, sal_uInt16 nIdx )
{ return pVar->GetInfo() && pVar->GetInfo()->GetParam( nIdx ) && pVar->GetInfo()->GetParam( nIdx )->eType & SbxMISSING;
}
// Construction of the parameter list. All ByRef-parameters are directly // taken over; copies of ByVal-parameters are created. If a particular // data type is requested, it is converted.
void SbiRuntime::SetParameters( SbxArray* pParams )
{
refParams = new SbxArray; // for the return value
refParams->Put(pMeth, 0);
// from 13.2.1997, new error handling: // ATTENTION: nError can be set already even if !nErrCode // since nError can now also be set from other RT-instances
if( nError )
{
SbxBase::ResetError();
}
// from 15.3.96: display errors only if BASIC is still active // (especially not after compiler errors at the runtime) if( nError && bRun )
{
ErrCode err = nError;
ClearExprStack();
nError = ERRCODE_NONE;
pInst->nErr = err;
pInst->nErl = nLine;
pErrCode = pCode;
pErrStmnt = pStmnt; // An error occurred in an error handler // force parent handler ( if there is one ) // to handle the error bool bLetParentHandleThis = false;
// in the error handler? so std-error if ( !bInError )
{
bInError = true;
if( !bError ) // On Error Resume Next
{
StepRESUME( 1 );
} elseif( pError ) // On Error Goto ...
{
pCode = pError;
} else
{
bLetParentHandleThis = true;
}
} else
{
bLetParentHandleThis = true;
pError = nullptr; //terminate the handler
} if ( bLetParentHandleThis )
{ // from 13.2.1997, new error handling: // consider superior error handlers
// Not correct for class module usage, remove for now //OSL_WARN_IF( pInst->pRun != this, "basic", "SbiRuntime::Error: can't propagate the error message details!" ); if ( pInst->pRun == this )
{
pInst->Error( _errCode, _details ); //OSL_WARN_IF( nError != _errCode, "basic", "SbiRuntime::Error: the instance is expected to propagate the error code back to me!" );
} else
{
nError = _errCode;
}
}
void SbiRuntime::FatalError( ErrCode n )
{
StepSTDERROR();
Error( n );
}
sal_Int32 SbiRuntime::translateErrorToVba( ErrCode nError, OUString& rMsg )
{ // If a message is defined use that ( in preference to // the defined one for the error ) NB #TODO // if there is an error defined it more than likely // is not the one you want ( some are the same though ) // we really need a new vba compatible error list // tdf#123144 - always translate an error number to a vba error message
StarBASIC::MakeErrorText( nError, rMsg );
rMsg = StarBASIC::GetErrorText(); // no num? most likely then it *is* really a vba err
sal_uInt16 nVBErrorCode = StarBASIC::GetVBErrorCode( nError );
sal_Int32 nVBAErrorNumber = ( nVBErrorCode == 0 ) ? sal_uInt32(nError) : nVBErrorCode; return nVBAErrorNumber;
}
// Stacks
// The expression-stack is available for the continuous evaluation // of expressions.
// Push of the for-stack. The stack has increment, end, begin and variable. // After the creation of the stack-element the stack's empty.
void SbiRuntime::PushFor()
{
SbiForStack* p = new SbiForStack;
p->eForType = ForType::To;
p->pNext = pForStk;
pForStk = p;
p->refInc = PopVar();
p->refEnd = PopVar(); if (isVBAEnabled())
{ // tdf#150458: only calculate these once, coercing to double // tdf#150460: shouldn't we do it in non-VBA / compat mode, too?
SbxVariableRef incCopy(new SbxVariable(SbxDOUBLE));
*incCopy = *p->refInc;
p->refInc = std::move(incCopy);
SbxVariableRef endCopy(new SbxVariable(SbxDOUBLE));
*endCopy = *p->refEnd;
p->refEnd = std::move(endCopy);
}
SbxVariableRef xBgn = PopVar();
p->refVar = PopVar(); // tdf#85371 - grant explicitly write access to the index variable // since it could be the name of a method itself used in the next statement.
ScopedWritableGuard aGuard(p->refVar, p->refVar.get() == pMeth);
*(p->refVar) = *xBgn;
nForLvl++;
}
void SbiRuntime::PushForEach()
{
SbiForStack* p = new SbiForStack; // Set default value in case of error which is ignored in Resume Next
p->eForType = ForType::EachArray;
p->pNext = pForStk;
pForStk = p;
SbxVariableRef xObjVar = PopVar();
SbxBase* pObj(nullptr); if (xObjVar)
{
SbxValues v(SbxVARIANT); // Here it may retrieve the value, and change the type from SbxEMPTY to SbxOBJECT
xObjVar->Get(v); if (v.eType == SbxOBJECT)
pObj = v.pObj;
}
if (SbxDimArray* pArray = dynamic_cast<SbxDimArray*>(pObj))
{
p->refEnd = reinterpret_cast<SbxVariable*>(pArray);
// tdf#144353 - do not compare a missing optional variable if ((p1->GetType() == SbxERROR && SbiRuntime::IsMissing(p1.get(), 1))
|| (p2->GetType() == SbxERROR && SbiRuntime::IsMissing(p2.get(), 1)))
{
SbxBase::SetError(ERRCODE_BASIC_NOT_OPTIONAL); return;
}
// Make sure objects with default params have // values ( and type ) set as appropriate
SbxDataType p1Type = p1->GetType();
SbxDataType p2Type = p2->GetType(); if ( p1Type == SbxEMPTY )
{
p1->Broadcast( SfxHintId::BasicDataWanted );
p1Type = p1->GetType();
} if ( p2Type == SbxEMPTY )
{
p2->Broadcast( SfxHintId::BasicDataWanted );
p2Type = p2->GetType();
} if ( p1Type == p2Type )
{ // if both sides are an object and have default props // then we need to use the default props // we don't need to worry if only one side ( lhs, rhs ) is an // object ( object side will get coerced to correct type in // Compare ) if ( p1Type == SbxOBJECT )
{
SbxVariable* pDflt = getDefaultProp( p1.get() ); if ( pDflt )
{
p1 = pDflt;
p1->Broadcast( SfxHintId::BasicDataWanted );
}
pDflt = getDefaultProp( p2.get() ); if ( pDflt )
{
p2 = pDflt;
p2->Broadcast( SfxHintId::BasicDataWanted );
}
}
} static SbxVariable* pTRUE = nullptr; static SbxVariable* pFALSE = nullptr; // why do this on non-windows ? // why do this at all ? // I dumbly follow the pattern :-/ if ( bVBAEnabled && ( p1->IsNull() || p2->IsNull() ) )
{ static SbxVariable* pNULL = []() {
SbxVariable* p = new SbxVariable;
p->PutNull();
p->AddFirstRef(); return p;
}();
PushVar( pNULL );
} elseif( p2->Compare( eOp, *p1 ) )
{ if( !pTRUE )
{
pTRUE = new SbxVariable;
pTRUE->PutBool( true );
pTRUE->AddFirstRef();
}
PushVar( pTRUE );
} else
{ if( !pFALSE )
{
pFALSE = new SbxVariable;
pFALSE->PutBool( false );
pFALSE->AddFirstRef();
}
PushVar( pFALSE );
}
}
// tdf#144353 - do not assign a missing optional variable to a property if (refVal->GetType() == SbxERROR && SbiRuntime::IsMissing(refVal.get(), 1))
{
SbxBase::SetError(ERRCODE_BASIC_NOT_OPTIONAL); returntrue;
}
if ( eValType != SbxOBJECT ) returnfalse; // we seem to be duplicating parts of SbxValue=operator, maybe we should just move this to // there :-/ not sure if for every '=' we would want struct handling if( eVarType != SbxOBJECT )
{ if ( refVar->IsFixed() ) returnfalse;
} // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure elseif( dynamic_cast<const SbProcedureProperty*>( refVar.get() ) != nullptr ) returnfalse;
SbUnoObject* pUnoVal = dynamic_cast<SbUnoObject*>( xValObj.get() );
SbUnoStructRefObject* pUnoStructVal = dynamic_cast<SbUnoStructRefObject*>( xValObj.get() );
Any aAny; // make doubly sure value is either a Uno object or // a uno struct if ( pUnoVal || pUnoStructVal )
aAny = pUnoVal ? pUnoVal->getUnoAny() : pUnoStructVal->getUnoAny(); else returnfalse; if ( aAny.getValueTypeClass() != TypeClass_STRUCT ) returnfalse;
refVar->SetType( SbxOBJECT );
ErrCode eOldErr = SbxBase::GetError(); // There are some circumstances when calling GetObject // will trigger an error, we need to squash those here. // Alternatively it is possible that the same scenario // could overwrite and existing error. Let's prevent that
SbxObjectRef xVarObj = static_cast<SbxObject*>(refVar->GetObject()); if ( eOldErr != ERRCODE_NONE )
SbxBase::SetError( eOldErr ); else
SbxBase::ResetError();
void SbiRuntime::StepPUT()
{
SbxVariableRef refVal = PopVar();
SbxVariableRef refVar = PopVar(); // store on its own method (inside a function)? bool bFlagsChanged = false;
SbxFlagBits n = SbxFlagBits::NONE; if( refVar.get() == pMeth )
{
bFlagsChanged = true;
n = refVar->GetFlags();
refVar->SetFlag( SbxFlagBits::Write );
}
// if left side arg is an object or variant and right handside isn't // either an object or a variant then try and see if a default // property exists. // to use e.g. Range{"A1") = 34 // could equate to Range("A1").Value = 34 if ( bVBAEnabled )
{ // yet more hacking at this, I feel we don't quite have the correct // heuristics for dealing with obj1 = obj2 ( where obj2 ( and maybe // obj1 ) has default member/property ) ) It seems that default props // aren't dealt with if the object is a member of some parent object bool bObjAssign = false; if ( refVar->GetType() == SbxEMPTY )
refVar->Broadcast( SfxHintId::BasicDataWanted ); if ( refVar->GetType() == SbxOBJECT )
{ if ( dynamic_cast<const SbxMethod *>(refVar.get()) != nullptr || ! refVar->GetParent() )
{
SbxVariable* pDflt = getDefaultProp( refVar.get() );
// VBA Dim As New behavior handling, save init object information struct DimAsNewRecoverItem
{
OUString m_aObjClass;
OUString m_aObjName;
SbxObject* m_pObjParent;
SbModule* m_pClassModule;
void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bHandleDefaultProp )
{ // #67733 types with array-flag are OK too
// Check var, !object is no error for sure if, only if type is fixed
SbxDataType eVarType = refVar->GetType(); if( !bHandleDefaultProp && eVarType != SbxOBJECT && !(eVarType & SbxARRAY) && refVar->IsFixed() )
{
Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); return;
}
// Check value, !object is no error for sure if, only if type is fixed
SbxDataType eValType = refVal->GetType(); if( !bHandleDefaultProp && eValType != SbxOBJECT && !(eValType & SbxARRAY) && refVal->IsFixed() )
{
Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT ); return;
}
// Getting in here causes problems with objects with default properties // if they are SbxEMPTY I guess if ( !bHandleDefaultProp || eValType == SbxOBJECT )
{ // activate GetObject for collections on refVal
SbxBase* pObjVarObj = refVal->GetObject(); if( pObjVarObj )
{
SbxVariableRef refObjVal = dynamic_cast<SbxObject*>( pObjVarObj );
// #52896 refVal can be invalid here, if uno-sequences - or more // general arrays - are assigned to variables that are declared // as an object! if( !refVal.is() )
{
Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
} else
{ bool bFlagsChanged = false;
SbxFlagBits n = SbxFlagBits::NONE; if( refVar.get() == pMeth )
{
bFlagsChanged = true;
n = refVar->GetFlags();
refVar->SetFlag( SbxFlagBits::Write );
}
SbProcedureProperty* pProcProperty = dynamic_cast<SbProcedureProperty*>( refVar.get() ); if( pProcProperty )
{
pProcProperty->setSet( true );
} if ( bHandleDefaultProp )
{ // get default properties for lhs & rhs where necessary // SbxVariable* defaultProp = NULL; unused variable // LHS try determine if a default prop exists // again like in StepPUT (see there too ) we are tweaking the // heuristics again for when to assign an object reference or // use default members if they exist // #FIXME we really need to get to the bottom of this mess bool bObjAssign = false; if ( refVar->GetType() == SbxOBJECT )
{ if ( dynamic_cast<const SbxMethod *>(refVar.get()) != nullptr || ! refVar->GetParent() )
{
SbxVariable* pDflt = getDefaultProp( refVar.get() ); if ( pDflt )
{
refVar = pDflt;
}
} else
bObjAssign = true;
} // RHS only get a default prop is the rhs has one if ( refVal->GetType() == SbxOBJECT )
{ // check if lhs is a null object // if it is then use the object not the default property
SbxObject* pObj = dynamic_cast<SbxObject*>( refVar.get() );
// calling GetObject on a SbxEMPTY variable raises // object not set errors, make sure it's an Object if ( !pObj && refVar->GetType() == SbxOBJECT )
{
SbxBase* pObjVarObj = refVar->GetObject();
pObj = dynamic_cast<SbxObject*>( pObjVarObj );
}
SbxVariable* pDflt = nullptr; if ( pObj && !bObjAssign )
{ // lhs is either a valid object || or has a defaultProp
pDflt = getDefaultProp( refVal.get() );
} if ( pDflt )
{
refVal = pDflt;
}
}
}
// lhs is a property who's value is currently (Empty e.g. no broadcast yet) // in this case if there is a default prop involved the value of the // default property may in fact be void so the type will also be SbxEMPTY // in this case we do not want to call checkUnoStructCopy 'cause that will // cause an error also if ( !checkUnoStructCopy( bHandleDefaultProp, refVal, refVar ) )
{
*refVar = *refVal;
} if ( bDimAsNew )
{ if( dynamic_cast<const SbxObject*>( refVar.get() ) == nullptr )
{
SbxBase* pValObjBase = refVal->GetObject(); if( pValObjBase == nullptr )
{ if( xPrevVarObj.is() )
{ // Object is overwritten with NULL, instantiate init object
DimAsNewRecoverHash::iterator it = gaDimAsNewRecoverHash.find( refVar.get() ); if( it != gaDimAsNewRecoverHash.end() )
{ const DimAsNewRecoverItem& rItem = it->second; if( rItem.m_pClassModule != nullptr )
{
SbClassModuleObject* pNewObj = new SbClassModuleObject(*rItem.m_pClassModule);
pNewObj->SetName( rItem.m_aObjName );
pNewObj->SetParent( rItem.m_pObjParent );
refVar->PutObject( pNewObj );
} elseif( rItem.m_aObjClass.equalsIgnoreAsciiCase( pCollectionStr ) )
{
BasicCollection* pNewCollection = new BasicCollection( pCollectionStr );
pNewCollection->SetName( rItem.m_aObjName );
pNewCollection->SetParent( rItem.m_pObjParent );
refVar->PutObject( pNewCollection );
}
}
}
} else
{ // Does old value exist? bool bFirstInit = !xPrevVarObj.is(); if( bFirstInit )
{ // Store information to instantiate object later
SbxObject* pValObj = dynamic_cast<SbxObject*>( pValObjBase ); if( pValObj != nullptr )
{
OUString aObjClass = pValObj->GetClassName();
// #56204 swap out DIM-functionality into a help method (step0.cxx) void SbiRuntime::DimImpl(const SbxVariableRef& refVar)
{ // If refDim then this DIM statement is terminating a ReDIM and // previous StepERASE_CLEAR for an array, the following actions have // been delayed from ( StepERASE_CLEAR ) 'till here if ( refRedim.is() )
{ if ( !refRedimpArray.is() ) // only erase the array not ReDim Preserve
{
lcl_eraseImpl( refVar, bVBAEnabled );
}
SbxDataType eType = refVar->GetType();
lcl_clearImpl( refVar, eType );
refRedim = nullptr;
}
SbxArray* pDims = refVar->GetParameters(); // must have an even number of arguments // have in mind that Arg[0] does not count! if (pDims && !(pDims->Count() & 1))
{
StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
} else
{
SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT;
SbxDimArray* pArray = new SbxDimArray( eType ); // allow arrays without dimension information, too (VB-compatible) if( pDims )
{
refVar->ResetFlag( SbxFlagBits::VarToDim );
for (sal_uInt32 i = 1; i < pDims->Count();)
{
sal_Int32 lb = pDims->Get(i++)->GetLong();
sal_Int32 ub = pDims->Get(i++)->GetLong(); if( ub < lb )
{
Error( ERRCODE_BASIC_OUT_OF_RANGE );
ub = lb;
}
pArray->AddDim(lb, ub); if ( lb != ub )
{
pArray->setHasFixedSize( true );
}
}
} else
{ // #62867 On creating an array of the length 0, create // a dimension (like for Uno-Sequences of the length 0)
pArray->unoAddDim(0, -1);
}
SbxFlagBits nSavFlags = refVar->GetFlags();
refVar->ResetFlag( SbxFlagBits::Fixed );
refVar->PutObject( pArray );
refVar->SetFlags( nSavFlags );
refVar->SetParameters( nullptr );
}
}
// REDIM // TOS = variable for the array // argv = dimension information
void SbiRuntime::StepREDIM()
{ // Nothing different than dim at the moment because // a double dim is already recognized by the compiler.
StepDIM();
}
// Helper function for StepREDIMP and StepDCREATE_IMPL / bRedimp = true staticvoid implCopyDimArray( SbxDimArray* pNewArray, SbxDimArray* pOldArray, sal_Int32 nMaxDimIndex,
sal_Int32 nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
{
sal_Int32& ri = pActualIndices[nActualDim]; for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ )
{ if( nActualDim < nMaxDimIndex )
{
implCopyDimArray( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
pActualIndices, pLowerBounds, pUpperBounds );
} else
{
SbxVariable* pSource = pOldArray->Get(pActualIndices); if (pSource && pOldArray->GetRefCount() > 1) // tdf#134692: old array will stay alive after the redim - we need to copy deep
pSource = new SbxVariable(*pSource);
pNewArray->Put(pSource, pActualIndices);
}
}
}
if (nDimsOld != nDimsNew)
{
StarBASIC::Error(ERRCODE_BASIC_OUT_OF_RANGE); if (pbWasError)
*pbWasError = true;
} elseif (nDimsNew > 0)
{ // Store dims to use them for copying later
std::unique_ptr<sal_Int32[]> pLowerBounds(new sal_Int32[nDimsNew]);
std::unique_ptr<sal_Int32[]> pUpperBounds(new sal_Int32[nDimsNew]);
std::unique_ptr<sal_Int32[]> pActualIndices(new sal_Int32[nDimsNew]); bool bNeedsPreallocation = true;
// Compare bounds for (sal_Int32 i = 1; i <= nDimsNew; i++)
{
sal_Int32 lBoundNew, uBoundNew;
sal_Int32 lBoundOld, uBoundOld;
pNewArray->GetDim(i, lBoundNew, uBoundNew);
pOldArray->GetDim(i, lBoundOld, uBoundOld);
lBoundNew = std::max(lBoundNew, lBoundOld);
uBoundNew = std::min(uBoundNew, uBoundOld);
sal_Int32 j = i - 1;
pActualIndices[j] = pLowerBounds[j] = lBoundNew;
pUpperBounds[j] = uBoundNew; if (lBoundNew > uBoundNew) // No elements in the dimension -> no elements to restore
bNeedsPreallocation = false;
}
// Optimization: pre-allocate underlying container if (bNeedsPreallocation)
pNewArray->Put(nullptr, pUpperBounds.get());
// Copy data from old array by going recursively through all dimensions // (It would be faster to work on the flat internal data array of an // SbyArray but this solution is clearer and easier)
implCopyDimArray(pNewArray, pOldArray, nDimsNew - 1, 0, pActualIndices.get(),
pLowerBounds.get(), pUpperBounds.get());
bResult = true;
}
rrefRedimpArray.clear();
} return bResult;
}
// REDIM PRESERVE // TOS = variable for the array // argv = dimension information
// Now check, if we can copy from the old array if( refRedimpArray.is() )
{ if (SbxDimArray* pNewArray = dynamic_cast<SbxDimArray*>(refVar->GetObject()))
implRestorePreservedArray(pNewArray, refRedimpArray);
}
}
// REDIM_COPY // TOS = Array-Variable, Reference to array is copied // Variable is cleared as in ERASE
staticvoid lcl_eraseImpl( SbxVariableRef const & refVar, bool bVBAEnabled )
{
SbxDataType eType = refVar->GetType(); if( eType & SbxARRAY )
{ if ( bVBAEnabled )
{
SbxBase* pElemObj = refVar->GetObject();
SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj ); if( pDimArray )
{ if ( pDimArray->hasFixedSize() )
{ // Clear all Value(s)
pDimArray->SbxArray::Clear();
} else
{
pDimArray->Clear(); // clear dims and values
}
} else
{
SbxArray* pArray = dynamic_cast<SbxArray*>( pElemObj ); if ( pArray )
{
pArray->Clear();
}
}
} else
{ // Arrays have on an erase to VB quite a complex behaviour. Here are // only the type problems at REDIM (#26295) removed at first: // Set type hard onto the array-type, because a variable with array is // SbxOBJECT. At REDIM there's an SbxOBJECT-array generated then and // the original type is lost -> runtime error
lcl_clearImpl( refVar, eType );
}
} elseif( refVar->IsFixed() )
{
refVar->Clear();
} else
{
refVar->SetType( SbxEMPTY );
}
}
void SbiRuntime::StepNEXT()
{ if( !pForStk )
{
StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); return;
} if (pForStk->eForType != ForType::To) return; if (!pForStk->refVar)
{
StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); return;
} // tdf#85371 - grant explicitly write access to the index variable // since it could be the name of a method itself used in the next statement.
ScopedWritableGuard aGuard(pForStk->refVar, pForStk->refVar.get() == pMeth);
pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc );
}
void SbiRuntime::StepLEAVE()
{
bRun = false; // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed ) if ( bInError && pError )
{
SbxErrObject::getUnoErrObject()->Clear();
}
}
void SbiRuntime::StepCHANNEL() // TOS = channel number
{
SbxVariableRef pChan = PopVar(); short nChan = pChan->GetInteger();
pIosys->SetChannel( nChan );
Error( pIosys->GetError() );
}
void SbiRuntime::StepPRINT() // print TOS
{
SbxVariableRef p = PopVar();
OUString s1 = p->GetOUString();
OUString s; if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
{
s = " "; // one blank before
}
s += s1;
pIosys->Write( s );
Error( pIosys->GetError() );
}
void SbiRuntime::StepPRINTF() // print TOS in field
{
SbxVariableRef p = PopVar();
OUString s1 = p->GetOUString();
OUStringBuffer s; if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
{
s.append(' ');
}
s.append(s1);
comphelper::string::padToLength(s, 14, ' ');
pIosys->Write( s );
Error( pIosys->GetError() );
}
void SbiRuntime::StepWRITE() // write TOS
{
SbxVariableRef p = PopVar(); // Does the string have to be encapsulated? char ch = 0; switch (p->GetType() )
{ case SbxSTRING: ch = '"'; break; case SbxCURRENCY: case SbxBOOL: case SbxDATE: ch = '#'; break; default: break;
}
OUString s; if( ch )
{
s += OUStringChar(ch);
}
s += p->GetOUString(); if( ch )
{
s += OUStringChar(ch);
}
pIosys->Write( s );
Error( pIosys->GetError() );
}
// empty expression on stack for missing parameter
void SbiRuntime::StepEMPTY()
{ // #57915 The semantics of StepEMPTY() is the representation of a missing argument. // This is represented by the value 448 (ERRCODE_BASIC_NAMED_NOT_FOUND) of the type error // in VB. StepEmpty should now rather be named StepMISSING() but the name is kept // to simplify matters.
SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
xVar->PutErr( 448 ); // tdf#79426, tdf#125180 - add additional information about a missing parameter
SetIsMissing( xVar.get() );
PushVar( xVar.get() );
}
// loading a numeric constant (+ID) // See also: SbiImage::GetString void SbiRuntime::StepLOADNC( sal_uInt32 nOp1 )
{ // tdf#143707 - check if the data type character was added after the string termination symbol
SbxDataType eTypeStr; // #57844 use localized function
OUString aStr = pImg->GetString(nOp1, &eTypeStr); // also allow , !!!
sal_Int32 iComma = aStr.indexOf(','); if( iComma >= 0 )
{
aStr = aStr.replaceAt(iComma, 1, u".");
}
sal_Int32 nParseEnd = 0;
rtl_math_ConversionStatus eStatus = rtl_math_ConversionStatus_Ok; double n = ::rtl::math::stringToDouble( aStr, '.', ',', &eStatus, &nParseEnd );
// tdf#131296 - retrieve data type put in SbiExprNode::Gen
SbxDataType eType = SbxDOUBLE; if ( nParseEnd < aStr.getLength() )
{ // tdf#143707 - Check if there was a data type character after the numeric constant, // added by older versions of the fix of the default values for strings. switch ( aStr[nParseEnd] )
{ // See GetSuffixType in basic/source/comp/scanner.cxx for type characters case'%': eType = SbxINTEGER; break; case'&': eType = SbxLONG; break; case'!': eType = SbxSINGLE; break; case'@': eType = SbxCURRENCY; break; // tdf#142460 - properly handle boolean values in string pool case'b': eType = SbxBOOL; break; // tdf#168569 - support date values in string pool case'd': eType = SbxDATE; break; // Not in GetSuffixType
}
} // tdf#143707 - if the data type character is different from the default value, it was added // in basic/source/comp/symtbl.cxx. Hence, change the type of the numeric constant to be loaded. elseif (eTypeStr != SbxSTRING)
{
eType = eTypeStr;
}
SbxVariable* p = new SbxVariable( eType );
p->PutDouble( n ); // tdf#133913 - create variable with Variant/Type in order to prevent type conversion errors
p->ResetFlag( SbxFlagBits::Fixed );
PushVar( p );
}
// loading a string constant (+ID)
void SbiRuntime::StepLOADSC( sal_uInt32 nOp1 )
{
SbxVariable* p = new SbxVariable;
p->PutString( pImg->GetString( nOp1 ) );
PushVar( p );
}
// Immediate Load (+value) // The opcode is not generated in SbiExprNode::Gen anymore; used for legacy images
void SbiRuntime::StepLOADI( sal_uInt32 nOp1 )
{
SbxVariable* p = new SbxVariable;
p->PutInteger( static_cast<sal_Int16>( nOp1 ) );
PushVar( p );
}
// store a named argument in Argv (+Arg-no. from 1!)
void SbiRuntime::StepARGN( sal_uInt32 nOp1 )
{ if( !refArgv.is() )
StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR ); else
{
OUString aAlias( pImg->GetString( nOp1 ) );
SbxVariableRef pVal = PopVar(); if( bVBAEnabled &&
( dynamic_cast<const SbxMethod*>( pVal.get()) != nullptr
|| dynamic_cast<const SbUnoProperty*>( pVal.get()) != nullptr
|| dynamic_cast<const SbProcedureProperty*>( pVal.get()) != nullptr ) )
{ // named variables ( that are Any especially properties ) can be empty at this point and need a broadcast if ( pVal->GetType() == SbxEMPTY )
pVal->Broadcast( SfxHintId::BasicDataWanted ); // evaluate methods and properties!
SbxVariable* pRes = new SbxVariable( *pVal );
pVal = pRes;
}
refArgv->Put(pVal.get(), nArgc);
refArgv->PutAlias(aAlias, nArgc++);
}
}
// converting the type of an argument in Argv for DECLARE-Fkt. (+type)
OUStringBuffer aBuf(s); if (aBuf.getLength() > nLen)
{
comphelper::string::truncateToLength(aBuf, nLen);
} else
{
comphelper::string::padToLength(aBuf, nLen, ' ');
}
s = aBuf.makeStringAndClear(); // Do not modify the original variable inadvertently
PopVar();
p = new SbxVariable;
p->PutString(s);
PushVar(p);
}
bool SbiRuntime::EvaluateTopOfStackAsBool()
{
SbxVariableRef tos = PopVar(); // In a test e.g. If Null then // will evaluate Null will act as if False if ( bVBAEnabled && tos->IsNull() )
{ returnfalse;
}
// tdf#151503 - do not evaluate a missing optional variable to a boolean if (tos->GetType() == SbxERROR && IsMissing(tos.get(), 1))
{
Error(ERRCODE_BASIC_NOT_OPTIONAL); returnfalse;
}
if ( tos->IsObject() )
{ //GetBool applied to an Object attempts to dereference and evaluate //the underlying value as Bool. Here, we're checking rather that //it is not null return tos->GetObject();
} else
{ return tos->GetBool();
}
}
// evaluate TOS, jump into JUMP-table (+MaxVal) // looks like this: // ONJUMP 2 // JUMP target1 // JUMP target2
// if 0x8000 is set in the operand, push the return address (ON..GOSUB)
void SbiRuntime::StepONJUMP( sal_uInt32 nOp1 )
{
SbxVariableRef p = PopVar();
sal_Int16 n = p->GetInteger();
if (nOp1 & 0x8000)
nOp1 &= 0x7FFF;
// tdf#160321 - do not execute the jump statement if the expression is out of range if (n < 1 || o3tl::make_unsigned(n) > nOp1)
n = static_cast<sal_Int16>(nOp1 + 1); elseif (nOp1 & 0x8000)
PushGosub(pCode + 5 * nOp1);
SbxDataType t = refVal->GetType();
SbxVariable* pVal = refVal.get(); // we don't know the type of uno properties that are (maybevoid) if ( t == SbxEMPTY )
{ if ( auto pProp = dynamic_cast<SbUnoProperty*>( refVal.get() ) )
{
t = pProp->getRealType();
}
} if( t == SbxOBJECT || bVBAEnabled )
{
SbxObject* pObj = dynamic_cast<SbxObject*>(pVal); if (!pObj)
{
pObj = dynamic_cast<SbxObject*>(refVal->GetObject());
} if( pObj )
{ if( !implIsClass( pObj, aClass ) )
{
SbUnoObject* pUnoObj(nullptr); if (bVBAEnabled || CodeCompleteOptions::IsExtendedTypeDeclaration())
{
pUnoObj = dynamic_cast<SbUnoObject*>(pObj);
}
if (pUnoObj)
bOk = checkUnoObjectType(*pUnoObj, aClass); else
bOk = false; if ( !bOk && bRaiseErrors )
Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
} else
{
bOk = true;
bool bOk = checkClass_Impl( refVal, aClass, true, true ); if( bOk )
{
StepSET_Impl( refVal, refVar, bHandleDflt ); // don't do handle default prop for a "proper" set
}
}
// TOS is incremented by BASE, BASE is pushed before (+BASE) // This opcode is pushed before DIM/REDIM-commands, // if there's been only one index named.
// #109275 Check compatibility mode bool bCompatible = ((nOp1 & 0x8000) != 0);
sal_uInt16 uBase = static_cast<sal_uInt16>(nOp1 & 1); // Can only be 0 or 1
p1->PutInteger( uBase ); if( !bCompatible )
{ // tdf#85371 - grant explicitly write access to the dimension variable // since in Star/OpenOffice Basic the upper index border is affected, // and the dimension variable could be the name of the method itself.
ScopedWritableGuard aGuard(x2, x2.get() == pMeth);
x2->Compute( SbxPLUS, *p1 );
}
PushVar( x2.get() ); // first the Expr
PushVar( p1 ); // then the Base
}
// the bits in the String-ID: // 0x8000 - Argv is reserved
// #110004, #112015: Make private really private if( bLocal && pElem ) // Local as flag for global search
{ if( pElem->IsSet( SbxFlagBits::Private ) )
{
SbiInstance* pInst_ = GetSbData()->pInst; if( pInst_ && pInst_->IsCompatibility() && pObj != pElem->GetParent() )
{
pElem = nullptr; // Found but in wrong module!
} // Interfaces: Use SbxFlagBits::ExtFound
}
}
rBasic.bNoRtl = bSave;
// is it a global uno-identifier? if( bLocal && !pElem )
{ bool bSetName = true; // preserve normal behaviour
// i#i68894# if VBAInterOp favour searching vba globals // over searching for uno classes if ( bVBAEnabled )
{ // Try Find in VBA symbols space
pElem = rBasic.VBAFind( aName, SbxClassType::DontCare ); if ( pElem )
{
bSetName = false; // don't overwrite uno name
} else
{
pElem = VBAConstantHelper::instance().getVBAConstant( aName );
}
}
if( !pElem )
{ // #72382 ATTENTION! ALWAYS returns a result now // because of unknown modules!
SbUnoClass* pUnoClass = findUnoClass( aName ); if( pUnoClass )
{
pElem = new SbxVariable( t );
SbxValues aRes( SbxOBJECT );
aRes.pObj = pUnoClass;
pElem->SbxVariable::Put( aRes );
}
}
// #62939 If a uno-class has been found, the wrapper // object has to be held, because the uno-class, e. g. // "stardiv", has to be read out of the registry // every time again otherwise if( pElem )
{ // #63774 May not be saved too!!!
pElem->SetFlag( SbxFlagBits::DontStore );
pElem->SetFlag( SbxFlagBits::NoModify);
// #72382 save locally, all variables that have been declared // implicit would become global automatically otherwise! if ( bSetName )
{
pElem->SetName( aName );
}
refLocals->Put(pElem, refLocals->Count());
}
}
if( !pElem )
{ // not there and not in the object? // don't establish if that thing has parameters! if( nOp1 & 0x8000 )
{
bFatalError = true;
}
// else, if there are parameters, use different error code if( !bLocal || pImg->IsFlag( SbiImageFlags::EXPLICIT ) )
{ // #39108 if explicit and as ELEM always a fatal error
bFatalError = true;
Error( nNotFound, aName );
} else
{ if ( bStatic )
{
pElem = StepSTATIC_Impl( aName, t, 0 );
} if ( !pElem )
{
pElem = new SbxVariable( t ); if( t != SbxVARIANT )
{
pElem->SetFlag( SbxFlagBits::Fixed );
}
pElem->SetName( aName );
refLocals->Put(pElem, refLocals->Count());
}
}
}
} // #39108 Args can already be deleted! if( !bFatalError )
{
SetupArgs( pElem, nOp1 );
} // because a particular call-type is requested if (SbxMethod* pMethod = dynamic_cast<SbxMethod*>(pElem))
{ // shall the type be converted?
SbxDataType t2 = pElem->GetType(); bool bSet = false; if( (pElem->GetFlags() & SbxFlagBits::Fixed) == SbxFlagBits::NONE )
{ if( t != SbxVARIANT && t != t2 &&
t >= SbxINTEGER && t <= SbxSTRING )
{
pElem->SetType( t );
bSet = true;
}
} // assign pElem to a Ref, to delete a temp-var if applicable
SbxVariableRef xDeleteRef = pElem;
// remove potential rests of the last call of the SbxMethod // free Write before, so that there's no error
SbxFlagBits nSavFlags = pElem->GetFlags();
pElem->SetFlag( SbxFlagBits::ReadWrite | SbxFlagBits::NoBroadcast );
pElem->SbxValue::Clear();
pElem->SetFlags( nSavFlags );
// don't touch before setting, as e. g. LEFT() // has to know the difference between Left$() and Left()
// because the methods' parameters are cut away in PopVar()
SbxVariable* pNew = new SbxMethod(*pMethod); //OLD: SbxVariable* pNew = new SbxVariable( *pElem );
if( bSet )
{
pElem->SetType( t2 );
}
pElem = pNew;
} // consider index-access for UnoObjects // definitely we want this for VBA where properties are often // collections ( which need index access ), but let's only do // this if we actually have params following elseif( bVBAEnabled && dynamic_cast<const SbUnoProperty*>( pElem) != nullptr && pElem->GetParameters() )
{
SbxVariableRef xDeleteRef = pElem;
// dissolve the notify while copying variable
SbxVariable* pNew = new SbxVariable( *pElem );
pElem->SetParameters( nullptr );
pElem = pNew;
}
} return CheckArray( pElem );
}
// for current scope (e. g. query from BASIC-IDE)
SbxBase* SbiRuntime::FindElementExtern( const OUString& rName )
{ // don't expect pMeth to be != 0, as there are none set // in the RunInit yet
SbxVariable* pElem = nullptr; if( !pMod || rName.isEmpty() )
{ return nullptr;
} if( refLocals.is() )
{
pElem = refLocals->Find( rName, SbxClassType::DontCare );
} if ( !pElem && pMeth )
{ const OUString aMethName = pMeth->GetName(); // tdf#57308 - check if the name is the current method instance if (pMeth->GetName() == rName)
{
pElem = pMeth;
} else
{ // for statics, set the method's name in front
pElem = pMod->Find(aMethName + ":" + rName, SbxClassType::DontCare);
}
}
SbxVariable* SbiRuntime::CheckArray( SbxVariable* pElem )
{
assert(pElem);
SbxArray* pPar; if( ( pElem->GetType() & SbxARRAY ) && refRedim.get() != pElem )
{
SbxBase* pElemObj = pElem->GetObject();
SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj );
pPar = pElem->GetParameters(); if( pDimArray )
{ // parameters may be missing, if an array is // passed as an argument if( pPar )
{ bool parIsArrayIndex = true; if (dynamic_cast<const SbxMethod*>(pElem))
{ // If this was a method, then there are two possibilities: // 1. pPar is this method's parameters. // 2. pPar is the indexes into the array returned from the method. // To disambiguate, check the 0th element of pPar. if (dynamic_cast<const SbxMethod*>(pPar->Get(0)))
{ // pPar was the parameters to the method, not indexes into the array
parIsArrayIndex = false;
}
} if (parIsArrayIndex)
pElem = pDimArray->Get(pPar);
}
} else
{
SbxArray* pArray = dynamic_cast<SbxArray*>( pElemObj ); if( pArray )
{ if( !pPar )
{
Error( ERRCODE_BASIC_OUT_OF_RANGE );
pElem = new SbxVariable;
} else
{
pElem = pArray->Get(pPar->Get(1)->GetInteger());
}
}
}
// #42940, set parameter 0 to NULL so that var doesn't contain itself if( pPar )
{
pPar->Put(nullptr, 0);
}
} // consider index-access for UnoObjects elseif( pElem->GetType() == SbxOBJECT && dynamic_cast<const SbxMethod*>( pElem) == nullptr &&
( !bVBAEnabled || dynamic_cast<const SbxProperty*>( pElem) == nullptr ) )
{
pPar = pElem->GetParameters(); if ( pPar )
{ // is it a uno-object?
SbxBaseRef pObj = pElem->GetObject(); if( pObj.is() )
{ if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj.get()))
{
Any aAny = pUnoObj->getUnoAny();
// get index
sal_Int32 nIndex = pPar->Get(1)->GetLong();
Reference< XInterface > xRet; try
{
Any aAny2 = xIndexAccess->getByIndex( nIndex );
aAny2 >>= xRet;
} catch (const IndexOutOfBoundsException&)
{ // usually expect converting problem
StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
}
// #57847 always create a new variable, else error // due to PutObject(NULL) at ReadOnly-properties
pElem = new SbxVariable( SbxVARIANT ); if( xRet.is() )
{
aAny <<= xRet;
// #67173 don't specify a name so that the real class name is entered
SbxObjectRef xWrapper = static_cast<SbxObject*>(new SbUnoObject( OUString(), aAny ));
pElem->PutObject( xWrapper.get() );
} else
{
pElem->PutObject( nullptr );
}
}
} else
{ // check if there isn't a default member between the current variable // and the params, e.g. // Dim rst1 As New ADODB.Recordset // " // val = rst1("FirstName") // has the default 'Fields' member between rst1 and '("FirstName")'
Any x = aAny;
SbxVariable* pDflt = getDefaultProp( pElem ); if ( pDflt )
{
pDflt->Broadcast( SfxHintId::BasicDataWanted );
SbxBaseRef pDfltObj = pDflt->GetObject(); if( pDfltObj.is() )
{ if (SbUnoObject* pSbObj = dynamic_cast<SbUnoObject*>(pDfltObj.get()))
{
pUnoObj = pSbObj;
Any aUnoAny = pUnoObj->getUnoAny();
// #56368 save reference at StepElem, otherwise objects could // lose their reference too early in qualification chains like // ActiveComponent.Selection(0).Text // #74254 now per list if( pObj )
{
aRefSaved.emplace_back(pObj );
}
PushVar( FindElement( pObj, nOp1, nOp2, ERRCODE_BASIC_NO_METHOD, false ) );
}
/** Loading of a parameter (+offset+type) If the data type is wrong, create a copy and search for optionals including the default value. The data type SbxEMPTY shows that no parameters are given. Get( 0 ) may be EMPTY
@param nOp1 the index of the current parameter being processed, where the entry of the index 0 is for the return value.
@param nOp2 the data type of the parameter.
*/ void SbiRuntime::StepPARAM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{
sal_uInt16 nIdx = static_cast<sal_uInt16>( nOp1 & 0x7FFF );
SbxDataType eType = static_cast<SbxDataType>(nOp2);
SbxVariable* pVar;
// #57915 solve missing in a cleaner way
sal_uInt32 nParamCount = refParams->Count(); if( nIdx >= nParamCount )
{
sal_uInt16 iLoop = nIdx; while( iLoop >= nParamCount )
{
pVar = new SbxVariable();
pVar->PutErr( 448 ); // like in VB: Error-Code 448 (ERRCODE_BASIC_NAMED_NOT_FOUND) // tdf#79426, tdf#125180 - add additional information about a missing parameter
SetIsMissing( pVar );
refParams->Put(pVar, iLoop);
iLoop--;
}
}
pVar = refParams->Get(nIdx);
// tdf#79426, tdf#125180 - check for optionals only if the parameter is actually missing if( pVar->GetType() == SbxERROR && IsMissing( pVar, 1 ) && nIdx )
{ // if there's a parameter missing, it can be OPTIONAL bool bOpt = false; if( pMeth )
{
SbxInfo* pInfo = pMeth->GetInfo(); if ( pInfo )
{ const SbxParamInfo* pParam = pInfo->GetParam( nIdx ); if( pParam && ( pParam->nFlags & SbxFlagBits::Optional ) )
{ // tdf#136143 - reset SbxFlagBits::Fixed in order to prevent type conversion errors
pVar->ResetFlag( SbxFlagBits::Fixed ); // Default value?
sal_uInt16 nDefaultId = static_cast<sal_uInt16>(pParam->nUserData & 0x0ffff); if( nDefaultId > 0 )
{ // tdf#143707 - check if the data type character was added after the string // termination symbol, and convert the variable if it was present. The // data type character was added in basic/source/comp/symtbl.cxx.
SbxDataType eTypeStr;
OUString aDefaultStr = pImg->GetString( nDefaultId, &eTypeStr );
pVar = new SbxVariable(pParam-> eType);
pVar->PutString( aDefaultStr ); if (eTypeStr != SbxSTRING)
pVar->Convert(eTypeStr);
refParams->Put(pVar, nIdx);
} elseif ( SbiRuntime::isVBAEnabled() && eType != SbxVARIANT )
{ // tdf#36737 - initialize the parameter with the default value of its type
pVar = new SbxVariable( pParam->eType );
refParams->Put(pVar, nIdx);
}
bOpt = true;
}
}
} if( !bOpt )
{
Error( ERRCODE_BASIC_NOT_OPTIONAL );
}
} elseif( eType != SbxVARIANT && static_cast<SbxDataType>(pVar->GetType() & 0x0FFF ) != eType )
{ // tdf#43003 - convert parameter to the requested type
pVar->Convert(eType);
}
SetupArgs( pVar, nOp1 );
PushVar( CheckArray( pVar ) );
}
void SbiRuntime::StepSTMNT( sal_uInt32 nOp1, sal_uInt32 nOp2 )
{ // If the Expr-Stack at the beginning of a statement contains a variable, // some fool has called X as a function, although it's a variable! bool bFatalExpr = false;
OUString sUnknownMethodName; if( nExprLvl > 1 )
{
bFatalExpr = true;
} elseif( nExprLvl )
{
SbxVariable* p = refExprStk->Get(0); if( p->GetRefCount() > 1 &&
refLocals.is() && refLocals->Find( p->GetName(), p->GetClass() ) )
{
sUnknownMethodName = p->GetName();
bFatalExpr = true;
}
}
ClearExprStack();
aRefSaved.clear();
// We have to cancel hard here because line and column // would be wrong later otherwise! if( bFatalExpr)
{
StarBASIC::FatalError( ERRCODE_BASIC_NO_METHOD, sUnknownMethodName ); return;
}
pStmnt = pCode - 9;
sal_uInt16 nOld = nLine;
nLine = static_cast<short>( nOp1 );
// #29955 & 0xFF, to filter out for-loop-level
nCol1 = static_cast<short>( nOp2 & 0xFF );
// find the next STMNT-command to set the final column // of this statement
// #29955 correct for-loop-level, #67452 NOT in the error-handler if( !bInError )
{ // (there's a difference here in case of a jump out of a loop)
sal_uInt16 nExpectedForLevel = static_cast<sal_uInt16>( nOp2 / 0x100 ); if( !pGosubStk.empty() )
{
nExpectedForLevel = nExpectedForLevel + pGosubStk.back().nStartForLvl;
}
// if the actual for-level is too small it'd jump out // of a loop -> corrected while( nForLvl > nExpectedForLevel )
{
PopFor();
}
}
// 16.10.96: #31460 new concept for StepInto/Over/Out // see explanation at SbiInstance::CalcBreakCallLevel if( pInst->nCallLvl <= pInst->nBreakCallLvl )
{
StarBASIC* pStepBasic = GetCurrentBasic( &rBasic );
BasicDebugFlags nNewFlags = pStepBasic->StepPoint( nLine, nCol1, nCol2 );
pInst->CalcBreakCallLevel( nNewFlags );
}
// break points only at STMNT-commands in a new line! elseif( ( nOp1 != nOld )
&& ( nFlags & BasicDebugFlags::Break )
&& pMod->IsBP( static_cast<sal_uInt16>( nOp1 ) ) )
{
StarBASIC* pBreakBasic = GetCurrentBasic( &rBasic );
BasicDebugFlags nNewFlags = pBreakBasic->BreakPoint( nLine, nCol1, nCol2 );
pInst->CalcBreakCallLevel( nNewFlags );
}
}
// (+StreamMode+Flags) // Stack: block length // channel number // file name
// fill the array with instances of the requested class
SbxBase* pObj = refVar->GetObject(); if (!pObj)
{
StarBASIC::Error( ERRCODE_BASIC_INVALID_OBJECT ); return;
}
SbxDimArray* pArray = dynamic_cast<SbxDimArray*>(pObj); if (!pArray) return;
// First, fill those parts of the array that are preserved bool bWasError = false; constbool bRestored = implRestorePreservedArray(pArray, refRedimpArray, &bWasError); if (bWasError)
nTotalSize = 0; // on error, don't create objects
// create objects and insert them into the array
OUString aClass( pImg->GetString( nOp2 ) );
OUString aName; for( sal_Int32 i = 0 ; i < nTotalSize ; ++i )
{ if (!bRestored || !pArray->SbxArray::GetRef(i)) // For those left unset after preserve
{
SbxObjectRef pClassObj = SbxBase::CreateObject(aClass); if (!pClassObj)
{
Error(ERRCODE_BASIC_INVALID_OBJECT); break;
} else
{ if (aName.isEmpty())
aName = pImg->GetString(nOp1);
pClassObj->SetName(aName); // the object must be able to call the basic
pClassObj->SetParent(&rBasic);
pArray->SbxArray::Put(pClassObj.get(), i);
}
}
}
}
// Store module scope variables at module scope // in non vba mode these are stored at the library level :/ // not sure if this really should not be enabled for ALL basic
SbxObject* pStorage = &rBasic; if ( SbiRuntime::isVBAEnabled() )
{
pStorage = pMod;
pMod->AddVarName( aName );
}
bool bFlag = pStorage->IsSet( SbxFlagBits::NoModify );
rBasic.SetFlag( SbxFlagBits::NoModify );
SbxVariableRef p = pStorage->Find( aName, SbxClassType::Property ); if( p.is() )
{
pStorage->Remove (p.get());
}
p = pStorage->Make( aName, SbxClassType::Property, t ); if( !bFlag )
{
pStorage->ResetFlag( SbxFlagBits::NoModify );
} if( p.is() )
{
p->SetFlag( SbxFlagBits::DontStore ); // from 2.7.1996: HACK because of 'reference can't be saved'
p->SetFlag( SbxFlagBits::NoModify);
}
}
// Creates global variable that isn't reinitialised when // basic is restarted, P=PERSIST (+StringID+Typ)
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung und die Messung sind noch experimentell.