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