src/fortrancode.l

   1 /******************************************************************************
   2  *
   3  * Parser for syntax hightlighting and references for Fortran90 F subset
   4  *
   5  * Copyright (C) by Anke Visser
   6  * based on the work of Dimitri van Heesch.
   7  *
   8  * Permission to use, copy, modify, and distribute this software and its
   9  * documentation under the terms of the GNU General Public License is hereby
  10  * granted. No representations are made about the suitability of this software
  11  * for any purpose. It is provided "as is" without express or implied warranty.
  12  * See the GNU General Public License for more details.
  13  *
  14  * Documents produced by Doxygen are derivative works derived from the
  15  * input used in their production; they are not affected by this license.
  16  *
  17  */
  18
  19 /**
  20  @todo - continutation lines not always recognized
  21        - merging of use-statements with same module name and different only-names
  22        - rename part of use-statement
  23        - links to interface functions
  24        - references to variables
  25 **/
  26
  27 %{
  28
  29 /*
  30  *      includes
  31  */
  32 #include "qtbc.h"
  33 #include <stdio.h>
  34 #include <assert.h>
  35 #include <ctype.h>
  36 #include <qregexp.h>
  37 #include <qdir.h>
  38 #include <qstringlist.h>
  39 #include "entry.h"
  40 #include "doxygen.h"
  41 #include "message.h"
  42 #include "outputlist.h"
  43 #include "util.h"
  44 #include "membername.h"
  45 #include "searchindex.h"
  46 #include "defargs.h"
  47
  48 #define YY_NEVER_INTERACTIVE 1
  49 #define YY_NO_TOP_STATE 1
  50 #define YY_NO_INPUT 1
  51
  52 //--------------------------------------------------------------------------------
  53
  54 /**
  55   data of an use-statement
  56 */
  57 class UseEntry
  58 {
  59  public:
  60    QCString module; // just for debug
  61    QStringList onlyNames;   /* entries of the ONLY-part */
  62 };
  63
  64 /**
  65   module name -> list of ONLY/remote entries
  66   (module name = name of the module, which can be accessed via use-directive)
  67 */
  68 class UseSDict : public SDict<UseEntry>
  69 {
  70   public:
  71     UseSDict() : SDict<UseEntry>(17) {}
  72 };
  73
  74 /**
  75   Contains names of used modules and names of local variables.
  76 */
  77 class Scope
  78 {
  79   public:
  80     QStringList useNames; //!< contains names of used modules
  81     QDict<void> localVars; //!< contains names of local variables
  82
  83     Scope() : localVars(7, FALSE /*caseSensitive*/) {}
  84 };
  85
  86 /*===================================================================*/
  87 /*
  88  *      statics
  89  */
  90
  91 static QCString  docBlock;                   //!< contents of all lines of a documentation block
  92 static QCString  currentModule=0;            //!< name of the current enclosing module
  93 static UseSDict  *useMembers= new UseSDict;  //!< info about used modules
  94 static UseEntry  *useEntry = 0;              //!< current use statement info
  95 static QList<Scope> scopeStack;
  96 // static QStringList *currentUseNames= new QStringList; //! contains names of used modules of current program unit
  97 static QCString str="";         //!> contents of fortran string
  98
  99 static CodeOutputInterface * g_code;
 100
 101 // TODO: is this still needed? if so, make it work
 102 static QCString      g_parmType;
 103 static QCString      g_parmName;
 104
 105 static const char *  g_inputString;     //!< the code fragment as text
 106 static int           g_inputPosition;   //!< read offset during parsing
 107 static int           g_inputLines;      //!< number of line in the code fragment
 108 static int           g_yyLineNr;        //!< current line number
 109 static bool          g_needsTermination;
 110 static Definition   *g_searchCtx;
 111 static bool          g_isFixedForm;
 112
 113 static bool          g_insideBody;      //!< inside subprog/program body? => create links
 114 static const char *  g_currentFontClass;
 115
 116 static bool          g_exampleBlock;
 117 static QCString      g_exampleName;
 118 static QCString      g_exampleFile;
 119
 120 static FileDef *     g_sourceFileDef;
 121 static Definition *  g_currentDefinition;
 122 static MemberDef *   g_currentMemberDef;
 123 static bool          g_includeCodeFragment;
 124
 125 static char          stringStartSymbol; // single or double quote
 126 // count in variable declaration to filter out
 127 //  declared from referenced names
 128 static int           bracketCount = 0;
 129
 130 // simplified way to know if this is fixed form
 131 // duplicate in fortranscanner.l
 132 static bool recognizeFixedForm(const char* contents)
 133 {
 134   int column=0;
 135   bool skipLine=FALSE;
 136
 137   for (int i=0;;i++)
 138   {
 139     column++;
 140
 141     switch(contents[i])
 142     {
 143       case '\n':
 144         column=0;
 145         skipLine=FALSE;
 146         break;
 147       case ' ':
 148         break;
 149       case '\000':
 150         return FALSE;
 151       case 'C':
 152       case 'c':
 153       case '*':
 154         if(column==1) return TRUE;
 155         if(skipLine) break;
 156         return FALSE;
 157       case '!':
 158         if(column>1 && column<7) return FALSE;
 159         skipLine=TRUE;
 160         break;
 161       default:
 162         if(skipLine) break;
 163         if(column==7) return TRUE;
 164         return FALSE;
 165     }
 166   }
 167   return FALSE;
 168 }
 169
 170 static void endFontClass()
 171 {
 172   if (g_currentFontClass)
 173   {
 174     g_code->endFontClass();
 175     g_currentFontClass=0;
 176   }
 177 }
 178
 179 static void startFontClass(const char *s)
 180 {
 181   endFontClass();
 182   g_code->startFontClass(s);
 183   g_currentFontClass=s;
 184 }
 185
 186 static void setCurrentDoc(const QCString &anchor)
 187 {
 188   if (Doxygen::searchIndex)
 189   {
 190     if (g_searchCtx)
 191     {
 192       Doxygen::searchIndex->setCurrentDoc(g_searchCtx,g_searchCtx->anchor(),FALSE);
 193     }
 194     else
 195     {
 196       Doxygen::searchIndex->setCurrentDoc(g_sourceFileDef,anchor,TRUE);
 197     }
 198   }
 199 }
 200
 201 static void addToSearchIndex(const char *text)
 202 {
 203   if (Doxygen::searchIndex)
 204   {
 205     Doxygen::searchIndex->addWord(text,FALSE);
 206   }
 207 }
 208
 209 /*! start a new line of code, inserting a line number if g_sourceFileDef
 210  * is TRUE. If a definition starts at the current line, then the line
 211  * number is linked to the documentation of that definition.
 212  */
 213 static void startCodeLine()
 214 {
 215   if (g_sourceFileDef)
 216   {
 217     //QCString lineNumber,lineAnchor;
 218     //lineNumber.sprintf("%05d",g_yyLineNr);
 219     //lineAnchor.sprintf("l%05d",g_yyLineNr);
 220
 221     Definition *d   = g_sourceFileDef->getSourceDefinition(g_yyLineNr);
 222     //printf("startCodeLine %d d=%s\n", g_yyLineNr,d ? d->name().data() : "<null>");
 223     if (!g_includeCodeFragment && d)
 224     {
 225       g_currentDefinition = d;
 226       g_currentMemberDef = g_sourceFileDef->getSourceMember(g_yyLineNr);
 227       g_insideBody = FALSE;
 228       g_parmType.resize(0);
 229       g_parmName.resize(0);
 230       QCString lineAnchor;
 231       lineAnchor.sprintf("l%05d",g_yyLineNr);
 232       if (g_currentMemberDef)
 233       {
 234         g_code->writeLineNumber(g_currentMemberDef->getReference(),
 235                                 g_currentMemberDef->getOutputFileBase(),
 236                                 g_currentMemberDef->anchor(),g_yyLineNr);
 237         setCurrentDoc(lineAnchor);
 238       }
 239       else if (d->isLinkableInProject())
 240       {
 241         g_code->writeLineNumber(d->getReference(),
 242                                 d->getOutputFileBase(),
 243                                 0,g_yyLineNr);
 244         setCurrentDoc(lineAnchor);
 245       }
 246     }
 247     else
 248     {
 249       g_code->writeLineNumber(0,0,0,g_yyLineNr);
 250     }
 251   }
 252   g_code->startCodeLine(g_sourceFileDef);
 253   if (g_currentFontClass)
 254   {
 255     g_code->startFontClass(g_currentFontClass);
 256   }
 257 }
 258
 259
 260 static void endFontClass();
 261 static void endCodeLine()
 262 {
 263   endFontClass();
 264   g_code->endCodeLine();
 265 }
 266
 267 /*! write a code fragment `text' that may span multiple lines, inserting
 268  * line numbers for each line.
 269  */
 270 static void codifyLines(char *text)
 271 {
 272   //printf("codifyLines(%d,\"%s\")\n",g_yyLineNr,text);
 273   char *p=text,*sp=p;
 274   char c;
 275   bool done=FALSE;
 276   const char *  tmp_currentFontClass = g_currentFontClass;
 277   while (!done)
 278   {
 279     sp=p;
 280     while ((c=*p++) && c!='\n') { }
 281     if (c=='\n')
 282     {
 283       g_yyLineNr++;
 284       *(p-1)='\0';
 285       g_code->codify(sp);
 286       endCodeLine();
 287       if (g_yyLineNr<g_inputLines)
 288       {
 289         startCodeLine();
 290       }
 291       if (tmp_currentFontClass)
 292       {
 293         startFontClass(tmp_currentFontClass);
 294       }
 295     }
 296     else
 297     {
 298       g_code->codify(sp);
 299       done=TRUE;
 300     }
 301   }
 302 }
 303
 304 static void codifyLines(QCString str)
 305 {
 306   char *tmp= (char *) malloc(str.length()+1);
 307   strcpy(tmp, str);
 308   codifyLines(tmp);
 309   free(tmp);
 310 }
 311
 312 /*! writes a link to a fragment \a text that may span multiple lines, inserting
 313  * line numbers for each line. If \a text contains newlines, the link will be
 314  * split into multiple links with the same destination, one for each line.
 315  */
 316 static void writeMultiLineCodeLink(CodeOutputInterface &ol,
 317                   const char *ref,const char *file,
 318                   const char *anchor,const char *text)
 319 {
 320   bool done=FALSE;
 321   char *p=(char *)text;
 322   while (!done)
 323   {
 324     char *sp=p;
 325     char c;
 326     while ((c=*p++) && c!='\n') { }
 327     if (c=='\n')
 328     {
 329       g_yyLineNr++;
 330       *(p-1)='\0';
 331       //printf("writeCodeLink(%s,%s,%s,%s)\n",ref,file,anchor,sp);
 332       ol.writeCodeLink(ref,file,anchor,sp,0);
 333       endCodeLine();
 334       if (g_yyLineNr<g_inputLines)
 335       {
 336         startCodeLine();
 337       }
 338     }
 339     else
 340     {
 341       //printf("writeCodeLink(%s,%s,%s,%s)\n",ref,file,anchor,sp);
 342       ol.writeCodeLink(ref,file,anchor,sp,0);
 343       done=TRUE;
 344     }
 345   }
 346 }
 347
 348 /**
 349   generates dictionay entries that are used if REFERENCED_BY_RELATION ... options are set
 350   (e.g. the "referenced by ..." list after the function documentation)
 351 */
 352
 353 static void addDocCrossReference(MemberDef *src, MemberDef *dst)
 354 {
 355   if (dst->isTypedef() || dst->isEnumerate()) return; // don't add types
 356  //printf("======= addDocCrossReference src=%s,dst=%s\n",src->name().data(),dst->name().data());
 357   if ((Config_getBool("REFERENCED_BY_RELATION") || Config_getBool("CALLER_GRAPH")) &&
 358       (src->isFunction()))
 359   {
 360     dst->addSourceReferencedBy(src);
 361   }
 362   if ((Config_getBool("REFERENCES_RELATION") || Config_getBool("CALL_GRAPH")) && (src->isFunction()))
 363   {
 364     src->addSourceReferences(dst);
 365   }
 366 }
 367
 368 //-------------------------------------------------------------------------------
 369 /**
 370   searches for definition of a type
 371   @param tname the name of the type
 372   @param moduleName name of enclosing module or null, if global entry
 373   @param cd the entry, if found or null
 374   @param useDict dictionary of data of USE-statement
 375   @returns true, if type is found
 376 */
 377 static bool getFortranTypeDefs(const QCString &tname, const QCString &moduleName,
 378                                ClassDef *&cd, UseSDict *usedict=0)
 379 {
 380   if (tname.isEmpty()) return FALSE; /* empty name => nothing to link */
 381
 382   //cout << "=== search for type: " << tname << endl;
 383
 384   // search for type
 385   if ((cd=Doxygen::classSDict->find(tname)))
 386   {
 387     //cout << "=== type found in global module" << endl;
 388     return TRUE;
 389   }
 390   else if (moduleName && (cd= Doxygen::classSDict->find(moduleName+"::"+tname)))
 391   {
 392     //cout << "=== type found in local module" << endl;
 393     return TRUE;
 394   }
 395   else
 396   {
 397     UseEntry *use;
 398     for (UseSDict::Iterator di(*usedict); (use=di.current()); ++di)
 399     {
 400       if ((cd= Doxygen::classSDict->find(use->module+"::"+tname)))
 401       {
 402         //cout << "===  type found in used module" << endl;
 403         return TRUE;
 404       }
 405     }
 406   }
 407
 408   return FALSE;
 409 }
 410
 411 /**
 412   searches for definition of function memberName
 413   @param memberName the name of the function/variable
 414   @param moduleName name of enclosing module or null, if global entry
 415   @param md the entry, if found or null
 416   @param usedict array of data of USE-statement
 417   @returns true, if found
 418 */
 419 static bool getFortranDefs(const QCString &memberName, const QCString &moduleName,
 420                            MemberDef *&md, UseSDict *usedict=0)
 421 {
 422   if (memberName.isEmpty()) return FALSE; /* empty name => nothing to link */
 423
 424   // look in local variables
 425   for (Scope *scope=scopeStack.last(); scope!=NULL; scope=scopeStack.prev())
 426   {
 427     if(scope->localVars.find(memberName))
 428       return FALSE;
 429   }
 430
 431   // search for function
 432   MemberName *mn = Doxygen::functionNameSDict->find(memberName);
 433   if (!mn)
 434   {
 435     mn = Doxygen::memberNameSDict->find(memberName);
 436   }
 437
 438   if (mn) // name is known
 439   {
 440       MemberListIterator mli(*mn);
 441       for (mli.toFirst();(md=mli.current());++mli) // all found functions with given name
 442       {
 443         FileDef  *fd=md->getFileDef();
 444         GroupDef *gd=md->getGroupDef();
 445
 446  //cout << "found link with same name: " << fd->fileName() << "  " <<  memberName;
 447  //if (md->getNamespaceDef() != 0) cout << " in namespace " << md->getNamespaceDef()->name();cout << endl;
 448
 449         if ((gd && gd->isLinkable()) || (fd && fd->isLinkable()))
 450         {
 451            NamespaceDef *nspace= md->getNamespaceDef();
 452
 453            if (nspace == 0)
 454            { // found function in global scope
 455              return TRUE;
 456            }
 457            else if (moduleName == nspace->name())
 458            { // found in local scope
 459              return TRUE;
 460            }
 461            else
 462            { // else search in used modules
 463              QCString moduleName= nspace->name();
 464              UseEntry *ue= usedict->find(moduleName);
 465              if (ue)
 466              {
 467                // check if only-list exists and if current entry exists is this list
 468                QStringList &only= ue->onlyNames;
 469                if (only.isEmpty())
 470                {
 471                //cout << " found in module " << moduleName << " entry " << memberName <<  endl;
 472                  return TRUE; // whole module used
 473                }
 474                else
 475                {
 476                  for ( QStringList::Iterator it = only.begin(); it != only.end(); ++it)
 477                  {
 478                    //cout << " search in only: " << moduleName << ":: " << memberName << "==" << (*it)<<  endl;
 479                    if (memberName == (*it).utf8())
 480                    {
 481                      return TRUE; // found in ONLY-part of use list
 482                    }
 483                  }
 484                }
 485              }
 486            }
 487         } // if linkable
 488       } // for
 489   }
 490   return FALSE;
 491 }
 492
 493 /**
 494  gets the link to a generic procedure which depends not on the name, but on the parameter list
 495  @todo implementation
 496 */
 497 static bool getGenericProcedureLink(const ClassDef *cd,
 498                                     const char *memberText,
 499                                     CodeOutputInterface &ol)
 500 {
 501   (void)cd;
 502   (void)memberText;
 503   (void)ol;
 504   return FALSE;
 505 }
 506
 507 static bool getLink(UseSDict *usedict, // dictonary with used modules
 508                     const char *memberText,  // exact member text
 509                     CodeOutputInterface &ol,
 510                     const char *text)
 511 {
 512   MemberDef *md;
 513   QCString memberName= removeRedundantWhiteSpace(memberText);
 514
 515   if (getFortranDefs(memberName, currentModule, md, usedict) && md->isLinkable())
 516   {
 517     //if (md->isVariable()) return FALSE; // variables aren't handled yet
 518
 519     Definition *d = md->getOuterScope()==Doxygen::globalScope ?
 520                     md->getBodyDef() : md->getOuterScope();
 521     if (md->getGroupDef()) d = md->getGroupDef();
 522     if (d && d->isLinkable())
 523     {
 524       if (g_currentDefinition && g_currentMemberDef && md!=g_currentMemberDef && g_insideBody)
 525       {
 526         addDocCrossReference(g_currentMemberDef,md);
 527       }
 528       ol.linkableSymbol(g_yyLineNr,md->name(),md,
 529                         g_currentMemberDef ? g_currentMemberDef : g_currentDefinition);
 530       writeMultiLineCodeLink(ol,md->getReference(),
 531                                 md->getOutputFileBase(),
 532                                 md->anchor(),
 533                                 text ? text : memberText);
 534       addToSearchIndex(text ? text : memberText);
 535       return TRUE;
 536     }
 537   }
 538   return FALSE;
 539 }
 540
 541
 542 static void generateLink(CodeOutputInterface &ol, char *lname)
 543 {
 544   ClassDef *cd=0;
 545   QCString tmp = lname;
 546   tmp = removeRedundantWhiteSpace(tmp.lower());
 547
 548   // check if lowercase lname is a linkable type or interface
 549   if ( (getFortranTypeDefs(tmp, currentModule, cd, useMembers)) && cd->isLinkable() )
 550   {
 551     if ( (cd->compoundType() == ClassDef::Class) && // was  Entry::INTERFACE_SEC) &&
 552          (getGenericProcedureLink(cd, tmp, ol)) )
 553     {
 554       //cout << "=== generic procedure resolved" << endl;
 555     }
 556     else
 557     { // write type or interface link
 558       ol.linkableSymbol(g_yyLineNr, tmp, cd, g_currentMemberDef?g_currentMemberDef:g_currentDefinition);
 559       writeMultiLineCodeLink(ol,cd->getReference(),cd->getOutputFileBase(),cd->anchor(),tmp);
 560       addToSearchIndex(tmp.data());
 561     }
 562   }
 563   // check for function/variable
 564   else if (getLink(useMembers, tmp, ol, tmp))
 565   {
 566     //cout << "=== found link for lowercase " << lname << endl;
 567   }
 568   else
 569   {
 570     // nothing found, just write out the word
 571     ol.linkableSymbol(g_yyLineNr, tmp, 0, g_currentMemberDef?g_currentMemberDef:g_currentDefinition);
 572     //startFontClass("charliteral"); //test
 573     codifyLines(tmp);
 574     //endFontClass(); //test
 575     addToSearchIndex(tmp.data());
 576   }
 577 }
 578
 579 /*! counts the number of lines in the input */
 580 static int countLines()
 581 {
 582   const char *p=g_inputString;
 583   char c;
 584   int count=1;
 585   while ((c=*p))
 586   {
 587     p++ ;
 588     if (c=='\n') count++;
 589   }
 590   if (p>g_inputString && *(p-1)!='\n')
 591   { // last line does not end with a \n, so we add an extra
 592     // line and explicitly terminate the line after parsing.
 593     count++,
 594     g_needsTermination=TRUE;
 595   }
 596   return count;
 597 }
 598
 599 //----------------------------------------------------------------------------
 600 /** start scope */
 601 static void startScope()
 602 {
 603   // fprintf(stderr, "===> startScope %s",yytext);
 604   Scope *scope = new Scope;
 605   scopeStack.append(scope);
 606 }
 607
 608 /** end scope */
 609 static void endScope()
 610 {
 611   // fprintf(stderr,"===> endScope %s",yytext);
 612   if (scopeStack.isEmpty())
 613   {
 614     //fprintf(stderr,"WARNING: fortrancode.l: stack empty!\n");
 615     return;
 616   }
 617
 618   Scope *scope = scopeStack.getLast();
 619   scopeStack.removeLast();
 620   for ( QStringList::Iterator it = scope->useNames.begin(); it != scope->useNames.end(); ++it)
 621   {
 622     useMembers->remove((*it).utf8());
 623   }
 624   delete scope;
 625 }
 626
 627 static void addUse(const QCString &moduleName)
 628 {
 629   if (!scopeStack.isEmpty())
 630     scopeStack.last()->useNames.append(moduleName);
 631 }
 632
 633 static void addLocalVar(const QCString &varName)
 634 {
 635   if (!scopeStack.isEmpty())
 636     scopeStack.last()->localVars.insert(varName, (void*)1);
 637 }
 638
 639 //----------------------------------------------------------------------------
 640
 641 /* -----------------------------------------------------------------*/
 642 #undef  YY_INPUT
 643 #define YY_INPUT(buf,result,max_size) result=yyread(buf,max_size);
 644
 645 static int yyread(char *buf,int max_size)
 646 {
 647     int c=0;
 648     while( c < max_size && g_inputString[g_inputPosition] )
 649     {
 650         *buf = g_inputString[g_inputPosition++] ;
 651         c++; buf++;
 652     }
 653     return c;
 654 }
 655
 656 %}
 657
 658 IDSYM     [a-z_A-Z0-9]
 659 ID        [a-z_A-Z]+{IDSYM}*
 660 SUBPROG   (subroutine|function)
 661 B         [ \t]
 662 BS        [ \t]*
 663 BS_       [ \t]+
 664 COMMA     {BS},{BS}
 665 ARGS_L0   ("("[^)]*")")
 666 ARGS_L1a  [^()]*"("[^)]*")"[^)]*
 667 ARGS_L1   ("("{ARGS_L1a}*")")
 668 ARGS_L2   "("({ARGS_L0}|[^()]|{ARGS_L1a}|{ARGS_L1})*")"
 669 ARGS      {BS}({ARGS_L0}|{ARGS_L1}|{ARGS_L2})
 670
 671 NUM_TYPE  (complex|integer|logical|real)
 672 LOG_OPER  (\.and\.|\.eq\.|\.eqv\.|\.ge\.|\.gt\.|\.le\.|\.lt\.|\.ne\.|\.neqv\.|\.or\.|\.not\.)
 673 KIND      {ARGS}
 674 CHAR      (CHARACTER{ARGS}?|CHARACTER{BS}"*"({BS}[0-9]+|{ARGS}))
 675 TYPE_SPEC (({NUM_TYPE}({BS}"*"{BS}[0-9]+)?)|({NUM_TYPE}{KIND})|DOUBLE{BS_}COMPLEX|DOUBLE{BS_}PRECISION|{CHAR})
 676
 677 INTENT_SPEC intent{BS}"("{BS}(in|out|in{BS}out){BS}")"
 678 ATTR_SPEC (IMPLICIT|ALLOCATABLE|DIMENSION{ARGS}|EXTERNAL|{INTENT_SPEC}|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PRIVATE|PUBLIC|SAVE|TARGET|RECURSIVE|PURE|ELEMENTAL)
 679 ACCESS_SPEC (PRIVATE|PUBLIC)
 680 /* Assume that attribute statements are almost the same as attributes. */
 681 ATTR_STMT {ATTR_SPEC}|DIMENSION
 682 FLOW  (DO|SELECT|CASE|WHERE|IF|THEN|ELSE|WHILE|FORALL|ELSEWHERE|ELSEIF|RETURN|CONTINUE|EXIT)
 683 COMMANDS  (FORMAT|CONTAINS|MODULE{BS_}PROCEDURE|WRITE|READ|ALLOCATE|ALLOCATED|ASSOCIATED|DEALLOCATE|SIZE|INQUIRE|OPEN|CLOSE|DATA|COMMON)
 684 IGNORE (CALL)
 685 PREFIX    (RECURSIVE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,2}(RECURSIVE|PURE|ELEMENTAL)?
 686
 687 /* |  */
 688
 689 %option noyywrap
 690 %option stack
 691 %option caseless
 692 /*%option debug*/
 693
 694 %x Start
 695 %x SubCall
 696 %x FuncDef
 697 %x ClassName
 698 %x ClassVar
 699 %x Subprog
 700 %x DocBlock
 701 %x Use
 702 %x UseOnly
 703 %x TypeDecl
 704 %x Declaration
 705 %x DeclContLine
 706 %x Parameterlist
 707 %x String
 708 %x Subprogend
 709
 710 %%
 711  /*==================================================================*/
 712
 713  /*-------- ignore ------------------------------------------------------------*/
 714
 715 <Start>{IGNORE}/{BS}"("?                { // do not search keywords, intrinsics... TODO: complete list
 716                                           codifyLines(yytext);
 717                                         }
 718  /*-------- inner construct ---------------------------------------------------*/
 719
 720 <Start>{COMMANDS}/[,( \t\n].*           {  // highlight
 721                                           /* font class is defined e.g. in doxygen.css */
 722                                           startFontClass("keyword");
 723                                           codifyLines(yytext);
 724                                           endFontClass();
 725                                         }
 726 <Start>{FLOW}/[,( \t\n].*               {
 727                                           /* font class is defined e.g. in doxygen.css */
 728                                           startFontClass("keywordflow");
 729                                           codifyLines(yytext);
 730                                           endFontClass();
 731                                         }
 732 <Start>"end"({BS}{FLOW})?/[ \t\n]       { // list is a bit long as not all have possible end
 733                                           startFontClass("keywordflow");
 734                                           codifyLines(yytext);
 735                                           endFontClass();
 736                                         }
 737
 738 <Start>"implicit"{BS}"none"             {
 739                                           startFontClass("keywordtype");
 740                                           codifyLines(yytext);
 741                                           endFontClass();
 742                                         }
 743  /*-------- use statement -------------------------------------------*/
 744 <Start>"use"{BS_}                       {
 745                                           startFontClass("keywordtype");
 746                                           codifyLines(yytext);
 747                                           endFontClass();
 748                                           yy_push_state(YY_START);
 749                                           BEGIN(Use);
 750                                         }
 751 <Use>{ID}                               {
 752                                           QCString tmp = yytext;
 753                                           tmp = tmp.lower();
 754                                           g_insideBody=TRUE;
 755                                           generateLink(*g_code, yytext);
 756                                           g_insideBody=FALSE;
 757
 758                                           /* append module name to use dict */
 759                                           useEntry = new UseEntry();
 760                                           //useEntry->module = yytext;
 761                                           //useMembers->append(yytext, useEntry);
 762                                           //addUse(yytext);
 763                                           useEntry->module = tmp;
 764                                           useMembers->append(tmp, useEntry);
 765                                           addUse(tmp);
 766                                         }
 767 <Use>,{BS}"ONLY"                        { // TODO: rename
 768                                           startFontClass("keywordtype");
 769                                           codifyLines(yytext);
 770                                           endFontClass();
 771                                           yy_push_state(YY_START);
 772                                           BEGIN(UseOnly);
 773                                         }
 774 <UseOnly>{BS},{BS}                      { codifyLines(yytext); }
 775 <UseOnly>{BS}&{BS}"\n"                  { codifyLines(yytext); }
 776 <UseOnly>{ID}                           {
 777                                           g_insideBody=TRUE;
 778                                           generateLink(*g_code, yytext);
 779                                           g_insideBody=FALSE;
 780                                           useEntry->onlyNames.append(yytext);
 781                                         }
 782 <Use,UseOnly>"\n"                       {
 783                                           unput(*yytext);
 784                                           yy_pop_state();
 785                                         }
 786
 787  /*-------- fortran module  -----------------------------------------*/
 788 <Start>("block"{BS}"data"|"program"|"module"|"type"|"interface")/{BS_}|({COMMA}{ACCESS_SPEC})|\n {  //
 789                                           startScope();
 790                                           startFontClass("keyword");
 791                                           codifyLines(yytext);
 792                                           endFontClass();
 793                                           yy_push_state(YY_START);
 794                                           BEGIN(ClassName);
 795                                           if (!stricmp(yytext,"module")) currentModule="module";
 796                                         }
 797 <ClassName>{ID}                         {
 798                                           if (currentModule == "module")
 799                                           {
 800                                             currentModule=yytext;
 801                                             currentModule = currentModule.lower();
 802                                           }
 803                                           generateLink(*g_code,yytext);
 804                                           yy_pop_state();
 805                                         }
 806 <ClassName>\n                           { // interface may be without name
 807                                           yy_pop_state();
 808                                           REJECT;
 809                                         }
 810 <Start>"end"({BS_}"module").*          { // just reset currentModule, rest is done in following rule
 811                                           currentModule=0;
 812                                           REJECT;
 813                                         }
 814  /*-------- subprog definition -------------------------------------*/
 815 <Start>({PREFIX}{BS_})?{TYPE_SPEC}{BS_}({PREFIX}{BS_})?{BS}/{SUBPROG}{BS_}  {   // TYPE_SPEC is for old function style function result
 816                                           startFontClass("keyword");
 817                                           codifyLines(yytext);
 818                                           endFontClass();
 819                                        }
 820 <Start>({PREFIX}{BS_})?{SUBPROG}{BS_}                  {  // Fortran subroutine or function found
 821                                           startFontClass("keyword");
 822                                           codifyLines(yytext);
 823                                           endFontClass();
 824                                           yy_push_state(YY_START);
 825                                           BEGIN(Subprog);
 826                                         }
 827 <Subprog>{ID}                           { // subroutine/function name
 828                                           // fprintf(stderr, "===> start subprogram %s\n", yytext);
 829                                           startScope();
 830                                           generateLink(*g_code,yytext);
 831                                         }
 832 <Subprog>"(".*                          { // ignore rest of line
 833                                           codifyLines(yytext);
 834                                         }
 835 <Subprog,Subprogend>"\n"                { codifyLines(yytext);
 836                                           yy_pop_state();
 837                                         }
 838 <Start>^{BS}"end"{BS}("block"{BS}"data"|{SUBPROG}|"module"|"program"|"type"|"interface"){BS}     {  // Fortran subroutine or function ends
 839                                           //cout << "===> end function " << yytext << endl;
 840                                           endScope();
 841                                           startFontClass("keyword");
 842                                           codifyLines(yytext);
 843                                           endFontClass();
 844                                           yy_push_state(YY_START);
 845                                           BEGIN(Subprogend);
 846                                         }
 847 <Subprogend>{ID}/{BS}(\n|!)             {
 848                                           generateLink(*g_code,yytext);
 849                                           yy_pop_state();
 850                                         }
 851 <Start>^{BS}"end"{BS}("block"{BS}"data"|{SUBPROG}|"module"|"program"|"type"|"interface"){BS}/(\n|!) {  // Fortran subroutine or function ends
 852                                           //cout << "===> end function " << yytext << endl;
 853                                           endScope();
 854                                           startFontClass("keyword");
 855                                           codifyLines(yytext);
 856                                           endFontClass();
 857                                         }
 858  /*-------- variable declaration ----------------------------------*/
 859 <Start>"type"{BS}"("                    {
 860                                           yy_push_state(YY_START);
 861                                           BEGIN(TypeDecl);
 862                                           startFontClass("keywordtype");
 863                                           g_code->codify(yytext);
 864                                           endFontClass();
 865                                         }
 866 <TypeDecl>{ID}                          { // link type
 867                                           g_insideBody=TRUE;
 868                                           generateLink(*g_code,yytext);
 869                                           g_insideBody=FALSE;
 870                                         }
 871 <TypeDecl>")"                           {
 872                                           BEGIN(Declaration);
 873                                           startFontClass("keywordtype");
 874                                           g_code->codify(yytext);
 875                                           endFontClass();
 876                                         }
 877 <Start>{TYPE_SPEC}/[,:( ]               {
 878                                           yy_push_state(YY_START);
 879                                           BEGIN(Declaration);
 880                                           startFontClass("keywordtype");
 881                                           g_code->codify(yytext);
 882                                           endFontClass();
 883                                        }
 884 <Start>{ATTR_SPEC}                     {
 885                                           startFontClass("keywordtype");
 886                                           g_code->codify(yytext);
 887                                           endFontClass();
 888                                        }
 889 <Declaration>({TYPE_SPEC}|{ATTR_SPEC})/[,:( ] { //| variable deklaration
 890                                           startFontClass("keywordtype");
 891                                           g_code->codify(yytext);
 892                                           endFontClass();
 893                                         }
 894 <Declaration>{ID}                       { // local var
 895                                           if (g_currentMemberDef && !g_currentMemberDef->isFunction())
 896                                           {
 897                                             g_code->codify(yytext);
 898                                             addLocalVar(yytext);
 899                                           }
 900                                            else
 901                                           {
 902                                             generateLink(*g_code, yytext);
 903                                           }
 904                                         }
 905 <Declaration>[(]                        { // start of array specification
 906                                           bracketCount++;
 907                                           g_code->codify(yytext);
 908                                         }
 909
 910 <Declaration>[)]                        { // end array specification
 911                                           bracketCount--;
 912                                           g_code->codify(yytext);
 913                                         }
 914
 915 <Declaration>"&"                        { // continuation line
 916                                           g_code->codify(yytext);
 917                                           yy_push_state(YY_START);
 918                                           BEGIN(DeclContLine);
 919                                         }
 920 <DeclContLine>"\n"                      { // declaration not yet finished
 921                                           codifyLines(yytext);
 922                                           bracketCount = 0;
 923                                           yy_pop_state();
 924                                         }
 925 <Declaration>"\n"                       { // end declaration line
 926                                           codifyLines(yytext);
 927                                           bracketCount = 0;
 928                                           yy_pop_state();
 929                                         }
 930
 931  /*-------- subprog calls  -----------------------------------------*/
 932
 933 <Start>"call"{BS_}                      {
 934                                           codifyLines(yytext);
 935                                           yy_push_state(YY_START);
 936                                           BEGIN(SubCall);
 937                                         }
 938 <SubCall>{ID}                           { // subroutine call
 939                                           g_insideBody=TRUE;
 940                                           generateLink(*g_code, yytext);
 941                                           g_insideBody=FALSE;
 942                                           yy_pop_state();
 943                                         }
 944 <Start>{ID}{BS}/"("                     { // function call
 945                                           g_insideBody=TRUE;
 946                                           generateLink(*g_code, yytext);
 947                                           g_insideBody=FALSE;
 948                                         }
 949
 950  /*-------- comments ---------------------------------------------------*/
 951 <Start>\n?{BS}"!>"|"!<"                 { // start comment line or comment block
 952                                           yy_push_state(YY_START);
 953                                           BEGIN(DocBlock);
 954                                           docBlock=yytext;
 955                                         }
 956 <Declaration>{BS}"!<"                   { // start comment line or comment block
 957                                           yy_push_state(YY_START);
 958                                           BEGIN(DocBlock);
 959                                           docBlock=yytext;
 960                                         }
 961
 962 <DocBlock>.*                            { // contents of current comment line
 963                                           docBlock+=yytext;
 964                                         }
 965 <DocBlock>"\n"{BS}("!>"|"!<"|"!!")      { //| comment block (next line is also comment line)
 966                                           docBlock+=yytext;
 967                                         }
 968 <DocBlock>"\n"                          { // comment block ends at the end of this line
 969                                           docBlock+=yytext;
 970                                           // remove special comment (default config)
 971                                           if (Config_getBool("STRIP_CODE_COMMENTS"))
 972                                           {
 973                                             g_yyLineNr+=((QCString)docBlock).contains('\n');
 974                                             endCodeLine();
 975                                             if (g_yyLineNr<g_inputLines)
 976                                             {
 977                                               startCodeLine();
 978                                             }
 979                                           }
 980                                           else // do not remove comment
 981                                           {
 982                                             startFontClass("comment");
 983                                             codifyLines(docBlock);
 984                                             endFontClass();
 985                                           }
 986                                          yy_pop_state();
 987                                         }
 988
 989 <*>"!"[^><\n].*|"!"$                    { // normal comment
 990                                           if(YY_START == String) REJECT; // ignore in strings
 991                                           startFontClass("comment");
 992                                           codifyLines(yytext);
 993                                           endFontClass();
 994                                         }
 995
 996 <*>^[Cc*].*                             { // normal comment
 997                                           if(! g_isFixedForm) REJECT;
 998
 999                                           startFontClass("comment");
1000                                           codifyLines(yytext);
1001                                           endFontClass();
1002                                         }
1003
1004  /*------ preprocessor  --------------------------------------------*/
1005 <Start>"#".*\n                          { startFontClass("preprocessor");
1006                                           codifyLines(yytext);
1007                                           endFontClass();
1008                                         }
1009  /*------ variable references?  -------------------------------------*/
1010
1011 <Start>"%"{BS}{ID}                      { // ignore references to elements
1012                                           g_code->codify(yytext);
1013                                         }
1014 <Start>{ID}                             {
1015                                             g_insideBody=TRUE;
1016                                             generateLink(*g_code, yytext);
1017                                             g_insideBody=FALSE;
1018                                         }
1019  /*------ strings --------------------------------------------------*/
1020 <*>"\\\\"                               { str+=yytext; /* ignore \\  */}
1021 <*>"\\\""|\\\'                          { str+=yytext; /* ignore \"  */}
1022
1023 <String>\n                              { // string with \n inside
1024                                           str+=yytext;
1025                                           startFontClass("stringliteral");
1026                                           codifyLines(str);
1027                                           endFontClass();
1028                                           str = "";
1029                                         }
1030 <String>\"|\'                           { // string ends with next quote without previous backspace
1031                                           if(yytext[0]!=stringStartSymbol) REJECT; // single vs double quote
1032                                           str+=yytext;
1033                                           startFontClass("stringliteral");
1034                                           codifyLines(str);
1035                                           endFontClass();
1036                                           yy_pop_state();
1037                                         }
1038 <String>.                               {str+=yytext;}
1039
1040 <*>\"|\'                                { /* string starts */
1041                                           /* if(YY_START == StrIgnore) REJECT; // ignore in simple comments */
1042                                           yy_push_state(YY_START);
1043                                           stringStartSymbol=yytext[0]; // single or double quote
1044                                           BEGIN(String);
1045                                           str=yytext;
1046                                         }
1047  /*-----------------------------------------------------------------------------*/
1048
1049 <*>\n                                   {
1050                                           codifyLines(yytext);
1051                                         }
1052 <*>.                                    {
1053                                           g_code->codify(yytext);
1054                                         }
1055 <*>{LOG_OPER}                           { // Fortran logical comparison keywords
1056                                           g_code->codify(yytext);
1057                                         }
1058 %%
1059
1060 /*@ ----------------------------------------------------------------------------
1061  */
1062
1063 /*===================================================================*/
1064
1065
1066 void resetFortranCodeParserState() {}
1067
1068 void parseFortranCode(CodeOutputInterface &od,const char *className,const QCString &s,
1069                   bool exBlock, const char *exName,FileDef *fd,
1070                   int startLine,int endLine,bool inlineFragment,
1071                   MemberDef *memberDef,bool,Definition *searchCtx)
1072 {
1073   //printf("***parseCode() exBlock=%d exName=%s fd=%p\n",exBlock,exName,fd);
1074
1075   // used parameters
1076   (void)memberDef;
1077   (void)className;
1078
1079   if (s.isEmpty()) return;
1080   g_code = &od;
1081   g_inputString   = s;
1082   g_inputPosition = 0;
1083   g_isFixedForm = recognizeFixedForm((const char*)s);
1084   g_currentFontClass = 0;
1085   g_needsTermination = FALSE;
1086   g_searchCtx = searchCtx;
1087   if (endLine!=-1)
1088     g_inputLines  = endLine+1;
1089   else
1090     g_inputLines  = countLines();
1091
1092   if (startLine!=-1)
1093     g_yyLineNr    = startLine;
1094   else
1095     g_yyLineNr    = 1;
1096
1097   g_exampleBlock  = exBlock;
1098   g_exampleName   = exName;
1099   g_sourceFileDef = fd;
1100   if (exBlock && fd==0)
1101   {
1102     // create a dummy filedef for the example
1103     g_sourceFileDef = new FileDef("",exName);
1104   }
1105   if (g_sourceFileDef)
1106   {
1107     setCurrentDoc("l00001");
1108   }
1109   g_currentDefinition = 0;
1110   g_currentMemberDef = 0;
1111   if (!g_exampleName.isEmpty())
1112   {
1113     g_exampleFile = convertNameToFile(g_exampleName+"-example");
1114   }
1115   g_includeCodeFragment = inlineFragment;
1116   startCodeLine();
1117   g_parmName.resize(0);
1118   g_parmType.resize(0);
1119   fcodeYYrestart( fcodeYYin );
1120   BEGIN( Start );
1121   fcodeYYlex();
1122   if (g_needsTermination)
1123   {
1124     endFontClass();
1125     g_code->endCodeLine();
1126   }
1127   if (exBlock && g_sourceFileDef)
1128   {
1129     // delete the temporary file definition used for this example
1130     delete g_sourceFileDef;
1131     g_sourceFileDef=0;
1132   }
1133   return;
1134 }
1135
1136 #if !defined(YY_FLEX_SUBMINOR_VERSION)
1137 extern "C" { // some bogus code to keep the compiler happy
1138   void fcodeYYdummy() { yy_flex_realloc(0,0); }
1139 }
1140 #elif YY_FLEX_SUBMINOR_VERSION<33
1141 #error "You seem to be using a version of flex newer than 2.5.4 but older than 2.5.33. These versions do NOT work with doxygen! Please use version <=2.5.4 or >=2.5.33 or expect things to be parsed wrongly!"
1142 #else
1143 extern "C" { // some bogus code to keep the compiler happy
1144   void fcodeYYdummy() { yy_top_state(); }
1145 }
1146 #endif
1147