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