basic/source/comp/dim.cxx

   1  /*************************************************************************
   2  *
   3  * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   4  *
   5  * Copyright 2008 by Sun Microsystems, Inc.
   6  *
   7  * OpenOffice.org - a multi-platform office productivity suite
   8  *
   9  * $RCSfile: dim.cxx,v $
  10  * $Revision: 1.30 $
  11  *
  12  * This file is part of OpenOffice.org.
  13  *
  14  * OpenOffice.org is free software: you can redistribute it and/or modify
  15  * it under the terms of the GNU Lesser General Public License version 3
  16  * only, as published by the Free Software Foundation.
  17  *
  18  * OpenOffice.org is distributed in the hope that it will be useful,
  19  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  20  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21  * GNU Lesser General Public License version 3 for more details
  22  * (a copy is included in the LICENSE file that accompanied this code).
  23  *
  24  * You should have received a copy of the GNU Lesser General Public License
  25  * version 3 along with OpenOffice.org.  If not, see
  26  * <http://www.openoffice.org/license.html>
  27  * for a copy of the LGPLv3 License.
  28  *
  29  ************************************************************************/
  30
  31 // MARKER(update_precomp.py): autogen include statement, do not remove
  32 #include "precompiled_basic.hxx"
  33 #include <basic/sbx.hxx>
  34 #include "sbcomp.hxx"
  35 #include "sbunoobj.hxx"
  36
  37
  38 // Deklaration einer Variablen
  39 // Bei Fehlern wird bis zum Komma oder Newline geparst.
  40 // Returnwert: eine neue Instanz, die eingefuegt und dann geloescht wird.
  41 // Array-Indexe werden als SbiDimList zurueckgegeben
  42
  43 SbiSymDef* SbiParser::VarDecl( SbiDimList** ppDim, BOOL bStatic, BOOL bConst )
  44 {
  45         // Some keywords can be dim as varibles like " Sub Test( Name as String )"
  46         eCurTok = Peek();
  47         BOOL bKwdOk = IsVBASupportOn() ? BOOL( (eCurTok == NAME) || (eCurTok == LINE) || (eCurTok == TEXT) ): FALSE;
  48         if( !TestSymbol( bKwdOk ) ) return NULL;
  49     SbxDataType t = eScanType;
  50     SbiSymDef* pDef = bConst ? new SbiConstDef( aSym ) : new SbiSymDef( aSym );
  51     SbiDimList* pDim = NULL;
  52     // Klammern?
  53     if( Peek() == LPAREN )
  54         pDim = new SbiDimList( this );
  55     pDef->SetType( t );
  56     if( bStatic )
  57         pDef->SetStatic();
  58     TypeDecl( *pDef );
  59     if( !ppDim && pDim )
  60     {
  61         if(pDim->GetDims() )
  62             Error( SbERR_EXPECTED, "()" );
  63         delete pDim;
  64     }
  65     else if( ppDim )
  66         *ppDim = pDim;
  67     return pDef;
  68 }
  69
  70 // Aufloesen einer AS-Typdeklaration
  71 // Der Datentyp wird in die uebergebene Variable eingetragen
  72
  73 void SbiParser::TypeDecl( SbiSymDef& rDef, BOOL bAsNewAlreadyParsed )
  74 {
  75     SbxDataType eType = rDef.GetType();
  76     short nSize = 0;
  77     if( bAsNewAlreadyParsed || Peek() == AS )
  78     {
  79         if( !bAsNewAlreadyParsed )
  80             Next();
  81         rDef.SetDefinedAs();
  82         String aType;
  83         SbiToken eTok = Next();
  84         if( !bAsNewAlreadyParsed && eTok == NEW )
  85         {
  86             rDef.SetNew();
  87             eTok = Next();
  88         }
  89         switch( eTok )
  90         {
  91             case ANY:
  92                 if( rDef.IsNew() )
  93                     Error( SbERR_SYNTAX );
  94                 eType = SbxVARIANT; break;
  95             case TINTEGER:
  96             case TLONG:
  97             case TSINGLE:
  98             case TDOUBLE:
  99             case TCURRENCY:
 100             case TDATE:
 101             case TSTRING:
 102             case TOBJECT:
 103             case _ERROR_:
 104             case TBOOLEAN:
 105             case TVARIANT:
 106             case TBYTE:
 107                 if( rDef.IsNew() )
 108                     Error( SbERR_SYNTAX );
 109                 eType = (eTok==TBYTE) ? SbxBYTE : SbxDataType( eTok - TINTEGER + SbxINTEGER );
 110                 if( eType == SbxSTRING )
 111                 {
 112                     // STRING*n ?
 113                     if( Peek() == MUL )
 114                     {           // fixed size!
 115                         Next();
 116                         SbiConstExpression aSize( this );
 117                         nSize = aSize.GetShortValue();
 118                         if( nSize < 0 )
 119                             Error( SbERR_OUT_OF_RANGE );
 120                     }
 121                 }
 122                 break;
 123             case SYMBOL: // kann nur ein TYPE oder eine Objektklasse sein!
 124                 if( eScanType != SbxVARIANT )
 125                     Error( SbERR_SYNTAX );
 126                 else
 127                 {
 128                     String aCompleteName = aSym;
 129
 130                     // #52709 DIM AS NEW fuer Uno mit voll-qualifizierten Namen
 131                     if( Peek() == DOT )
 132                     {
 133                         String aDotStr( '.' );
 134                         while( Peek() == DOT )
 135                         {
 136                             aCompleteName += aDotStr;
 137                             Next();
 138                             SbiToken ePeekTok = Peek();
 139                             if( ePeekTok == SYMBOL || IsKwd( ePeekTok ) )
 140                             {
 141                                 Next();
 142                                 aCompleteName += aSym;
 143                             }
 144                             else
 145                             {
 146                                 Next();
 147                                 Error( SbERR_UNEXPECTED, SYMBOL );
 148                                 break;
 149                             }
 150                         }
 151                     }
 152                                         else if( rEnumArray->Find( aCompleteName, SbxCLASS_OBJECT ) || ( IsVBASupportOn() && VBAConstantHelper::instance().isVBAConstantType( aCompleteName ) ) )
 153                     {
 154                         eType = SbxLONG;
 155                         break;
 156                     }
 157
 158                     // In den String-Pool uebernehmen
 159                     rDef.SetTypeId( aGblStrings.Add( aCompleteName ) );
 160                 }
 161                 eType = SbxOBJECT;
 162                 break;
 163             case FIXSTRING: // new syntax for complex UNO types
 164                 rDef.SetTypeId( aGblStrings.Add( aSym ) );
 165                 eType = SbxOBJECT;
 166                 break;
 167             default:
 168                 Error( SbERR_UNEXPECTED, eTok );
 169                 Next();
 170         }
 171         // Die Variable koennte mit Suffix deklariert sein
 172         if( rDef.GetType() != SbxVARIANT )
 173         {
 174             if( rDef.GetType() != eType )
 175                 Error( SbERR_VAR_DEFINED, rDef.GetName() );
 176             else if( eType == SbxSTRING && rDef.GetLen() != nSize )
 177                 Error( SbERR_VAR_DEFINED, rDef.GetName() );
 178         }
 179         rDef.SetType( eType );
 180         rDef.SetLen( nSize );
 181     }
 182 }
 183
 184 // Hier werden Variable, Arrays und Strukturen definiert.
 185 // DIM/PRIVATE/PUBLIC/GLOBAL
 186
 187 void SbiParser::Dim()
 188 {
 189     DefVar( _DIM, ( pProc && bVBASupportOn ) ? pProc->IsStatic() : FALSE );
 190 }
 191
 192 void SbiParser::DefVar( SbiOpcode eOp, BOOL bStatic )
 193 {
 194     SbiSymPool* pOldPool = pPool;
 195     BOOL bSwitchPool = FALSE;
 196     BOOL bPersistantGlobal = FALSE;
 197     SbiToken eFirstTok = eCurTok;
 198     if( pProc && ( eCurTok == GLOBAL || eCurTok == PUBLIC || eCurTok == PRIVATE ) )
 199         Error( SbERR_NOT_IN_SUBR, eCurTok );
 200     if( eCurTok == PUBLIC || eCurTok == GLOBAL )
 201     {
 202         bSwitchPool = TRUE;             // im richtigen Moment auf globalen Pool schalten
 203         if( eCurTok == GLOBAL )
 204             bPersistantGlobal = TRUE;
 205     }
 206     // behavior in VBA is that a module scope variable's lifetime is
 207     // tied to the document. e.g. a module scope variable is global
 208        if(  GetBasic()->IsDocBasic() && bVBASupportOn && !pProc )
 209         bPersistantGlobal = TRUE;
 210     // PRIVATE ist Synonym fuer DIM
 211     // _CONST_?
 212     BOOL bConst = FALSE;
 213     if( eCurTok == _CONST_ )
 214         bConst = TRUE;
 215     else if( Peek() == _CONST_ )
 216         Next(), bConst = TRUE;
 217
 218     // #110004 It can also be a sub/function
 219     if( !bConst && (eCurTok == SUB || eCurTok == FUNCTION || eCurTok == PROPERTY ||
 220                     eCurTok == STATIC || eCurTok == ENUM || eCurTok == DECLARE) )
 221     {
 222         // Next token is read here, because !bConst
 223         bool bPrivate = ( eFirstTok == PRIVATE );
 224
 225         if( eCurTok == STATIC )
 226         {
 227             Next();
 228             DefStatic( bPrivate );
 229         }
 230                 else if( eCurTok == DECLARE )
 231                 {
 232                         Next();
 233                         DefDeclare( bPrivate );
 234                         return;
 235                 }
 236         else if( eCurTok == SUB || eCurTok == FUNCTION || eCurTok == PROPERTY )
 237         {
 238             // End global chain if necessary (not done in
 239             // SbiParser::Parse() under these conditions
 240             if( bNewGblDefs && nGblChain == 0 )
 241             {
 242                 nGblChain = aGen.Gen( _JUMP, 0 );
 243                 bNewGblDefs = FALSE;
 244             }
 245             Next();
 246             DefProc( FALSE, bPrivate );
 247             return;
 248         }
 249         else if( eCurTok == ENUM )
 250         {
 251             Next();
 252             DefEnum( bPrivate );
 253             return;
 254         }
 255         else if( eCurTok == DECLARE )
 256         {
 257             Next();
 258             DefDeclare( bPrivate );
 259             return;
 260         }
 261     }
 262
 263 #ifdef SHARED
 264 #define tmpSHARED
 265 #undef SHARED
 266 #endif
 267     // SHARED wird ignoriert
 268     if( Peek() == SHARED ) Next();
 269 #ifdef tmpSHARED
 270 #define SHARED
 271 #undef tmpSHARED
 272 #endif
 273     // PRESERVE nur bei REDIM
 274     if( Peek() == PRESERVE )
 275     {
 276         Next();
 277         if( eOp == _REDIM )
 278             eOp = _REDIMP;
 279         else
 280             Error( SbERR_UNEXPECTED, eCurTok );
 281     }
 282     SbiSymDef* pDef;
 283     SbiDimList* pDim;
 284
 285     // AB 9.7.97, #40689, Statics -> Modul-Initialisierung, in Sub ueberspringen
 286     UINT32 nEndOfStaticLbl = 0;
 287     if( !bVBASupportOn && bStatic )
 288     {
 289         nEndOfStaticLbl = aGen.Gen( _JUMP, 0 );
 290         aGen.Statement();       // bei static hier nachholen
 291     }
 292
 293     BOOL bDefined = FALSE;
 294     while( ( pDef = VarDecl( &pDim, bStatic, bConst ) ) != NULL )
 295     {
 296         EnableErrors();
 297         // Variable suchen:
 298         if( bSwitchPool )
 299             pPool = &aGlobals;
 300         SbiSymDef* pOld = pPool->Find( pDef->GetName() );
 301         // AB 31.3.1996, #25651#, auch in Runtime-Library suchen
 302         BOOL bRtlSym = FALSE;
 303         if( !pOld )
 304         {
 305             pOld = CheckRTLForSym( pDef->GetName(), SbxVARIANT );
 306             if( pOld )
 307                 bRtlSym = TRUE;
 308         }
 309         if( pOld && !(eOp == _REDIM || eOp == _REDIMP) )
 310         {
 311             if( pDef->GetScope() == SbLOCAL && pOld->GetScope() != SbLOCAL )
 312                 pOld = NULL;
 313         }
 314         if( pOld )
 315         {
 316             bDefined = TRUE;
 317             // Bei RTL-Symbol immer Fehler
 318             if( !bRtlSym && (eOp == _REDIM || eOp == _REDIMP) )
 319             {
 320                 // Bei REDIM die Attribute vergleichen
 321                 SbxDataType eDefType;
 322                 bool bError_ = false;
 323                 if( pOld->IsStatic() )
 324                 {
 325                     bError_ = true;
 326                 }
 327                 else if( pOld->GetType() != ( eDefType = pDef->GetType() ) )
 328                 {
 329                     if( !( eDefType == SbxVARIANT && !pDef->IsDefinedAs() ) )
 330                         bError_ = true;
 331                 }
 332                 if( bError_ )
 333                     Error( SbERR_VAR_DEFINED, pDef->GetName() );
 334             }
 335             else
 336                 Error( SbERR_VAR_DEFINED, pDef->GetName() );
 337             delete pDef; pDef = pOld;
 338         }
 339         else
 340             pPool->Add( pDef );
 341
 342         // #36374: Variable vor Unterscheidung IsNew() anlegen
 343         // Sonst Error bei Dim Identifier As New Type und option explicit
 344         if( !bDefined && !(eOp == _REDIM || eOp == _REDIMP)
 345                       && ( !bConst || pDef->GetScope() == SbGLOBAL ) )
 346         {
 347             // Variable oder globale Konstante deklarieren
 348             SbiOpcode eOp2;
 349             switch ( pDef->GetScope() )
 350             {
 351                 case SbGLOBAL:  eOp2 = bPersistantGlobal ? _GLOBAL_P : _GLOBAL;
 352                                 goto global;
 353                 case SbPUBLIC:  eOp2 = bPersistantGlobal ? _PUBLIC_P : _PUBLIC;
 354                                 // AB 9.7.97, #40689, kein eigener Opcode mehr
 355                                 if( bVBASupportOn && bStatic )
 356                                 {
 357                                     eOp2 = _STATIC;
 358                                     break;
 359                                 }
 360                 global:                 aGen.BackChain( nGblChain );
 361                                 nGblChain = 0;
 362                                 bGblDefs = bNewGblDefs = TRUE;
 363                                 break;
 364                 default:                eOp2 = _LOCAL;
 365             }
 366             aGen.Gen(
 367                 eOp2, pDef->GetId(),
 368                 sal::static_int_cast< UINT16 >( pDef->GetType() ) );
 369         }
 370
 371         // Initialisierung fuer selbstdefinierte Datentypen
 372         // und per NEW angelegte Variable
 373         if( pDef->GetType() == SbxOBJECT
 374          && pDef->GetTypeId() )
 375         {
 376             if( !bCompatible && !pDef->IsNew() )
 377             {
 378                 String aTypeName( aGblStrings.Find( pDef->GetTypeId() ) );
 379                 if( rTypeArray->Find( aTypeName, SbxCLASS_OBJECT ) == NULL )
 380                     Error( SbERR_UNDEF_TYPE, aTypeName );
 381             }
 382
 383             if( bConst )
 384             {
 385                 Error( SbERR_SYNTAX );
 386             }
 387
 388             if( pDim )
 389             {
 390                 if( eOp == _REDIMP )
 391                 {
 392                     SbiExpression aExpr( this, *pDef, NULL );
 393                     aExpr.Gen();
 394                     aGen.Gen( _REDIMP_ERASE );
 395
 396                     pDef->SetDims( pDim->GetDims() );
 397                     SbiExpression aExpr2( this, *pDef, pDim );
 398                     aExpr2.Gen();
 399                     aGen.Gen( _DCREATE_REDIMP, pDef->GetId(), pDef->GetTypeId() );
 400                 }
 401                 else
 402                 {
 403                     pDef->SetDims( pDim->GetDims() );
 404                     SbiExpression aExpr( this, *pDef, pDim );
 405                     aExpr.Gen();
 406                     aGen.Gen( _DCREATE, pDef->GetId(), pDef->GetTypeId() );
 407                 }
 408             }
 409             else
 410             {
 411                 SbiExpression aExpr( this, *pDef );
 412                 aExpr.Gen();
 413                 SbiOpcode eOp_ = pDef->IsNew() ? _CREATE : _TCREATE;
 414                 aGen.Gen( eOp_, pDef->GetId(), pDef->GetTypeId() );
 415                                 if ( bVBASupportOn )
 416                                         aGen.Gen( _VBASET );
 417                                 else
 418                 aGen.Gen( _SET );
 419             }
 420         }
 421         else
 422         {
 423             if( bConst )
 424             {
 425                 // Konstanten-Definition
 426                 if( pDim )
 427                 {
 428                     Error( SbERR_SYNTAX );
 429                     delete pDim;
 430                 }
 431                 SbiExpression aVar( this, *pDef );
 432                 if( !TestToken( EQ ) )
 433                     goto MyBreak;       // AB 24.6.1996 (s.u.)
 434                 SbiConstExpression aExpr( this );
 435                 if( !bDefined && aExpr.IsValid() )
 436                 {
 437                     if( pDef->GetScope() == SbGLOBAL )
 438                     {
 439                         // Nur Code fuer globale Konstante erzeugen!
 440                         aVar.Gen();
 441                         aExpr.Gen();
 442                         aGen.Gen( _PUTC );
 443                     }
 444                     SbiConstDef* pConst = pDef->GetConstDef();
 445                     if( aExpr.GetType() == SbxSTRING )
 446                         pConst->Set( aExpr.GetString() );
 447                     else
 448                         pConst->Set( aExpr.GetValue(), aExpr.GetType() );
 449                 }
 450             }
 451             else if( pDim )
 452             {
 453                 // Die Variable dimensionieren
 454                 // Bei REDIM die Var vorher loeschen
 455                 if( eOp == _REDIM )
 456                 {
 457                     SbiExpression aExpr( this, *pDef, NULL );
 458                     aExpr.Gen();
 459                     if ( bVBASupportOn )
 460                         // delete the array but
 461                         // clear the variable ( this
 462                         // allows the processing of
 463                         // the param to happen as normal without errors ( ordinary ERASE just clears the array )
 464                         aGen.Gen( _ERASE_CLEAR );
 465                     else
 466                         aGen.Gen( _ERASE );
 467                 }
 468                 else if( eOp == _REDIMP )
 469                 {
 470                     SbiExpression aExpr( this, *pDef, NULL );
 471                     aExpr.Gen();
 472                     aGen.Gen( _REDIMP_ERASE );
 473                 }
 474                 pDef->SetDims( pDim->GetDims() );
 475                 if( bPersistantGlobal )
 476                     pDef->SetGlobal( TRUE );
 477                 SbiExpression aExpr( this, *pDef, pDim );
 478                 aExpr.Gen();
 479                 pDef->SetGlobal( FALSE );
 480                 aGen.Gen( (eOp == _STATIC) ? _DIM : eOp );
 481             }
 482         }
 483         if( !TestComma() )
 484             goto MyBreak;       // AB 24.6.1996 (s.u.)
 485
 486         // #27963# AB, 24.6.1996
 487         // Einfuehrung bSwitchPool (s.o.): pPool darf beim VarDecl-Aufruf
 488         // noch nicht auf &aGlobals gesetzt sein.
 489         // Ansonsten soll das Verhalten aber absolut identisch bleiben,
 490         // d.h. pPool muss immer am Schleifen-Ende zurueckgesetzt werden.
 491         // auch bei break
 492         pPool = pOldPool;
 493         continue;               // MyBreak überspingen
 494     MyBreak:
 495         pPool = pOldPool;
 496         break;
 497     }
 498
 499     // AB 9.7.97, #40689, Sprung ueber Statics-Deklaration abschliessen
 500     if( !bVBASupportOn && bStatic )
 501     {
 502         // globalen Chain pflegen
 503         nGblChain = aGen.Gen( _JUMP, 0 );
 504         bGblDefs = bNewGblDefs = TRUE;
 505
 506         // fuer Sub Sprung auf Ende der statics eintragen
 507         aGen.BackChain( nEndOfStaticLbl );
 508     }
 509
 510     //pPool = pOldPool;
 511 }
 512
 513 // Hier werden Arrays redimensioniert.
 514
 515 void SbiParser::ReDim()
 516 {
 517     DefVar( _REDIM, (  pProc && bVBASupportOn ) ? pProc->IsStatic() : FALSE );
 518 }
 519
 520 // ERASE array, ...
 521
 522 void SbiParser::Erase()
 523 {
 524     while( !bAbort )
 525     {
 526         if( !TestSymbol() ) return;
 527         String aName( aSym );
 528         SbxDataType eType = eScanType;
 529         SbiSymDef* pDef = pPool->Find( aName );
 530         if( !pDef )
 531         {
 532             if( bExplicit )
 533                 Error( SbERR_UNDEF_VAR, aName );
 534             pDef = pPool->AddSym( aName );
 535             pDef->SetType( eType );
 536         }
 537         SbiExpression aExpr( this, *pDef );
 538         aExpr.Gen();
 539         aGen.Gen( _ERASE );
 540         if( !TestComma() ) break;
 541     }
 542 }
 543
 544 // Deklaration eines Datentyps
 545
 546 void SbiParser::Type()
 547 {
 548     DefType( FALSE );
 549 }
 550
 551 void SbiParser::DefType( BOOL bPrivate )
 552 {
 553     // TODO: Use bPrivate
 554     (void)bPrivate;
 555
 556     // Neues Token lesen, es muss ein Symbol sein
 557     if (!TestSymbol())
 558         return;
 559
 560     if (rTypeArray->Find(aSym,SbxCLASS_OBJECT))
 561     {
 562         Error( SbERR_VAR_DEFINED, aSym );
 563         return;
 564     }
 565
 566     SbxObject *pType = new SbxObject(aSym);
 567
 568     SbiSymDef* pElem;
 569     SbiDimList* pDim = NULL;
 570     BOOL bDone = FALSE;
 571
 572     while( !bDone && !IsEof() )
 573     {
 574         switch( Peek() )
 575         {
 576             case ENDTYPE :
 577                 pElem = NULL;
 578                 bDone = TRUE;
 579                 Next();
 580             break;
 581
 582             case EOLN :
 583             case REM :
 584                 pElem = NULL;
 585                 Next();
 586             break;
 587
 588             default:
 589                 pDim = NULL;
 590                 pElem = VarDecl(&pDim,FALSE,FALSE);
 591                 if( !pElem )
 592                     bDone = TRUE;       // Error occured
 593         }
 594         if( pElem )
 595         {
 596             SbxArray *pTypeMembers = pType -> GetProperties();
 597             if (pTypeMembers -> Find (pElem->GetName(),SbxCLASS_DONTCARE))
 598                 Error (SbERR_VAR_DEFINED);
 599             else
 600             {
 601                 SbxProperty *pTypeElem = new SbxProperty (pElem->GetName(),pElem->GetType());
 602                 if( pDim )
 603                 {
 604                     SbxDimArray* pArray = new SbxDimArray( pElem->GetType() );
 605                     if ( pDim->GetSize() )
 606                     {
 607                         // Dimension the target array
 608
 609                         for ( short i=0; i<pDim->GetSize();++i )
 610                         {
 611                             INT32 ub = -1;
 612                             INT32 lb = nBase;
 613                             SbiExprNode* pNode =  pDim->Get(i)->GetExprNode();
 614                             ub = pNode->GetNumber();
 615                             if ( !pDim->Get( i )->IsBased() ) // each dim is low/up
 616                             {
 617                                 if (  ++i >= pDim->GetSize() ) // trouble
 618                                     StarBASIC::FatalError( SbERR_INTERNAL_ERROR );
 619                                 pNode =  pDim->Get(i)->GetExprNode();
 620                                 lb = ub;
 621                                 ub = pNode->GetNumber();
 622                             }
 623                             else if ( !bCompatible )
 624                                 ub += nBase;
 625                             pArray->AddDim32( lb, ub );
 626                         }
 627                         pArray->setHasFixedSize( true );
 628                     }
 629                     else
 630                         pArray->unoAddDim( 0, -1 ); // variant array
 631                     USHORT nSavFlags = pTypeElem->GetFlags();
 632                     // need to reset the FIXED flag
 633                     // when calling PutObject ( because the type will not match Object )
 634                     pTypeElem->ResetFlag( SBX_FIXED );
 635                     pTypeElem->PutObject( pArray );
 636                     pTypeElem->SetFlags( nSavFlags );
 637                 }
 638                 delete pDim;
 639                 pTypeMembers->Insert( pTypeElem, pTypeMembers->Count() );
 640             }
 641             delete pElem;
 642         }
 643     }
 644
 645     pType->Remove( XubString( RTL_CONSTASCII_USTRINGPARAM("Name") ), SbxCLASS_DONTCARE );
 646     pType->Remove( XubString( RTL_CONSTASCII_USTRINGPARAM("Parent") ), SbxCLASS_DONTCARE );
 647
 648     rTypeArray->Insert (pType,rTypeArray->Count());
 649 }
 650
 651
 652 // Declaration of Enum type
 653
 654 void SbiParser::Enum()
 655 {
 656     DefEnum( FALSE );
 657 }
 658
 659 void SbiParser::DefEnum( BOOL bPrivate )
 660 {
 661     // Neues Token lesen, es muss ein Symbol sein
 662     if (!TestSymbol())
 663         return;
 664
 665     String aEnumName = aSym;
 666     if( rEnumArray->Find(aEnumName,SbxCLASS_OBJECT) )
 667     {
 668         Error( SbERR_VAR_DEFINED, aSym );
 669         return;
 670     }
 671
 672     SbxObject *pEnum = new SbxObject( aEnumName );
 673     if( bPrivate )
 674         pEnum->SetFlag( SBX_PRIVATE );
 675
 676     SbiSymDef* pElem;
 677     SbiDimList* pDim;
 678     BOOL bDone = FALSE;
 679
 680     // Starting with -1 to make first default value 0 after ++
 681     sal_Int32 nCurrentEnumValue = -1;
 682     while( !bDone && !IsEof() )
 683     {
 684         switch( Peek() )
 685         {
 686             case ENDENUM :
 687                 pElem = NULL;
 688                 bDone = TRUE;
 689                 Next();
 690             break;
 691
 692             case EOLN :
 693             case REM :
 694                 pElem = NULL;
 695                 Next();
 696             break;
 697
 698             default:
 699             {
 700                 // TODO: Check existing!
 701                 BOOL bDefined = FALSE;
 702
 703                 pDim = NULL;
 704                 pElem = VarDecl( &pDim, FALSE, TRUE );
 705                 if( !pElem )
 706                 {
 707                     bDone = TRUE;       // Error occured
 708                     break;
 709                 }
 710                 else if( pDim )
 711                 {
 712                     delete pDim;
 713                     Error( SbERR_SYNTAX );
 714                     bDone = TRUE;       // Error occured
 715                     break;
 716                 }
 717
 718                 SbiExpression aVar( this, *pElem );
 719                 if( Peek() == EQ )
 720                 {
 721                     Next();
 722
 723                     SbiConstExpression aExpr( this );
 724                     if( !bDefined && aExpr.IsValid() )
 725                     {
 726                         SbxVariableRef xConvertVar = new SbxVariable();
 727                         if( aExpr.GetType() == SbxSTRING )
 728                             xConvertVar->PutString( aExpr.GetString() );
 729                         else
 730                             xConvertVar->PutDouble( aExpr.GetValue() );
 731
 732                         nCurrentEnumValue = xConvertVar->GetLong();
 733                     }
 734                 }
 735                 else
 736                     nCurrentEnumValue++;
 737
 738                 SbiSymPool* pPoolToUse = bPrivate ? pPool : &aGlobals;
 739
 740                 SbiSymDef* pOld = pPoolToUse->Find( pElem->GetName() );
 741                 if( pOld )
 742                 {
 743                     Error( SbERR_VAR_DEFINED, pElem->GetName() );
 744                     bDone = TRUE;       // Error occured
 745                     break;
 746                 }
 747
 748                 pPool->Add( pElem );
 749
 750                 if( !bPrivate )
 751                 {
 752                     SbiOpcode eOp = _GLOBAL;
 753                     aGen.BackChain( nGblChain );
 754                     nGblChain = 0;
 755                     bGblDefs = bNewGblDefs = TRUE;
 756                     aGen.Gen(
 757                         eOp, pElem->GetId(),
 758                         sal::static_int_cast< UINT16 >( pElem->GetType() ) );
 759
 760                     aVar.Gen();
 761                     USHORT nStringId = aGen.GetParser()->aGblStrings.Add( nCurrentEnumValue, SbxLONG );
 762                     aGen.Gen( _NUMBER, nStringId );
 763                     aGen.Gen( _PUTC );
 764                 }
 765
 766                 SbiConstDef* pConst = pElem->GetConstDef();
 767                 pConst->Set( nCurrentEnumValue, SbxLONG );
 768             }
 769         }
 770         if( pElem )
 771         {
 772             SbxArray *pEnumMembers = pEnum->GetProperties();
 773             SbxProperty *pEnumElem = new SbxProperty( pElem->GetName(), SbxLONG );
 774             pEnumElem->PutLong( nCurrentEnumValue );
 775             pEnumElem->ResetFlag( SBX_WRITE );
 776             pEnumElem->SetFlag( SBX_CONST );
 777             pEnumMembers->Insert( pEnumElem, pEnumMembers->Count() );
 778         }
 779     }
 780
 781     pEnum->Remove( XubString( RTL_CONSTASCII_USTRINGPARAM("Name") ), SbxCLASS_DONTCARE );
 782     pEnum->Remove( XubString( RTL_CONSTASCII_USTRINGPARAM("Parent") ), SbxCLASS_DONTCARE );
 783
 784     rEnumArray->Insert( pEnum, rEnumArray->Count() );
 785 }
 786
 787
 788 // Prozedur-Deklaration
 789 // das erste Token ist bereits eingelesen (SUB/FUNCTION)
 790 // xxx Name [LIB "name"[ALIAS "name"]][(Parameter)][AS TYPE]
 791
 792 SbiProcDef* SbiParser::ProcDecl( BOOL bDecl )
 793 {
 794     BOOL bFunc = BOOL( eCurTok == FUNCTION );
 795     BOOL bProp = BOOL( eCurTok == GET || eCurTok == SET || eCurTok == LET );
 796     if( !TestSymbol() ) return NULL;
 797     String aName( aSym );
 798     SbxDataType eType = eScanType;
 799     SbiProcDef* pDef = new SbiProcDef( this, aName, true );
 800     pDef->SetType( eType );
 801     if( Peek() == _CDECL_ )
 802     {
 803         Next(); pDef->SetCdecl();
 804     }
 805     if( Peek() == LIB )
 806     {
 807         Next();
 808         if( Next() == FIXSTRING )
 809             pDef->GetLib() = aSym;
 810         else
 811             Error( SbERR_SYNTAX );
 812     }
 813     if( Peek() == ALIAS )
 814     {
 815         Next();
 816         if( Next() == FIXSTRING )
 817             pDef->GetAlias() = aSym;
 818         else
 819             Error( SbERR_SYNTAX );
 820     }
 821     if( !bDecl )
 822     {
 823         // CDECL, LIB und ALIAS sind unzulaessig
 824         if( pDef->GetLib().Len() )
 825             Error( SbERR_UNEXPECTED, LIB );
 826         if( pDef->GetAlias().Len() )
 827             Error( SbERR_UNEXPECTED, ALIAS );
 828         if( pDef->IsCdecl() )
 829             Error( SbERR_UNEXPECTED, _CDECL_ );
 830         pDef->SetCdecl( FALSE );
 831         pDef->GetLib().Erase();
 832         pDef->GetAlias().Erase();
 833     }
 834     else if( !pDef->GetLib().Len() )
 835     {
 836         // ALIAS und CDECL nur zusammen mit LIB
 837         if( pDef->GetAlias().Len() )
 838             Error( SbERR_UNEXPECTED, ALIAS );
 839         if( pDef->IsCdecl() )
 840             Error( SbERR_UNEXPECTED, _CDECL_ );
 841         pDef->SetCdecl( FALSE );
 842         pDef->GetAlias().Erase();
 843     }
 844     // Klammern?
 845     if( Peek() == LPAREN )
 846     {
 847         Next();
 848         if( Peek() == RPAREN )
 849             Next();
 850         else
 851           for(;;) {
 852             BOOL bByVal = FALSE;
 853             BOOL bOptional = FALSE;
 854             BOOL bParamArray = FALSE;
 855             while( Peek() == BYVAL || Peek() == BYREF || Peek() == _OPTIONAL_ )
 856             {
 857                 if              ( Peek() == BYVAL )             Next(), bByVal = TRUE;
 858                 else if ( Peek() == BYREF )             Next(), bByVal = FALSE;
 859                 else if ( Peek() == _OPTIONAL_ )        Next(), bOptional = TRUE;
 860             }
 861             if( bCompatible && Peek() == PARAMARRAY )
 862             {
 863                 if( bByVal || bByVal || bOptional )
 864                     Error( SbERR_UNEXPECTED, PARAMARRAY );
 865                 Next();
 866                 bParamArray = TRUE;
 867             }
 868             SbiSymDef* pPar = VarDecl( NULL, FALSE, FALSE );
 869             if( !pPar )
 870                 break;
 871             if( bByVal )
 872                 pPar->SetByVal();
 873             if( bOptional )
 874                 pPar->SetOptional();
 875             if( bParamArray )
 876                 pPar->SetParamArray();
 877             pDef->GetParams().Add( pPar );
 878             SbiToken eTok = Next();
 879             if( eTok != COMMA && eTok != RPAREN )
 880             {
 881                 BOOL bError2 = TRUE;
 882                 if( bOptional && bCompatible && eTok == EQ )
 883                 {
 884                     SbiConstExpression* pDefaultExpr = new SbiConstExpression( this );
 885                     SbxDataType eType2 = pDefaultExpr->GetType();
 886
 887                     USHORT nStringId;
 888                     if( eType2 == SbxSTRING )
 889                         nStringId = aGblStrings.Add( pDefaultExpr->GetString() );
 890                     else
 891                         nStringId = aGblStrings.Add( pDefaultExpr->GetValue(), eType2 );
 892
 893                     pPar->SetDefaultId( nStringId );
 894                     delete pDefaultExpr;
 895
 896                     eTok = Next();
 897                     if( eTok == COMMA || eTok == RPAREN )
 898                         bError2 = FALSE;
 899                 }
 900                 if( bError2 )
 901                 {
 902                     Error( SbERR_EXPECTED, RPAREN );
 903                     break;
 904                 }
 905             }
 906             if( eTok == RPAREN )
 907                 break;
 908         }
 909     }
 910     TypeDecl( *pDef );
 911     if( eType != SbxVARIANT && pDef->GetType() != eType )
 912         Error( SbERR_BAD_DECLARATION, aName );
 913 //      if( pDef->GetType() == SbxOBJECT )
 914 //              pDef->SetType( SbxVARIANT ),
 915 //              Error( SbERR_SYNTAX );
 916     if( pDef->GetType() == SbxVARIANT && !( bFunc || bProp ) )
 917         pDef->SetType( SbxEMPTY );
 918     return pDef;
 919 }
 920
 921 // DECLARE
 922
 923 void SbiParser::Declare()
 924 {
 925     DefDeclare( FALSE );
 926 }
 927
 928 void SbiParser::DefDeclare( BOOL bPrivate )
 929 {
 930     Next();
 931     if( eCurTok != SUB && eCurTok != FUNCTION )
 932       Error( SbERR_UNEXPECTED, eCurTok );
 933     else
 934     {
 935         SbiProcDef* pDef = ProcDecl( TRUE );
 936         if( pDef )
 937         {
 938             if( !pDef->GetLib().Len() )
 939                 Error( SbERR_EXPECTED, LIB );
 940             // gibts den schon?
 941             SbiSymDef* pOld = aPublics.Find( pDef->GetName() );
 942             if( pOld )
 943             {
 944                 SbiProcDef* p = pOld->GetProcDef();
 945                 if( !p )
 946                 {
 947                     // Als Variable deklariert
 948                     Error( SbERR_BAD_DECLARATION, pDef->GetName() );
 949                     delete pDef;
 950                     pDef = NULL;
 951                 }
 952                 else
 953                     pDef->Match( p );
 954             }
 955             else
 956                 aPublics.Add( pDef );
 957
 958             if ( pDef )
 959                 pDef->SetPublic( !bPrivate );
 960         }
 961     }
 962 }
 963
 964 void SbiParser::Attribute()
 965 {
 966         // TODO: Need to implement the method as an attributed object.
 967         while( Next() != EQ )
 968         {
 969                 String aSym( GetSym() );
 970                 if( Next() != DOT)
 971                         break;
 972         }
 973
 974         if( eCurTok != EQ )
 975                 Error( SbERR_SYNTAX );
 976         else
 977                 SbiExpression aValue( this );
 978
 979         // Don't generate any code - just discard it.
 980 }
 981
 982 // Aufruf einer SUB oder FUNCTION
 983
 984 void SbiParser::Call()
 985 {
 986     String aName( aSym );
 987     SbiExpression aVar( this, SbSYMBOL );
 988     aVar.Gen( FORCE_CALL );
 989     aGen.Gen( _GET );
 990 }
 991
 992 // SUB/FUNCTION
 993
 994 void SbiParser::SubFunc()
 995 {
 996     DefProc( FALSE, FALSE );
 997 }
 998
 999 // Einlesen einer Prozedur
1000
1001 BOOL runsInSetup( void );
1002
1003 void SbiParser::DefProc( BOOL bStatic, BOOL bPrivate )
1004 {
1005     USHORT l1 = nLine, l2 = nLine;
1006     BOOL bSub = BOOL( eCurTok == SUB );
1007     BOOL bProperty = BOOL( eCurTok == PROPERTY );
1008     PropertyMode ePropertyMode = PROPERTY_MODE_NONE;
1009     if( bProperty )
1010     {
1011         Next();
1012         if( eCurTok == GET )
1013             ePropertyMode = PROPERTY_MODE_GET;
1014         else if( eCurTok == LET )
1015             ePropertyMode = PROPERTY_MODE_LET;
1016         else if( eCurTok == SET )
1017             ePropertyMode = PROPERTY_MODE_SET;
1018         else
1019             Error( SbERR_EXPECTED, "Get or Let or Set" );
1020     }
1021
1022     SbiToken eExit = eCurTok;
1023     SbiProcDef* pDef = ProcDecl( FALSE );
1024     if( !pDef )
1025         return;
1026     pDef->setPropertyMode( ePropertyMode );
1027
1028     // Ist die Proc bereits deklariert?
1029     SbiSymDef* pOld = aPublics.Find( pDef->GetName() );
1030     if( pOld )
1031     {
1032         bool bError_ = false;
1033
1034         pProc = pOld->GetProcDef();
1035         if( !pProc )
1036         {
1037             // Als Variable deklariert
1038             Error( SbERR_BAD_DECLARATION, pDef->GetName() );
1039             delete pDef;
1040             pProc = NULL;
1041             bError_ = true;
1042         }
1043         // #100027: Multiple declaration -> Error
1044         // #112787: Not for setup, REMOVE for 8
1045         else if( !runsInSetup() && pProc->IsUsedForProcDecl() )
1046         {
1047             PropertyMode ePropMode = pDef->getPropertyMode();
1048             if( ePropMode == PROPERTY_MODE_NONE || ePropMode == pProc->getPropertyMode() )
1049             {
1050                 Error( SbERR_PROC_DEFINED, pDef->GetName() );
1051                 delete pDef;
1052                 pProc = NULL;
1053                 bError_ = true;
1054             }
1055         }
1056
1057         if( !bError_ )
1058         {
1059             pDef->Match( pProc );
1060             pProc = pDef;
1061         }
1062     }
1063     else
1064         aPublics.Add( pDef ), pProc = pDef;
1065
1066     if( !pProc )
1067         return;
1068     pProc->SetPublic( !bPrivate );
1069
1070     // Nun setzen wir die Suchhierarchie fuer Symbole sowie die aktuelle
1071     // Prozedur.
1072     aPublics.SetProcId( pProc->GetId() );
1073     pProc->GetParams().SetParent( &aPublics );
1074     if( bStatic )
1075         {
1076         if ( bVBASupportOn )
1077             pProc->SetStatic( TRUE );
1078         else
1079             Error( SbERR_NOT_IMPLEMENTED ); // STATIC SUB ...
1080         }
1081      else
1082     {
1083         pProc->SetStatic( FALSE );
1084         }
1085     // Normalfall: Lokale Variable->Parameter->Globale Variable
1086     pProc->GetLocals().SetParent( &pProc->GetParams() );
1087     pPool = &pProc->GetLocals();
1088
1089     pProc->Define();
1090     OpenBlock( eExit );
1091     StmntBlock( bSub ? ENDSUB : (bProperty ? ENDPROPERTY : ENDFUNC) );
1092     l2 = nLine;
1093     pProc->SetLine1( l1 );
1094     pProc->SetLine2( l2 );
1095     pPool = &aPublics;
1096     aPublics.SetProcId( 0 );
1097     // Offene Labels?
1098     pProc->GetLabels().CheckRefs();
1099     CloseBlock();
1100     aGen.Gen( _LEAVE );
1101     pProc = NULL;
1102 }
1103
1104 // STATIC variable|procedure
1105
1106 void SbiParser::Static()
1107 {
1108     DefStatic( FALSE );
1109 }
1110
1111 void SbiParser::DefStatic( BOOL bPrivate )
1112 {
1113     switch( Peek() )
1114     {
1115         case SUB:
1116         case FUNCTION:
1117         case PROPERTY:
1118             // End global chain if necessary (not done in
1119             // SbiParser::Parse() under these conditions
1120             if( bNewGblDefs && nGblChain == 0 )
1121             {
1122                 nGblChain = aGen.Gen( _JUMP, 0 );
1123                 bNewGblDefs = FALSE;
1124             }
1125             Next();
1126             DefProc( TRUE, bPrivate );
1127             break;
1128         default: {
1129             if( !pProc )
1130                 Error( SbERR_NOT_IN_SUBR );
1131             // Pool umsetzen, damit STATIC-Deklarationen im globalen
1132             // Pool landen
1133             SbiSymPool* p = pPool; pPool = &aPublics;
1134             DefVar( _STATIC, TRUE );
1135             pPool = p;
1136             } break;
1137     }
1138 }
1139