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