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