basic/source/comp/dim.cxx

   1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
   2 /*
   3  * This file is part of the LibreOffice project.
   4  *
   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/.
   8  *
   9  * This file incorporates work covered by the following license notice:
  10  *
  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 .
  18  */
  19
  20 #include <basic/sbx.hxx>
  21 #include "sbcomp.hxx"
  22 #include "sbunoobj.hxx"
  23
  24
  25 SbxObject* cloneTypeObjectImpl( const SbxObject& rTypeObj );
  26
  27 // Declaration of a variable
  28 // If there are errors it will be parsed up to the comma or the newline.
  29 // Return-value: a new instance, which were inserted and then deleted.
  30 // Array-Indexex were returned as SbiDimList
  31
  32 SbiSymDef* SbiParser::VarDecl( SbiDimList** ppDim, bool bStatic, bool bConst )
  33 {
  34     bool bWithEvents = false;
  35     if( Peek() == WITHEVENTS )
  36     {
  37         Next();
  38         bWithEvents = true;
  39     }
  40     if( !TestSymbol() ) return NULL;
  41     SbxDataType t = eScanType;
  42     SbiSymDef* pDef = bConst ? new SbiConstDef( aSym ) : new SbiSymDef( aSym );
  43     SbiDimList* pDim = NULL;
  44     // Brackets?
  45     if( Peek() == LPAREN )
  46     {
  47         pDim = new SbiDimList( this );
  48         if( !pDim->GetDims() )
  49             pDef->SetWithBrackets();
  50     }
  51     pDef->SetType( t );
  52     if( bStatic )
  53         pDef->SetStatic();
  54     if( bWithEvents )
  55         pDef->SetWithEvents();
  56     TypeDecl( *pDef );
  57     if( !ppDim && pDim )
  58     {
  59         if(pDim->GetDims() )
  60             Error( SbERR_EXPECTED, "()" );
  61         delete pDim;
  62     }
  63     else if( ppDim )
  64         *ppDim = pDim;
  65     return pDef;
  66 }
  67
  68 // Resolving of a AS-Type-Declaration
  69 // The data type were inserted into the handed over variable
  70
  71 void SbiParser::TypeDecl( SbiSymDef& rDef, bool bAsNewAlreadyParsed )
  72 {
  73     SbxDataType eType = rDef.GetType();
  74     if( bAsNewAlreadyParsed || Peek() == AS )
  75     {
  76         short nSize = 0;
  77         if( !bAsNewAlreadyParsed )
  78             Next();
  79         rDef.SetDefinedAs();
  80         SbiToken eTok = Next();
  81         if( !bAsNewAlreadyParsed && eTok == NEW )
  82         {
  83             rDef.SetNew();
  84             eTok = Next();
  85         }
  86         switch( eTok )
  87         {
  88             case ANY:
  89                 if( rDef.IsNew() )
  90                     Error( SbERR_SYNTAX );
  91                 eType = SbxVARIANT; break;
  92             case TINTEGER:
  93             case TLONG:
  94             case TSINGLE:
  95             case TDOUBLE:
  96             case TCURRENCY:
  97             case TDATE:
  98             case TSTRING:
  99             case TOBJECT:
 100             case _ERROR_:
 101             case TBOOLEAN:
 102             case TVARIANT:
 103             case TBYTE:
 104                 if( rDef.IsNew() )
 105                     Error( SbERR_SYNTAX );
 106                 eType = (eTok==TBYTE) ? SbxBYTE : SbxDataType( eTok - TINTEGER + SbxINTEGER );
 107                 if( eType == SbxSTRING )
 108                 {
 109                     // STRING*n ?
 110                     if( Peek() == MUL )
 111                     {       // fixed size!
 112                         Next();
 113                         SbiConstExpression aSize( this );
 114                         nSize = aSize.GetShortValue();
 115                         if( nSize < 0 || (bVBASupportOn && nSize <= 0) )
 116                             Error( SbERR_OUT_OF_RANGE );
 117                         else
 118                             rDef.SetFixedStringLength( nSize );
 119                     }
 120                 }
 121                 break;
 122             case SYMBOL: // can only be a TYPE or a object class!
 123                 if( eScanType != SbxVARIANT )
 124                     Error( SbERR_SYNTAX );
 125                 else
 126                 {
 127                     OUString aCompleteName = aSym;
 128
 129                     // #52709 DIM AS NEW for Uno with full-qualified name
 130                     if( Peek() == DOT )
 131                     {
 132                         rtl::OUString aDotStr( '.' );
 133                         while( Peek() == DOT )
 134                         {
 135                             aCompleteName += aDotStr;
 136                             Next();
 137                             SbiToken ePeekTok = Peek();
 138                             if( ePeekTok == SYMBOL || IsKwd( ePeekTok ) )
 139                             {
 140                                 Next();
 141                                 aCompleteName += aSym;
 142                             }
 143                             else
 144                             {
 145                                 Next();
 146                                 Error( SbERR_UNEXPECTED, SYMBOL );
 147                                 break;
 148                             }
 149                         }
 150                     }
 151                     else if( rEnumArray->Find( aCompleteName, SbxCLASS_OBJECT ) || ( IsVBASupportOn() && VBAConstantHelper::instance().isVBAConstantType( aCompleteName ) ) )
 152                     {
 153                         eType = SbxLONG;
 154                         break;
 155                     }
 156
 157                     // Take over in the string pool
 158                     rDef.SetTypeId( aGblStrings.Add( aCompleteName ) );
 159
 160                     if( rDef.IsNew() && pProc == NULL )
 161                         aRequiredTypes.push_back( aCompleteName );
 162                 }
 163                 eType = SbxOBJECT;
 164                 break;
 165             case FIXSTRING: // new syntax for complex UNO types
 166                 rDef.SetTypeId( aGblStrings.Add( aSym ) );
 167                 eType = SbxOBJECT;
 168                 break;
 169             default:
 170                 Error( SbERR_UNEXPECTED, eTok );
 171                 Next();
 172         }
 173         // The variable could have been declared with a suffix
 174         if( rDef.GetType() != SbxVARIANT )
 175         {
 176             if( rDef.GetType() != eType )
 177                 Error( SbERR_VAR_DEFINED, rDef.GetName() );
 178             else if( eType == SbxSTRING && rDef.GetLen() != nSize )
 179                 Error( SbERR_VAR_DEFINED, rDef.GetName() );
 180         }
 181         rDef.SetType( eType );
 182         rDef.SetLen( nSize );
 183     }
 184 }
 185
 186 // Here variables, arrays and structures were definied.
 187 // DIM/PRIVATE/PUBLIC/GLOBAL
 188
 189 void SbiParser::Dim()
 190 {
 191     DefVar( _DIM, ( pProc && bVBASupportOn ) ? pProc->IsStatic() : false );
 192 }
 193
 194 void SbiParser::DefVar( SbiOpcode eOp, bool bStatic )
 195 {
 196     SbiSymPool* pOldPool = pPool;
 197     bool bSwitchPool = false;
 198     bool bPersistantGlobal = false;
 199     SbiToken eFirstTok = eCurTok;
 200     if( pProc && ( eCurTok == GLOBAL || eCurTok == PUBLIC || eCurTok == PRIVATE ) )
 201         Error( SbERR_NOT_IN_SUBR, eCurTok );
 202     if( eCurTok == PUBLIC || eCurTok == GLOBAL )
 203     {
 204         bSwitchPool = true;     // at the right moment switch to the global pool
 205         if( eCurTok == GLOBAL )
 206             bPersistantGlobal = true;
 207     }
 208     // behavior in VBA is that a module scope variable's lifetime is
 209     // tied to the document. e.g. a module scope variable is global
 210        if(  GetBasic()->IsDocBasic() && bVBASupportOn && !pProc )
 211         bPersistantGlobal = true;
 212     // PRIVATE is a synonymous for DIM
 213     // _CONST_?
 214     bool bConst = false;
 215     if( eCurTok == _CONST_ )
 216         bConst = true;
 217     else if( Peek() == _CONST_ )
 218         Next(), bConst = true;
 219
 220     // #110004 It can also be a sub/function
 221     if( !bConst && (eCurTok == SUB || eCurTok == FUNCTION || eCurTok == PROPERTY ||
 222                     eCurTok == STATIC || eCurTok == ENUM || eCurTok == DECLARE || eCurTok == TYPE) )
 223     {
 224         // Next token is read here, because !bConst
 225         bool bPrivate = ( eFirstTok == PRIVATE );
 226
 227         if( eCurTok == STATIC )
 228         {
 229             Next();
 230             DefStatic( bPrivate );
 231         }
 232         else if( eCurTok == SUB || eCurTok == FUNCTION || eCurTok == PROPERTY )
 233         {
 234             // End global chain if necessary (not done in
 235             // SbiParser::Parse() under these conditions
 236             if( bNewGblDefs && nGblChain == 0 )
 237             {
 238                 nGblChain = aGen.Gen( _JUMP, 0 );
 239                 bNewGblDefs = false;
 240             }
 241             Next();
 242             DefProc( false, bPrivate );
 243             return;
 244         }
 245         else if( eCurTok == ENUM )
 246         {
 247             Next();
 248             DefEnum( bPrivate );
 249             return;
 250         }
 251         else if( eCurTok == DECLARE )
 252         {
 253             Next();
 254             DefDeclare( bPrivate );
 255             return;
 256         }
 257         // #i109049
 258         else if( eCurTok == TYPE )
 259         {
 260             Next();
 261             DefType( bPrivate );
 262             return;
 263         }
 264     }
 265
 266 #ifdef SHARED
 267 #define tmpSHARED
 268 #undef SHARED
 269 #endif
 270     // SHARED were ignored
 271     if( Peek() == SHARED ) Next();
 272 #ifdef tmpSHARED
 273 #define SHARED
 274 #undef tmpSHARED
 275 #endif
 276     // PRESERVE only at REDIM
 277     if( Peek() == PRESERVE )
 278     {
 279         Next();
 280         if( eOp == _REDIM )
 281             eOp = _REDIMP;
 282         else
 283             Error( SbERR_UNEXPECTED, eCurTok );
 284     }
 285     SbiSymDef* pDef;
 286     SbiDimList* pDim;
 287
 288     // #40689, Statics -> Modul-Initialising, skip in Sub
 289     sal_uInt32 nEndOfStaticLbl = 0;
 290     if( !bVBASupportOn && bStatic )
 291     {
 292         nEndOfStaticLbl = aGen.Gen( _JUMP, 0 );
 293         aGen.Statement();   // catch up on static here
 294     }
 295
 296     bool bDefined = false;
 297     while( ( pDef = VarDecl( &pDim, bStatic, bConst ) ) != NULL )
 298     {
 299         EnableErrors();
 300         // search variable:
 301         if( bSwitchPool )
 302             pPool = &aGlobals;
 303         SbiSymDef* pOld = pPool->Find( pDef->GetName() );
 304         // search also in the Runtime-Library
 305         bool bRtlSym = false;
 306         if( !pOld )
 307         {
 308             pOld = CheckRTLForSym( pDef->GetName(), SbxVARIANT );
 309             if( pOld )
 310                 bRtlSym = true;
 311         }
 312         if( pOld && !(eOp == _REDIM || eOp == _REDIMP) )
 313         {
 314             if( pDef->GetScope() == SbLOCAL && pOld->GetScope() != SbLOCAL )
 315                 pOld = NULL;
 316         }
 317         if( pOld )
 318         {
 319             bDefined = true;
 320             // always an error at a RTL-S
 321             if( !bRtlSym && (eOp == _REDIM || eOp == _REDIMP) )
 322             {
 323                 // compare the attributes at a REDIM
 324                 SbxDataType eDefType;
 325                 bool bError_ = false;
 326                 if( pOld->IsStatic() )
 327                 {
 328                     bError_ = true;
 329                 }
 330                 else if( pOld->GetType() != ( eDefType = pDef->GetType() ) )
 331                 {
 332                     if( !( eDefType == SbxVARIANT && !pDef->IsDefinedAs() ) )
 333                         bError_ = true;
 334                 }
 335                 if( bError_ )
 336                     Error( SbERR_VAR_DEFINED, pDef->GetName() );
 337             }
 338             else
 339                 Error( SbERR_VAR_DEFINED, pDef->GetName() );
 340             delete pDef; pDef = pOld;
 341         }
 342         else
 343             pPool->Add( pDef );
 344
 345         // #36374: Create the variable in front of the distinction IsNew()
 346         // Otherwise error at Dim Identifier As New Type and option explicit
 347         if( !bDefined && !(eOp == _REDIM || eOp == _REDIMP)
 348                       && ( !bConst || pDef->GetScope() == SbGLOBAL ) )
 349         {
 350             // Declare variable or global constant
 351             SbiOpcode eOp2;
 352             switch ( pDef->GetScope() )
 353             {
 354                 case SbGLOBAL:  eOp2 = bPersistantGlobal ? _GLOBAL_P : _GLOBAL;
 355                                 goto global;
 356                 case SbPUBLIC:  eOp2 = bPersistantGlobal ? _PUBLIC_P : _PUBLIC;
 357                                 // #40689, no own Opcode anymore
 358                                 if( bVBASupportOn && bStatic )
 359                                 {
 360                                     eOp2 = _STATIC;
 361                                     break;
 362                                 }
 363                 global:         aGen.BackChain( nGblChain );
 364                                 nGblChain = 0;
 365                                 bGblDefs = bNewGblDefs = true;
 366                                 break;
 367                 default:        eOp2 = _LOCAL;
 368             }
 369             sal_uInt32 nOpnd2 = sal::static_int_cast< sal_uInt16 >( pDef->GetType() );
 370             if( pDef->IsWithEvents() )
 371                 nOpnd2 |= SBX_TYPE_WITH_EVENTS_FLAG;
 372
 373             if( bCompatible && pDef->IsNew() )
 374                 nOpnd2 |= SBX_TYPE_DIM_AS_NEW_FLAG;
 375
 376             short nFixedStringLength = pDef->GetFixedStringLength();
 377             if( nFixedStringLength >= 0 )
 378                 nOpnd2 |= (SBX_FIXED_LEN_STRING_FLAG + (sal_uInt32(nFixedStringLength) << 17));     // len = all bits above 0x10000
 379
 380             if( pDim != NULL && pDim->GetDims() > 0 )
 381                 nOpnd2 |= SBX_TYPE_VAR_TO_DIM_FLAG;
 382
 383             aGen.Gen( eOp2, pDef->GetId(), nOpnd2 );
 384         }
 385
 386         // Initialising for self-defined daty types
 387         // and per NEW created variable
 388         if( pDef->GetType() == SbxOBJECT
 389          && pDef->GetTypeId() )
 390         {
 391             if( !bCompatible && !pDef->IsNew() )
 392             {
 393                 OUString aTypeName( aGblStrings.Find( pDef->GetTypeId() ) );
 394                 if( rTypeArray->Find( aTypeName, SbxCLASS_OBJECT ) == NULL )
 395                 {
 396                     Error( SbERR_UNDEF_TYPE, aTypeName );
 397                 }
 398             }
 399
 400             if( bConst )
 401             {
 402                 Error( SbERR_SYNTAX );
 403             }
 404
 405             if( pDim )
 406             {
 407                 if( eOp == _REDIMP )
 408                 {
 409                     SbiExpression aExpr( this, *pDef, NULL );
 410                     aExpr.Gen();
 411                     aGen.Gen( _REDIMP_ERASE );
 412
 413                     pDef->SetDims( pDim->GetDims() );
 414                     SbiExpression aExpr2( this, *pDef, pDim );
 415                     aExpr2.Gen();
 416                     aGen.Gen( _DCREATE_REDIMP, pDef->GetId(), pDef->GetTypeId() );
 417                 }
 418                 else
 419                 {
 420                     pDef->SetDims( pDim->GetDims() );
 421                     SbiExpression aExpr( this, *pDef, pDim );
 422                     aExpr.Gen();
 423                     aGen.Gen( _DCREATE, pDef->GetId(), pDef->GetTypeId() );
 424                 }
 425             }
 426             else
 427             {
 428                 SbiExpression aExpr( this, *pDef );
 429                 aExpr.Gen();
 430                 SbiOpcode eOp_ = pDef->IsNew() ? _CREATE : _TCREATE;
 431                 aGen.Gen( eOp_, pDef->GetId(), pDef->GetTypeId() );
 432                 if ( bVBASupportOn )
 433                     aGen.Gen( _VBASET );
 434                 else
 435                     aGen.Gen( _SET );
 436             }
 437         }
 438         else
 439         {
 440             if( bConst )
 441             {
 442                 // Definition of the constants
 443                 if( pDim )
 444                 {
 445                     Error( SbERR_SYNTAX );
 446                     delete pDim;
 447                 }
 448                 SbiExpression aVar( this, *pDef );
 449                 if( !TestToken( EQ ) )
 450                     goto MyBreak;   // (see below)
 451                 SbiConstExpression aExpr( this );
 452                 if( !bDefined && aExpr.IsValid() )
 453                 {
 454                     if( pDef->GetScope() == SbGLOBAL )
 455                     {
 456                         // Create code only for the global constant!
 457                         aVar.Gen();
 458                         aExpr.Gen();
 459                         aGen.Gen( _PUTC );
 460                     }
 461                     SbiConstDef* pConst = pDef->GetConstDef();
 462                     if( aExpr.GetType() == SbxSTRING )
 463                         pConst->Set( aExpr.GetString() );
 464                     else
 465                         pConst->Set( aExpr.GetValue(), aExpr.GetType() );
 466                 }
 467             }
 468             else if( pDim )
 469             {
 470                 // Dimension the variable
 471                 // Delete the var at REDIM beforehand
 472                 if( eOp == _REDIM )
 473                 {
 474                     SbiExpression aExpr( this, *pDef, NULL );
 475                     aExpr.Gen();
 476                     if ( bVBASupportOn )
 477                         // delete the array but
 478                         // clear the variable ( this
 479                         // allows the processing of
 480                         // the param to happen as normal without errors ( ordinary ERASE just clears the array )
 481                         aGen.Gen( _ERASE_CLEAR );
 482                     else
 483                         aGen.Gen( _ERASE );
 484                 }
 485                 else if( eOp == _REDIMP )
 486                 {
 487                     SbiExpression aExpr( this, *pDef, NULL );
 488                     aExpr.Gen();
 489                     aGen.Gen( _REDIMP_ERASE );
 490                 }
 491                 pDef->SetDims( pDim->GetDims() );
 492                 if( bPersistantGlobal )
 493                     pDef->SetGlobal( sal_True );
 494                 SbiExpression aExpr( this, *pDef, pDim );
 495                 aExpr.Gen();
 496                 pDef->SetGlobal( sal_False );
 497                 aGen.Gen( (eOp == _STATIC) ? _DIM : eOp );
 498             }
 499         }
 500         if( !TestComma() )
 501             goto MyBreak;
 502
 503         // Implementation of bSwitchPool (see above): pPool must not be set to &aGlobals
 504         // at the VarDecl-Call.
 505         // Apart from that the behavior should be absolutely identical,
 506         // i.e., pPool had to be reset always at the end of the loop.
 507         // also at a break
 508         pPool = pOldPool;
 509         continue;       // Skip MyBreak
 510     MyBreak:
 511         pPool = pOldPool;
 512         break;
 513     }
 514
 515     // #40689, finalize the jump over statics declarations
 516     if( !bVBASupportOn && bStatic )
 517     {
 518         // maintain the global chain
 519         nGblChain = aGen.Gen( _JUMP, 0 );
 520         bGblDefs = bNewGblDefs = true;
 521
 522         // Register for Sub a jump to the end of statics
 523         aGen.BackChain( nEndOfStaticLbl );
 524     }
 525
 526 }
 527
 528 // Here were Arrays redimensioned.
 529
 530 void SbiParser::ReDim()
 531 {
 532     DefVar( _REDIM, (  pProc && bVBASupportOn ) ? pProc->IsStatic() : false );
 533 }
 534
 535 // ERASE array, ...
 536
 537 void SbiParser::Erase()
 538 {
 539     while( !bAbort )
 540     {
 541         SbiExpression aExpr( this, SbLVALUE );
 542         aExpr.Gen();
 543         aGen.Gen( _ERASE );
 544         if( !TestComma() ) break;
 545     }
 546 }
 547
 548 // Declaration of a data type
 549
 550 void SbiParser::Type()
 551 {
 552     DefType( false );
 553 }
 554
 555 void SbiParser::DefType( bool bPrivate )
 556 {
 557     // TODO: Use bPrivate
 558     (void)bPrivate;
 559
 560     // Read the new Token lesen. It had to be a symbol
 561     if (!TestSymbol())
 562         return;
 563
 564     if (rTypeArray->Find(aSym,SbxCLASS_OBJECT))
 565     {
 566         Error( SbERR_VAR_DEFINED, aSym );
 567         return;
 568     }
 569
 570     SbxObject *pType = new SbxObject(aSym);
 571
 572     SbiSymDef* pElem;
 573     SbiDimList* pDim = NULL;
 574     bool bDone = false;
 575
 576     while( !bDone && !IsEof() )
 577     {
 578         switch( Peek() )
 579         {
 580             case ENDTYPE :
 581                 pElem = NULL;
 582                 bDone = true;
 583                 Next();
 584             break;
 585
 586             case EOLN :
 587             case REM :
 588                 pElem = NULL;
 589                 Next();
 590             break;
 591
 592             default:
 593                 pElem = VarDecl(&pDim, false, false);
 594                 if( !pElem )
 595                     bDone = true;   // Error occurred
 596         }
 597         if( pElem )
 598         {
 599             SbxArray *pTypeMembers = pType->GetProperties();
 600             OUString aElemName = pElem->GetName();
 601             if( pTypeMembers->Find( aElemName, SbxCLASS_DONTCARE) )
 602             {
 603                 Error (SbERR_VAR_DEFINED);
 604             }
 605             else
 606             {
 607                 SbxDataType eElemType = pElem->GetType();
 608                 SbxProperty *pTypeElem = new SbxProperty( aElemName, eElemType );
 609                 if( pDim )
 610                 {
 611                     SbxDimArray* pArray = new SbxDimArray( pElem->GetType() );
 612                     if ( pDim->GetSize() )
 613                     {
 614                         // Dimension the target array
 615
 616                         for ( short i=0; i<pDim->GetSize();++i )
 617                         {
 618                             sal_Int32 ub = -1;
 619                             sal_Int32 lb = nBase;
 620                             SbiExprNode* pNode =  pDim->Get(i)->GetExprNode();
 621                             ub = pNode->GetNumber();
 622                             if ( !pDim->Get( i )->IsBased() ) // each dim is low/up
 623                             {
 624                                 if (  ++i >= pDim->GetSize() ) // trouble
 625                                     StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
 626                                 pNode =  pDim->Get(i)->GetExprNode();
 627                                 lb = ub;
 628                                 ub = pNode->GetNumber();
 629                             }
 630                             else if ( !bCompatible )
 631                                 ub += nBase;
 632                             pArray->AddDim32( lb, ub );
 633                         }
 634                         pArray->setHasFixedSize( true );
 635                     }
 636                     else
 637                         pArray->unoAddDim( 0, -1 ); // variant array
 638                     sal_uInt16 nSavFlags = pTypeElem->GetFlags();
 639                     // need to reset the FIXED flag
 640                     // when calling PutObject ( because the type will not match Object )
 641                     pTypeElem->ResetFlag( SBX_FIXED );
 642                     pTypeElem->PutObject( pArray );
 643                     pTypeElem->SetFlags( nSavFlags );
 644                 }
 645                 // Nested user type?
 646                 if( eElemType == SbxOBJECT )
 647                 {
 648                     sal_uInt16 nElemTypeId = pElem->GetTypeId();
 649                     if( nElemTypeId != 0 )
 650                     {
 651                         OUString aTypeName( aGblStrings.Find( nElemTypeId ) );
 652                         SbxObject* pTypeObj = static_cast< SbxObject* >( rTypeArray->Find( aTypeName, SbxCLASS_OBJECT ) );
 653                         if( pTypeObj != NULL )
 654                         {
 655                             SbxObject* pCloneObj = cloneTypeObjectImpl( *pTypeObj );
 656                             pTypeElem->PutObject( pCloneObj );
 657                         }
 658                     }
 659                 }
 660                 pTypeMembers->Insert( pTypeElem, pTypeMembers->Count() );
 661             }
 662             delete pDim, pDim = NULL;
 663             delete pElem;
 664         }
 665     }
 666
 667     pType->Remove( rtl::OUString("Name"), SbxCLASS_DONTCARE );
 668     pType->Remove( rtl::OUString("Parent"), SbxCLASS_DONTCARE );
 669
 670     rTypeArray->Insert (pType,rTypeArray->Count());
 671 }
 672
 673
 674 // Declaration of Enum type
 675
 676 void SbiParser::Enum()
 677 {
 678     DefEnum( false );
 679 }
 680
 681 void SbiParser::DefEnum( bool bPrivate )
 682 {
 683     // Read a the new Token. It had to be a symbol
 684     if (!TestSymbol())
 685         return;
 686
 687     OUString aEnumName = aSym;
 688     if( rEnumArray->Find(aEnumName,SbxCLASS_OBJECT) )
 689     {
 690         Error( SbERR_VAR_DEFINED, aSym );
 691         return;
 692     }
 693
 694     SbxObject *pEnum = new SbxObject( aEnumName );
 695     if( bPrivate )
 696     {
 697         pEnum->SetFlag( SBX_PRIVATE );
 698     }
 699     SbiSymDef* pElem;
 700     SbiDimList* pDim;
 701     bool bDone = false;
 702
 703     // Starting with -1 to make first default value 0 after ++
 704     sal_Int32 nCurrentEnumValue = -1;
 705     while( !bDone && !IsEof() )
 706     {
 707         switch( Peek() )
 708         {
 709             case ENDENUM :
 710                 pElem = NULL;
 711                 bDone = true;
 712                 Next();
 713             break;
 714
 715             case EOLN :
 716             case REM :
 717                 pElem = NULL;
 718                 Next();
 719             break;
 720
 721             default:
 722             {
 723                 // TODO: Check existing!
 724                 bool bDefined = false;
 725
 726                 pDim = NULL;
 727                 pElem = VarDecl( &pDim, false, true );
 728                 if( !pElem )
 729                 {
 730                     bDone = true;   // Error occurred
 731                     break;
 732                 }
 733                 else if( pDim )
 734                 {
 735                     delete pDim;
 736                     Error( SbERR_SYNTAX );
 737                     bDone = true;   // Error occurred
 738                     break;
 739                 }
 740
 741                 SbiExpression aVar( this, *pElem );
 742                 if( Peek() == EQ )
 743                 {
 744                     Next();
 745
 746                     SbiConstExpression aExpr( this );
 747                     if( !bDefined && aExpr.IsValid() )
 748                     {
 749                         SbxVariableRef xConvertVar = new SbxVariable();
 750                         if( aExpr.GetType() == SbxSTRING )
 751                             xConvertVar->PutString( aExpr.GetString() );
 752                         else
 753                             xConvertVar->PutDouble( aExpr.GetValue() );
 754
 755                         nCurrentEnumValue = xConvertVar->GetLong();
 756                     }
 757                 }
 758                 else
 759                     nCurrentEnumValue++;
 760
 761                 SbiSymPool* pPoolToUse = bPrivate ? pPool : &aGlobals;
 762
 763                 SbiSymDef* pOld = pPoolToUse->Find( pElem->GetName() );
 764                 if( pOld )
 765                 {
 766                     Error( SbERR_VAR_DEFINED, pElem->GetName() );
 767                     bDone = true;   // Error occurred
 768                     break;
 769                 }
 770
 771                 pPool->Add( pElem );
 772
 773                 if( !bPrivate )
 774                 {
 775                     SbiOpcode eOp = _GLOBAL;
 776                     aGen.BackChain( nGblChain );
 777                     nGblChain = 0;
 778                     bGblDefs = bNewGblDefs = true;
 779                     aGen.Gen(
 780                         eOp, pElem->GetId(),
 781                         sal::static_int_cast< sal_uInt16 >( pElem->GetType() ) );
 782
 783                     aVar.Gen();
 784                     sal_uInt16 nStringId = aGen.GetParser()->aGblStrings.Add( nCurrentEnumValue, SbxLONG );
 785                     aGen.Gen( _NUMBER, nStringId );
 786                     aGen.Gen( _PUTC );
 787                 }
 788
 789                 SbiConstDef* pConst = pElem->GetConstDef();
 790                 pConst->Set( nCurrentEnumValue, SbxLONG );
 791             }
 792         }
 793         if( pElem )
 794         {
 795             SbxArray *pEnumMembers = pEnum->GetProperties();
 796             SbxProperty *pEnumElem = new SbxProperty( pElem->GetName(), SbxLONG );
 797             pEnumElem->PutLong( nCurrentEnumValue );
 798             pEnumElem->ResetFlag( SBX_WRITE );
 799             pEnumElem->SetFlag( SBX_CONST );
 800             pEnumMembers->Insert( pEnumElem, pEnumMembers->Count() );
 801         }
 802     }
 803
 804     pEnum->Remove( rtl::OUString("Name"), SbxCLASS_DONTCARE );
 805     pEnum->Remove( rtl::OUString("Parent"), SbxCLASS_DONTCARE );
 806
 807     rEnumArray->Insert( pEnum, rEnumArray->Count() );
 808 }
 809
 810
 811 // Procedure-Declaration
 812 // the first Token is already read in (SUB/FUNCTION)
 813 // xxx Name [LIB "name"[ALIAS "name"]][(Parameter)][AS TYPE]
 814
 815 SbiProcDef* SbiParser::ProcDecl( bool bDecl )
 816 {
 817     bool bFunc = ( eCurTok == FUNCTION );
 818     bool bProp = ( eCurTok == GET || eCurTok == SET || eCurTok == LET );
 819     if( !TestSymbol() ) return NULL;
 820     OUString aName( aSym );
 821     SbxDataType eType = eScanType;
 822     SbiProcDef* pDef = new SbiProcDef( this, aName, true );
 823     pDef->SetType( eType );
 824     if( Peek() == _CDECL_ )
 825     {
 826         Next(); pDef->SetCdecl();
 827     }
 828     if( Peek() == LIB )
 829     {
 830         Next();
 831         if( Next() == FIXSTRING )
 832         {
 833             pDef->GetLib() = aSym;
 834         }
 835         else
 836         {
 837             Error( SbERR_SYNTAX );
 838         }
 839     }
 840     if( Peek() == ALIAS )
 841     {
 842         Next();
 843         if( Next() == FIXSTRING )
 844         {
 845             pDef->GetAlias() = aSym;
 846         }
 847         else
 848         {
 849             Error( SbERR_SYNTAX );
 850         }
 851     }
 852     if( !bDecl )
 853     {
 854         // CDECL, LIB and ALIAS are invalid
 855         if( !pDef->GetLib().isEmpty() )
 856         {
 857             Error( SbERR_UNEXPECTED, LIB );
 858         }
 859         if( !pDef->GetAlias().isEmpty() )
 860         {
 861             Error( SbERR_UNEXPECTED, ALIAS );
 862         }
 863         if( pDef->IsCdecl() )
 864         {
 865             Error( SbERR_UNEXPECTED, _CDECL_ );
 866         }
 867         pDef->SetCdecl( false );
 868         pDef->GetLib() = "";
 869         pDef->GetAlias() = "";
 870     }
 871     else if( pDef->GetLib().isEmpty() )
 872     {
 873         // ALIAS and CDECL only together with LIB
 874         if( !pDef->GetAlias().isEmpty() )
 875         {
 876             Error( SbERR_UNEXPECTED, ALIAS );
 877         }
 878         if( pDef->IsCdecl() )
 879         {
 880             Error( SbERR_UNEXPECTED, _CDECL_ );
 881         }
 882         pDef->SetCdecl( false );
 883         pDef->GetAlias() = "";
 884     }
 885     // Brackets?
 886     if( Peek() == LPAREN )
 887     {
 888         Next();
 889         if( Peek() == RPAREN )
 890         {
 891             Next();
 892         }
 893         else
 894         {
 895             for(;;)
 896             {
 897                 bool bByVal = false;
 898                 bool bOptional = false;
 899                 bool bParamArray = false;
 900                 while( Peek() == BYVAL || Peek() == BYREF || Peek() == _OPTIONAL_ )
 901                 {
 902                     if( Peek() == BYVAL )
 903                     {
 904                         bByVal = true;
 905                     }
 906                     else if ( Peek() == BYREF )
 907                     {
 908                         bByVal = false;
 909                     }
 910                     else if ( Peek() == _OPTIONAL_ )
 911                     {
 912                         bOptional = true;
 913                     }
 914                     Next();
 915                 }
 916                 if( bCompatible && Peek() == PARAMARRAY )
 917                 {
 918                     if( bByVal || bOptional )
 919                     {
 920                         Error( SbERR_UNEXPECTED, PARAMARRAY );
 921                     }
 922                     Next();
 923                     bParamArray = true;
 924                 }
 925                 SbiSymDef* pPar = VarDecl( NULL, false, false );
 926                 if( !pPar )
 927                 {
 928                     break;
 929                 }
 930                 if( bByVal )
 931                 {
 932                     pPar->SetByVal();
 933                 }
 934                 if( bOptional )
 935                 {
 936                     pPar->SetOptional();
 937                 }
 938                 if( bParamArray )
 939                 {
 940                     pPar->SetParamArray();
 941                 }
 942                 pDef->GetParams().Add( pPar );
 943                 SbiToken eTok = Next();
 944                 if( eTok != COMMA && eTok != RPAREN )
 945                 {
 946                     bool bError2 = true;
 947                     if( bOptional && bCompatible && eTok == EQ )
 948                     {
 949                         SbiConstExpression* pDefaultExpr = new SbiConstExpression( this );
 950                         SbxDataType eType2 = pDefaultExpr->GetType();
 951
 952                         sal_uInt16 nStringId;
 953                         if( eType2 == SbxSTRING )
 954                         {
 955                             nStringId = aGblStrings.Add( pDefaultExpr->GetString() );
 956                         }
 957                         else
 958                         {
 959                             nStringId = aGblStrings.Add( pDefaultExpr->GetValue(), eType2 );
 960                         }
 961                         pPar->SetDefaultId( nStringId );
 962                         delete pDefaultExpr;
 963
 964                         eTok = Next();
 965                         if( eTok == COMMA || eTok == RPAREN )
 966                         {
 967                             bError2 = false;
 968                         }
 969                     }
 970                     if( bError2 )
 971                     {
 972                         Error( SbERR_EXPECTED, RPAREN );
 973                         break;
 974                     }
 975                 }
 976                 if( eTok == RPAREN )
 977                 {
 978                     break;
 979                 }
 980             }
 981         }
 982     }
 983     TypeDecl( *pDef );
 984     if( eType != SbxVARIANT && pDef->GetType() != eType )
 985     {
 986         Error( SbERR_BAD_DECLARATION, aName );
 987     }
 988     if( pDef->GetType() == SbxVARIANT && !( bFunc || bProp ) )
 989     {
 990         pDef->SetType( SbxEMPTY );
 991     }
 992     return pDef;
 993 }
 994
 995 // DECLARE
 996
 997 void SbiParser::Declare()
 998 {
 999     DefDeclare( false );
1000 }
1001
1002 void SbiParser::DefDeclare( bool bPrivate )
1003 {
1004     Next();
1005     if( eCurTok != SUB && eCurTok != FUNCTION )
1006     {
1007       Error( SbERR_UNEXPECTED, eCurTok );
1008     }
1009     else
1010     {
1011         bool bFunction = (eCurTok == FUNCTION);
1012
1013         SbiProcDef* pDef = ProcDecl( true );
1014         if( pDef )
1015         {
1016             if( pDef->GetLib().isEmpty() )
1017             {
1018                 Error( SbERR_EXPECTED, LIB );
1019             }
1020             // Is it already there?
1021             SbiSymDef* pOld = aPublics.Find( pDef->GetName() );
1022             if( pOld )
1023             {
1024                 SbiProcDef* p = pOld->GetProcDef();
1025                 if( !p )
1026                 {
1027                     // Declared as a variable
1028                     Error( SbERR_BAD_DECLARATION, pDef->GetName() );
1029                     delete pDef;
1030                     pDef = NULL;
1031                 }
1032                 else
1033                 {
1034                     pDef->Match( p );
1035                 }
1036             }
1037             else
1038             {
1039                 aPublics.Add( pDef );
1040             }
1041             if ( pDef )
1042             {
1043                 pDef->SetPublic( !bPrivate );
1044
1045                 // New declare handling
1046                 if( !pDef->GetLib().isEmpty())
1047                 {
1048                     if( bNewGblDefs && nGblChain == 0 )
1049                     {
1050                         nGblChain = aGen.Gen( _JUMP, 0 );
1051                         bNewGblDefs = false;
1052                     }
1053
1054                     sal_uInt16 nSavLine = nLine;
1055                     aGen.Statement();
1056                     pDef->Define();
1057                     pDef->SetLine1( nSavLine );
1058                     pDef->SetLine2( nSavLine );
1059
1060                     SbiSymPool& rPool = pDef->GetParams();
1061                     sal_uInt16 nParCount = rPool.GetSize();
1062
1063                     SbxDataType eType = pDef->GetType();
1064                     if( bFunction )
1065                     {
1066                         aGen.Gen( _PARAM, 0, sal::static_int_cast< sal_uInt16 >( eType ) );
1067                     }
1068                     if( nParCount > 1 )
1069                     {
1070                         aGen.Gen( _ARGC );
1071
1072                         for( sal_uInt16 i = 1 ; i < nParCount ; ++i )
1073                         {
1074                             SbiSymDef* pParDef = rPool.Get( i );
1075                             SbxDataType eParType = pParDef->GetType();
1076
1077                             aGen.Gen( _PARAM, i, sal::static_int_cast< sal_uInt16 >( eParType ) );
1078                             aGen.Gen( _ARGV );
1079
1080                             sal_uInt16 nTyp = sal::static_int_cast< sal_uInt16 >( pParDef->GetType() );
1081                             if( pParDef->IsByVal() )
1082                             {
1083                                 // Reset to avoid additional byval in call to wrapper function
1084                                 pParDef->SetByVal( sal_False );
1085                                 nTyp |= 0x8000;
1086                             }
1087                             aGen.Gen( _ARGTYP, nTyp );
1088                         }
1089                     }
1090
1091                     aGen.Gen( _LIB, aGblStrings.Add( pDef->GetLib() ) );
1092
1093                     SbiOpcode eOp = pDef->IsCdecl() ? _CALLC : _CALL;
1094                     sal_uInt16 nId = pDef->GetId();
1095                     if( !pDef->GetAlias().isEmpty() )
1096                     {
1097                         nId = ( nId & 0x8000 ) | aGblStrings.Add( pDef->GetAlias() );
1098                     }
1099                     if( nParCount > 1 )
1100                     {
1101                         nId |= 0x8000;
1102                     }
1103                     aGen.Gen( eOp, nId, sal::static_int_cast< sal_uInt16 >( eType ) );
1104
1105                     if( bFunction )
1106                     {
1107                         aGen.Gen( _PUT );
1108                     }
1109                     aGen.Gen( _LEAVE );
1110                 }
1111             }
1112         }
1113     }
1114 }
1115
1116 void SbiParser::Attribute()
1117 {
1118     // TODO: Need to implement the method as an attributed object.
1119     while( Next() != EQ )
1120     {
1121         if( Next() != DOT)
1122         {
1123             break;
1124         }
1125     }
1126
1127     if( eCurTok != EQ )
1128     {
1129         Error( SbERR_SYNTAX );
1130     }
1131     else
1132     {
1133         SbiExpression aValue( this );
1134     }
1135     // Don't generate any code - just discard it.
1136 }
1137
1138 // Call of a SUB or a FUNCTION
1139
1140 void SbiParser::Call()
1141 {
1142     SbiExpression aVar( this, SbSYMBOL );
1143     aVar.Gen( FORCE_CALL );
1144     aGen.Gen( _GET );
1145 }
1146
1147 // SUB/FUNCTION
1148
1149 void SbiParser::SubFunc()
1150 {
1151     DefProc( false, false );
1152 }
1153
1154 // Read in of a procedure
1155
1156 void SbiParser::DefProc( bool bStatic, bool bPrivate )
1157 {
1158     sal_uInt16 l1 = nLine, l2 = nLine;
1159     bool bSub = ( eCurTok == SUB );
1160     bool bProperty = ( eCurTok == PROPERTY );
1161     PropertyMode ePropertyMode = PROPERTY_MODE_NONE;
1162     if( bProperty )
1163     {
1164         Next();
1165         if( eCurTok == GET )
1166         {
1167             ePropertyMode = PROPERTY_MODE_GET;
1168         }
1169         else if( eCurTok == LET )
1170         {
1171             ePropertyMode = PROPERTY_MODE_LET;
1172         }
1173         else if( eCurTok == SET )
1174         {
1175             ePropertyMode = PROPERTY_MODE_SET;
1176         }
1177         else
1178         {
1179             Error( SbERR_EXPECTED, "Get or Let or Set" );
1180         }
1181     }
1182
1183     SbiToken eExit = eCurTok;
1184     SbiProcDef* pDef = ProcDecl( false );
1185     if( !pDef )
1186     {
1187         return;
1188     }
1189     pDef->setPropertyMode( ePropertyMode );
1190
1191     // Is the Proc already declared?
1192     SbiSymDef* pOld = aPublics.Find( pDef->GetName() );
1193     if( pOld )
1194     {
1195         bool bError_ = false;
1196
1197         pProc = pOld->GetProcDef();
1198         if( !pProc )
1199         {
1200             // Declared as a variable
1201             Error( SbERR_BAD_DECLARATION, pDef->GetName() );
1202             delete pDef;
1203             pProc = NULL;
1204             bError_ = true;
1205         }
1206         // #100027: Multiple declaration -> Error
1207         // #112787: Not for setup, REMOVE for 8
1208         else if( pProc->IsUsedForProcDecl() )
1209         {
1210             PropertyMode ePropMode = pDef->getPropertyMode();
1211             if( ePropMode == PROPERTY_MODE_NONE || ePropMode == pProc->getPropertyMode() )
1212             {
1213                 Error( SbERR_PROC_DEFINED, pDef->GetName() );
1214                 delete pDef;
1215                 pProc = NULL;
1216                 bError_ = true;
1217             }
1218         }
1219
1220         if( !bError_ )
1221         {
1222             pDef->Match( pProc );
1223             pProc = pDef;
1224         }
1225     }
1226     else
1227     {
1228         aPublics.Add( pDef ), pProc = pDef;
1229     }
1230     if( !pProc )
1231     {
1232         return;
1233     }
1234     pProc->SetPublic( !bPrivate );
1235
1236     // Now we set the search hierarchy for symbols as well as the
1237     // current procedure.
1238     aPublics.SetProcId( pProc->GetId() );
1239     pProc->GetParams().SetParent( &aPublics );
1240     if( bStatic )
1241     {
1242         if ( bVBASupportOn )
1243         {
1244             pProc->SetStatic( sal_True );
1245         }
1246         else
1247         {
1248             Error( SbERR_NOT_IMPLEMENTED ); // STATIC SUB ...
1249         }
1250     }
1251     else
1252     {
1253         pProc->SetStatic( sal_False );
1254     }
1255     // Normal case: Local variable->parameter->global variable
1256     pProc->GetLocals().SetParent( &pProc->GetParams() );
1257     pPool = &pProc->GetLocals();
1258
1259     pProc->Define();
1260     OpenBlock( eExit );
1261     StmntBlock( bSub ? ENDSUB : (bProperty ? ENDPROPERTY : ENDFUNC) );
1262     l2 = nLine;
1263     pProc->SetLine1( l1 );
1264     pProc->SetLine2( l2 );
1265     pPool = &aPublics;
1266     aPublics.SetProcId( 0 );
1267     // Open labels?
1268     pProc->GetLabels().CheckRefs();
1269     CloseBlock();
1270     aGen.Gen( _LEAVE );
1271     pProc = NULL;
1272 }
1273
1274 // STATIC variable|procedure
1275
1276 void SbiParser::Static()
1277 {
1278     DefStatic( false );
1279 }
1280
1281 void SbiParser::DefStatic( bool bPrivate )
1282 {
1283     SbiSymPool* p;
1284
1285     switch( Peek() )
1286     {
1287     case SUB:
1288     case FUNCTION:
1289     case PROPERTY:
1290         // End global chain if necessary (not done in
1291         // SbiParser::Parse() under these conditions
1292         if( bNewGblDefs && nGblChain == 0 )
1293         {
1294             nGblChain = aGen.Gen( _JUMP, 0 );
1295             bNewGblDefs = false;
1296         }
1297         Next();
1298         DefProc( true, bPrivate );
1299         break;
1300     default:
1301         if( !pProc )
1302         {
1303             Error( SbERR_NOT_IN_SUBR );
1304         }
1305         // Reset the Pool, so that STATIC-Declarations go into the
1306         // global Pool
1307         p = pPool;
1308         pPool = &aPublics;
1309         DefVar( _STATIC, true );
1310         pPool = p;
1311         break;
1312     }
1313 }
1314
1315 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */