xref: /trunk/main/basic/source/comp/dim.cxx (revision cdf0e10c)
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