src/fortranscanner.l

   1 /* -*- mode: fundamental; indent-tabs-mode: 1; -*- */
   2 /*****************************************************************************
   3  * Parser 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 /* Developer notes.
  20  *
  21  * - Consider using startScope(), endScope() functions with  module, program,
  22  * subroutine or any other scope in fortran program.
  23  *
  24  * - Symbol modifiers (attributes) are collected using SymbolModifiers |= operator during
  25  * substructure parsing. When substructure ends all modifiers are applied to actual
  26  * entries in applyModifiers() functions.
  27  *
  28  * - How case insensitiveness should be handled in code?
  29  * On one side we have arg->name and entry->name, on another side modifierMap[name].
  30  * In entries and arguments case is the same as in code, in modifier map case is lowered and
  31  * then it is compared to lowered entry/argument names.
  32  *
  33  * - Do not like constructs like aa{BS} or {BS}bb. Should try to handle blank space
  34  * with separate rule?: It seems it is often necessary, because we may parse something like
  35  * "functionA" or "MyInterface". So constructs like `(^|[ \t])interface({BS_}{ID})?/[ \t\n]'
  36  * are desired.
  37  *
  38  * - Must track yyLineNr when using REJECT, unput() or similar commands.
  39  */
  40
  41 %{
  42
  43 #include <stdio.h>
  44 #include <stdlib.h>
  45 #include <assert.h>
  46 #include <ctype.h>
  47
  48 #include <qarray.h>
  49 #include <qstack.h>
  50 #include <qregexp.h>
  51 #include <unistd.h>
  52 #include <qfile.h>
  53 #include <qmap.h>
  54
  55 #include "fortranscanner.h"
  56 #include "entry.h"
  57 #include "message.h"
  58 #include "config.h"
  59 #include "doxygen.h"
  60 #include "util.h"
  61 #include "defargs.h"
  62 #include "language.h"
  63 #include "commentscan.h"
  64 #include "fortrancode.h"
  65 #include "pre.h"
  66 #include "arguments.h"
  67
  68 // Toggle for some debugging info
  69 //#define DBG_CTX(x) fprintf x
  70 #define DBG_CTX(x) do { } while(0)
  71
  72 #define YY_NEVER_INTERACTIVE 1
  73 #define YY_NO_INPUT 1
  74
  75 enum ScanVar { V_IGNORE, V_VARIABLE, V_PARAMETER};
  76 enum InterfaceType { IF_NONE, IF_SPECIFIC, IF_GENERIC, IF_ABSTRACT };
  77
  78 // {{{ ----- Helper structs -----
  79 //! Holds modifiers (ie attributes) for one symbol (variable, function, etc)
  80 struct SymbolModifiers {
  81   enum Protection {NONE_P, PUBLIC, PRIVATE};
  82   enum Direction {NONE_D, IN, OUT, INOUT};
  83
  84   //!< This is only used with function return value.
  85   QCString type, returnName;
  86   Protection protection;
  87   Direction direction;
  88   bool optional;
  89   bool protect;
  90   QCString dimension;
  91   bool allocatable;
  92   bool external;
  93   bool intrinsic;
  94   bool parameter;
  95   bool pointer;
  96   bool target;
  97   bool save;
  98   bool deferred;
  99   bool nonoverridable;
 100   bool nopass;
 101   bool pass;
 102   QCString passVar;
 103
 104   SymbolModifiers() : type(), returnName(), protection(NONE_P), direction(NONE_D),
 105     optional(FALSE), protect(FALSE), dimension(), allocatable(FALSE),
 106     external(FALSE), intrinsic(FALSE), parameter(FALSE),
 107     pointer(FALSE), target(FALSE), save(FALSE), deferred(FALSE), nonoverridable(FALSE),
 108     nopass(FALSE), pass(FALSE), passVar() {}
 109
 110   SymbolModifiers& operator|=(const SymbolModifiers &mdfs);
 111   SymbolModifiers& operator|=(QCString mdfrString);
 112 };
 113
 114 //ostream& operator<<(ostream& out, const SymbolModifiers& mdfs);
 115
 116 static const char *directionStrs[] =
 117 {
 118    "", "intent(in)", "intent(out)", "intent(inout)"
 119 };
 120 static const char *directionParam[] =
 121 {
 122    "", "[in]", "[out]", "[in,out]"
 123 };
 124
 125 // }}}
 126
 127 /* -----------------------------------------------------------------
 128  *
 129  *      statics
 130  */
 131 static ParserInterface *g_thisParser;
 132 static const char *     inputString;
 133 static int              inputPosition;
 134 static bool             isFixedForm;
 135 static QCString         inputStringPrepass; ///< Input string for prepass of line cont. '&'
 136 static QCString         inputStringSemi; ///< Input string after command separetor ';'
 137 static unsigned int     inputPositionPrepass;
 138 static int              lineCountPrepass = 0;
 139
 140 static QList<Entry>  subrCurrent;
 141
 142 struct CommentInPrepass {
 143   int column;
 144   QCString str;
 145   CommentInPrepass(int column, QCString str) : column(column), str(str) {}
 146 };
 147 static QList<CommentInPrepass>  comments;
 148
 149 YY_BUFFER_STATE *include_stack = NULL;
 150 int include_stack_ptr = 0;
 151 int include_stack_cnt = 0;
 152
 153 static QFile            inputFile;
 154 static QCString         yyFileName;
 155 static int              yyLineNr     = 1 ;
 156 static int              yyColNr     = 0 ;
 157 static Entry*           current_root = 0 ;
 158 static Entry*           global_root  = 0 ;
 159 static Entry*           file_root    = 0 ;
 160 static Entry*           current      = 0 ;
 161 static Entry*           last_entry   = 0 ;
 162 static ScanVar          v_type       = V_IGNORE; // type of parsed variable
 163 static QList<Entry>     moduleProcedures; // list of all interfaces which contain unresolved
 164                                           // module procedures
 165 static QCString         docBlock;
 166 static QCString         docBlockName;
 167 static bool             docBlockInBody = FALSE;
 168 static bool             docBlockJavaStyle;
 169
 170 static MethodTypes      mtype;
 171 static bool             gstat;
 172 static Specifier        virt;
 173
 174 static QCString          debugStr;
 175 static QCString          result; // function result
 176 static Argument          *parameter; // element of parameter list
 177 static QCString          argType;  // fortran type of an argument of a parameter list
 178 static QCString          argName;  // last identifier name in variable list
 179 static QCString          initializer;  // initial value of a variable
 180 static int               initializerArrayScope;  // number if nested array scopes in initializer
 181 static int               initializerScope;  // number if nested function calls in initializer
 182 static QCString          useModuleName;  // name of module in the use statement
 183 static Protection        defaultProtection;
 184 static Protection        typeProtection;
 185 static int               typeMode = false;
 186 static InterfaceType     ifType = IF_NONE;
 187 static bool              functionLine = FALSE;
 188
 189 static char              stringStartSymbol; // single or double quote
 190 static bool              parsingPrototype = FALSE; // see parsePrototype()
 191
 192 //! Accumulated modifiers of current statement, eg variable declaration.
 193 static SymbolModifiers currentModifiers;
 194 //! Holds program scope->symbol name->symbol modifiers.
 195 static QMap<Entry*,QMap<QCString,SymbolModifiers> > modifiers;
 196
 197 //-----------------------------------------------------------------------------
 198
 199 static int yyread(char *buf,int max_size);
 200 static void startCommentBlock(bool);
 201 static void handleCommentBlock(const QCString &doc,bool brief);
 202 static void subrHandleCommentBlock(const QCString &doc,bool brief);
 203 static void addCurrentEntry(int case_insens);
 204 static void addModule(const char *name, bool isModule=FALSE);
 205 static void addSubprogram(const char *text);
 206 static void addInterface(QCString name, InterfaceType type);
 207 static Argument *getParameter(const QCString &name);
 208 static void scanner_abort();
 209
 210 static void startScope(Entry *scope);
 211 static bool endScope(Entry *scope, bool isGlobalRoot=FALSE);
 212 //static bool isTypeName(QCString name);
 213 static void resolveModuleProcedures(QList<Entry> &moduleProcedures, Entry *current_root);
 214 static int getAmpersandAtTheStart(const char *buf, int length);
 215 static int getAmpOrExclAtTheEnd(const char *buf, int length);
 216 static void truncatePrepass(int index);
 217 static void pushBuffer(QCString &buffer);
 218 static void popBuffer();
 219 //static void extractPrefix(QCString& text);
 220 static QCString extractFromParens(const QCString name);
 221 static CommentInPrepass* locatePrepassComment(int from, int to);
 222 static void updateVariablePrepassComment(int from, int to);
 223 static void newLine();
 224
 225 //-----------------------------------------------------------------------------
 226 #undef  YY_INPUT
 227 #define YY_INPUT(buf,result,max_size) result=yyread(buf,max_size);
 228 #define YY_USER_ACTION yyColNr+=(int)yyleng;
 229 //-----------------------------------------------------------------------------
 230
 231 %}
 232
 233  //-----------------------------------------------------------------------------
 234  //-----------------------------------------------------------------------------
 235 IDSYM     [a-z_A-Z0-9]
 236 NOTIDSYM  [^a-z_A-Z0-9]
 237 SEPARATE  [:, \t]
 238 ID        [a-z_A-Z%]+{IDSYM}*
 239 ID_       [a-z_A-Z%]*{IDSYM}*
 240 PP_ID     {ID}
 241 LABELID   [a-z_A-Z]+[a-z_A-Z0-9\-]*
 242 SUBPROG   (subroutine|function)
 243 B         [ \t]
 244 BS        [ \t]*
 245 BS_       [ \t]+
 246 COMMA     {BS},{BS}
 247 ARGS_L0   ("("[^)]*")")
 248 ARGS_L1a  [^()]*"("[^)]*")"[^)]*
 249 ARGS_L1   ("("{ARGS_L1a}*")")
 250 ARGS_L2   "("({ARGS_L0}|[^()]|{ARGS_L1a}|{ARGS_L1})*")"
 251 ARGS      {BS}({ARGS_L0}|{ARGS_L1}|{ARGS_L2})
 252 NOARGS    {BS}"\n"
 253
 254 NUM_TYPE  (complex|integer|logical|real)
 255 LOG_OPER  (\.and\.|\.eq\.|\.eqv\.|\.ge\.|\.gt\.|\.le\.|\.lt\.|\.ne\.|\.neqv\.|\.or\.|\.not\.)
 256 KIND      {ARGS}
 257 CHAR      (CHARACTER{ARGS}?|CHARACTER{BS}"*"({BS}[0-9]+|{ARGS}))
 258 TYPE_SPEC (({NUM_TYPE}({BS}"*"{BS}[0-9]+)?)|({NUM_TYPE}{KIND})|DOUBLE{BS}COMPLEX|DOUBLE{BS}PRECISION|{CHAR}|TYPE{ARGS}|CLASS{ARGS}|PROCEDURE{ARGS}?)
 259
 260 INTENT_SPEC intent{BS}"("{BS}(in|out|in{BS}out){BS}")"
 261 ATTR_SPEC (ALLOCATABLE|DIMENSION{ARGS}|EXTERNAL|{INTENT_SPEC}|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PROTECTED|PRIVATE|PUBLIC|SAVE|TARGET|NOPASS|PASS{ARGS}?|DEFERRED|NON_OVERRIDABLE)
 262 ACCESS_SPEC (PRIVATE|PUBLIC)
 263 LANGUAGE_BIND_SPEC BIND{BS}"("{BS}C{BS}(,{BS}NAME{BS}"="{BS}"\""(.*)"\""{BS})?")"
 264 /* Assume that attribute statements are almost the same as attributes. */
 265 ATTR_STMT {ATTR_SPEC}|DIMENSION|{ACCESS_SPEC}
 266
 267 CONTAINS  CONTAINS
 268 PREFIX    (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|IMPURE|PURE|ELEMENTAL)?
 269 SCOPENAME ({ID}{BS}"::"{BS})*
 270
 271 %option noyywrap
 272 %option stack
 273 %option caseless
 274 /*%option debug */
 275
 276  //---------------------------------------------------------------------------------
 277
 278  /** fortran parsing states */
 279 %x      Subprog
 280 %x      SubprogPrefix
 281 %x      Parameterlist
 282 %x      SubprogBody
 283 %x      SubprogBodyContains
 284 %x      Start
 285 %x      Comment
 286 %x      Module
 287 %x      Program
 288 %x      ModuleBody
 289 %x      ModuleBodyContains
 290 %x      AttributeList
 291 %x      Variable
 292 %x      Initialization
 293 %x      ArrayInitializer
 294 %x      Typedef
 295 %x      TypedefBody
 296 %x      TypedefBodyContains
 297 %x      InterfaceBody
 298 %x      StrIgnore
 299 %x      String
 300 %x      Use
 301 %x      UseOnly
 302 %x      ModuleProcedure
 303
 304 %x      Prepass
 305
 306  /** comment parsing states */
 307 %x      DocBlock
 308 %x      DocBackLine
 309 %x      EndDoc
 310
 311 %x      BlockData
 312
 313 /** prototype parsing */
 314 %x      Prototype
 315 %x      PrototypeSubprog
 316 %x      PrototypeArgs
 317
 318 %%
 319
 320  /*-----------------------------------------------------------------------------------*/
 321
 322 <*>^.*\n                                { // prepass: look for line continuations
 323                                           functionLine = FALSE;
 324
 325                                           DBG_CTX((stderr, "---%s", yytext));
 326
 327                                             int indexStart = getAmpersandAtTheStart(yytext, (int)yyleng);
 328                                             int indexEnd = getAmpOrExclAtTheEnd(yytext, (int)yyleng);
 329                                             if (indexEnd>=0 && yytext[indexEnd]!='&') //we are only interested in amp
 330                                               indexEnd=-1;
 331
 332                                             if(indexEnd<0){ // ----- no ampersand as line continuation
 333                                                if(YY_START == Prepass) { // last line in "continuation"
 334
 335                                                  // Only take input after initial ampersand
 336                                                  inputStringPrepass+=(const char*)(yytext+(indexStart+1));
 337
 338                                                  //printf("BUFFER:%s\n", (const char*)inputStringPrepass);
 339                                                  pushBuffer(inputStringPrepass);
 340                                                  yyColNr = 0;
 341                                                  yy_pop_state();
 342                                                } else { // simple line
 343                                                  yyColNr = 0;
 344                                                  REJECT;
 345                                                }
 346
 347                                             } else { // ----- line with continuation
 348                                               if(YY_START != Prepass) {
 349                                                 comments.setAutoDelete(TRUE);
 350                                                 comments.clear();
 351                                                 yy_push_state(Prepass);
 352                                               }
 353
 354                                               int length = inputStringPrepass.length();
 355
 356                                               // Only take input after initial ampersand
 357                                               inputStringPrepass+=(const char*)(yytext+(indexStart+1));
 358                                               lineCountPrepass ++;
 359
 360                                               // cut off & and remove following comment if present
 361                                               truncatePrepass(length+indexEnd-(indexStart+1));
 362                                             }
 363
 364                                         }
 365
 366
 367  /*------ ignore strings that are not initialization strings */
 368 <*>"\\\\"                               { if (yy_top_state() == Initialization
 369                                               || yy_top_state() == ArrayInitializer)
 370                                             initializer+=yytext;
 371                                         }
 372 <*>"\\\""|\\\'                          { if (yy_top_state() == Initialization
 373                                               || yy_top_state() == ArrayInitializer)
 374                                             initializer+=yytext;
 375                                         }
 376 <String>\"|\'                           { // string ends with next quote without previous backspace
 377                                           if (yytext[0]!=stringStartSymbol) { yyColNr -= (int)yyleng; REJECT; } // single vs double quote
 378                                           if (yy_top_state() == Initialization
 379                                               || yy_top_state() == ArrayInitializer)
 380                                             initializer+=yytext;
 381                                           yy_pop_state();
 382                                         }
 383 <String>.                               { if (yy_top_state() == Initialization
 384                                               || yy_top_state() == ArrayInitializer)
 385                                             initializer+=yytext;
 386                                         }
 387 <*>\"|\'                                { /* string starts */
 388                                           if (YY_START == StrIgnore) { yyColNr -= (int)yyleng; REJECT; }; // ignore in simple comments
 389                                           yy_push_state(YY_START);
 390                                           if (yy_top_state() == Initialization
 391                                               || yy_top_state() == ArrayInitializer)
 392                                             initializer+=yytext;
 393                                           stringStartSymbol=yytext[0]; // single or double quote
 394                                           BEGIN(String);
 395                                         }
 396
 397  /*------ ignore simple comment (not documentation comments) */
 398
 399 <*>"!"/[^<>\n]                         {  if (YY_START == String) { yyColNr -= (int)yyleng; REJECT; } // "!" is ignored in strings
 400                                           // skip comment line (without docu comments "!>" "!<" )
 401                                           /* ignore further "!" and ignore comments in Strings */
 402                                           if ((YY_START != StrIgnore) && (YY_START != String))
 403                                           {
 404                                             yy_push_state(YY_START);
 405                                             BEGIN(StrIgnore);
 406                                             debugStr="*!";
 407                                             DBG_CTX((stderr,"start comment %d\n",yyLineNr));
 408                                            }
 409                                         }
 410 <StrIgnore>.?/\n                        { yy_pop_state(); // comment ends with endline character
 411                                           DBG_CTX((stderr,"end comment %d %s\n",yyLineNr,debugStr.data()));
 412                                         } // comment line ends
 413 <StrIgnore>.                            { debugStr+=yytext; }
 414
 415
 416  /*------ use handling ------------------------------------------------------------*/
 417
 418 <Start,ModuleBody,SubprogBody>"use"{BS_} {
 419                                           if(YY_START == Start)
 420                                           {
 421                                             addModule(NULL);
 422                                             yy_push_state(ModuleBody); //anon program
 423                                           }
 424                                           yy_push_state(Use);
 425                                         }
 426 <Use>{ID}                               {
 427                                           DBG_CTX((stderr,"using dir %s\n",yytext));
 428                                           current->name=yytext;
 429                                           current->fileName = yyFileName;
 430                                           current->section=Entry::USINGDIR_SEC;
 431                                           current_root->addSubEntry(current);
 432                                           current = new Entry;
 433                                           current->lang = SrcLangExt_Fortran;
 434                                           yy_pop_state();
 435                                         }
 436 <Use>{ID}/,                             {
 437                                           useModuleName=yytext;
 438                                         }
 439 <Use>,{BS}"ONLY"                        { BEGIN(UseOnly);
 440                                         }
 441 <UseOnly>{BS},{BS}                      {}
 442 <UseOnly>{ID}                           {
 443                                           current->name= useModuleName+"::"+yytext;
 444                                           current->fileName = yyFileName;
 445                                           current->section=Entry::USINGDECL_SEC;
 446                                           current_root->addSubEntry(current);
 447                                           current = new Entry ;
 448                                           current->lang = SrcLangExt_Fortran;
 449                                         }
 450 <Use,UseOnly>"\n"                       {
 451                                           yyColNr -= 1;
 452                                           unput(*yytext);
 453                                           yy_pop_state();
 454                                         }
 455
 456  /* INTERFACE definitions */
 457 <Start,ModuleBody,SubprogBody>{
 458 ^{BS}interface{IDSYM}+                  { /* variable with interface prefix */ }
 459 ^{BS}interface                          { ifType = IF_SPECIFIC;
 460                                           yy_push_state(InterfaceBody);
 461                                           // do not start a scope here, every
 462                                           // interface body is a scope of its own
 463                                         }
 464
 465 ^{BS}abstract{BS_}interface             { ifType = IF_ABSTRACT;
 466                                           yy_push_state(InterfaceBody);
 467                                           // do not start a scope here, every
 468                                           // interface body is a scope of its own
 469                                         }
 470
 471 ^{BS}interface{BS_}{ID}{ARGS}?          { ifType = IF_GENERIC;
 472                                           yy_push_state(InterfaceBody);
 473
 474                                           // extract generic name
 475                                           QCString name = QCString(yytext).stripWhiteSpace();
 476                                           name = name.right(name.length() - 9).stripWhiteSpace().lower();
 477                                           addInterface(name, ifType);
 478                                           startScope(last_entry);
 479                                         }
 480 }
 481
 482 <InterfaceBody>^{BS}end{BS}interface({BS_}{ID})? {
 483                                           // end scope only if GENERIC interface
 484                                           if (ifType == IF_GENERIC && !endScope(current_root))
 485                                             yyterminate();
 486
 487                                           ifType = IF_NONE;
 488                                           yy_pop_state();
 489                                         }
 490 <InterfaceBody>module{BS}procedure      { yy_push_state(YY_START);
 491                                           BEGIN(ModuleProcedure);
 492                                         }
 493 <ModuleProcedure>{ID}                   { if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
 494                                           {
 495                                             addInterface(yytext, ifType);
 496                                             startScope(last_entry);
 497                                           }
 498
 499                                           current->section = Entry::FUNCTION_SEC ;
 500                                           current->name = yytext;
 501                                           moduleProcedures.append(current);
 502                                           addCurrentEntry(1);
 503                                         }
 504 <ModuleProcedure>"\n"                   { yyColNr -= 1;
 505                                           unput(*yytext);
 506                                           yy_pop_state();
 507                                         }
 508 <InterfaceBody>.                        {}
 509
 510  /*-- Contains handling --*/
 511 <Start>^{BS}{CONTAINS}/({BS}|\n|!)      {
 512                                           if(YY_START == Start)
 513                                           {
 514                                             addModule(NULL);
 515                                             yy_push_state(ModuleBodyContains); //anon program
 516                                           }
 517                                         }
 518 <ModuleBody>^{BS}{CONTAINS}/({BS}|\n|!)   { BEGIN(ModuleBodyContains); }
 519 <SubprogBody>^{BS}{CONTAINS}/({BS}|\n|!)  { BEGIN(SubprogBodyContains); }
 520 <TypedefBody>^{BS}{CONTAINS}/({BS}|\n|!)  { BEGIN(TypedefBodyContains); }
 521
 522  /*------ module handling ------------------------------------------------------------*/
 523 <Start>block{BS}data{BS}{ID_}        {  //
 524                                          v_type = V_IGNORE;
 525                                             yy_push_state(BlockData);
 526                                             defaultProtection = Public;
 527                                        }
 528 <Start>module|program{BS_}             {  //
 529                                          v_type = V_IGNORE;
 530                                             if(yytext[0]=='m' || yytext[0]=='M')
 531                                               yy_push_state(Module);
 532                                             else
 533                                               yy_push_state(Program);
 534                                             defaultProtection = Public;
 535                                        }
 536 <BlockData>^{BS}"end"({BS}(block{BS}data)({BS_}{ID})?)?{BS}/(\n|!) { // end block data
 537                                             //if (!endScope(current_root))
 538                                             //  yyterminate();
 539                                             defaultProtection = Public;
 540                                             yy_pop_state();
 541                                        }
 542 <Start,ModuleBody,ModuleBodyContains>^{BS}"end"({BS}(module|program)({BS_}{ID})?)?{BS}/(\n|!) { // end module
 543                                             resolveModuleProcedures(moduleProcedures, current_root);
 544                                             if (!endScope(current_root))
 545                                               yyterminate();
 546                                             defaultProtection = Public;
 547                                             yy_pop_state();
 548                                        }
 549 <Module>{ID}                           {
 550                                             addModule(yytext, TRUE);
 551                                             BEGIN(ModuleBody);
 552                                        }
 553
 554 <Program>{ID}                           {
 555                                             addModule(yytext, FALSE);
 556                                             BEGIN(ModuleBody);
 557                                        }
 558
 559   /*------- access specification --------------------------------------------------------------------------*/
 560
 561 <ModuleBody>private/{BS}(\n|"!")         { defaultProtection = Private;
 562                                            current->protection = defaultProtection ;
 563                                          }
 564 <ModuleBody>public/{BS}(\n|"!")          { defaultProtection = Public;
 565                                            current->protection = defaultProtection ;
 566                                          }
 567
 568  /*------- type definition  -------------------------------------------------------------------------------*/
 569
 570 <Start,ModuleBody>^{BS}type/[^a-z0-9_]   {
 571                                           if(YY_START == Start)
 572                                           {
 573                                             addModule(NULL);
 574                                             yy_push_state(ModuleBody); //anon program
 575                                           }
 576
 577                                           yy_push_state(Typedef);
 578                                           current->protection = defaultProtection;
 579                                           typeProtection = defaultProtection;
 580                                           typeMode = true;
 581                                         }
 582 <Typedef>{
 583 {COMMA}                                 {}
 584
 585 {BS}"::"{BS}                            {}
 586
 587 abstract                                {
 588                                           current->spec |= Entry::AbstractClass;
 589                                         }
 590 extends{ARGS}                           {
 591                                           QCString basename = extractFromParens(yytext);
 592                                           current->extends->append(new BaseInfo(basename, Public, Normal));
 593                                         }
 594 public                                  {
 595                                           current->protection = Public;
 596                                           typeProtection = Public;
 597                                         }
 598 private                                 {
 599                                           current->protection = Private;
 600                                           typeProtection = Private;
 601                                         }
 602 {LANGUAGE_BIND_SPEC}                    {
 603                                           /* ignored for now */
 604                                         }
 605 {ID}                                    { /* type name found */
 606                                           current->section = Entry::CLASS_SEC;
 607                                           current->spec |= Entry::Struct;
 608                                           current->name = yytext;
 609                                           current->fileName = yyFileName;
 610                                           current->bodyLine  = yyLineNr;
 611
 612                                           /* if type is part of a module, mod name is necessary for output */
 613                                           if ((current_root) &&
 614                                               (current_root->section == Entry::CLASS_SEC
 615                                                || current_root->section == Entry::NAMESPACE_SEC))
 616                                           {
 617                                             current->name = current_root->name + "::" + current->name;
 618                                           }
 619
 620                                           addCurrentEntry(1);
 621                                           startScope(last_entry);
 622                                           BEGIN(TypedefBody);
 623                                         }
 624 }
 625
 626 <TypedefBodyContains>{                  /* Type Bound Procedures */
 627 ^{BS}PROCEDURE{ARGS}?                   {
 628                                           current->type = QCString(yytext).simplifyWhiteSpace();
 629                                         }
 630 ^{BS}final                              {
 631                                           current->spec |= Entry::Final;
 632                                           current->type = QCString(yytext).simplifyWhiteSpace();
 633                                         }
 634 ^{BS}generic                            {
 635                                           current->type = QCString(yytext).simplifyWhiteSpace();
 636                                         }
 637 {COMMA}                                 {
 638                                         }
 639 {ATTR_SPEC}                             {
 640                                           currentModifiers |= QCString(yytext);
 641                                         }
 642 {BS}"::"{BS}                            {
 643                                         }
 644 {ID}                                    {
 645                                           QCString name = yytext;
 646                                           modifiers[current_root][name.lower()] |= currentModifiers;
 647                                           current->section  = Entry::FUNCTION_SEC;
 648                                           current->name     = name;
 649                                           current->fileName = yyFileName;
 650                                           current->bodyLine = yyLineNr;
 651                                           addCurrentEntry(1);
 652                                         }
 653 {BS}"=>"[^(\n|\!)]*                     { /* Specific bindings come after the ID. */
 654                                           last_entry->args = yytext;
 655                                         }
 656 "\n"                                    {
 657                                           currentModifiers = SymbolModifiers();
 658                                           newLine();
 659                                           docBlock.resize(0);
 660                                         }
 661 }
 662
 663
 664 <TypedefBody,TypedefBodyContains>{
 665 ^{BS}"end"{BS}"type"({BS_}{ID})?{BS}/(\n|!) { /* end type definition */
 666                                           if (!endScope(current_root))
 667                                             yyterminate();
 668                                           typeMode = false;
 669                                           yy_pop_state();
 670                                         }
 671 }
 672
 673  /*------- module/global/typedef variable ---------------------------------------------------*/
 674
 675 <SubprogBody,SubprogBodyContains>^{BS}[0-9]*{BS}"end"({BS}{SUBPROG}({BS_}{ID})?)?{BS}/(\n|!) {
 676                                            //
 677                                            // ABSTRACT and specific interfaces are stored
 678                                            // in a scope of their own, even if multiple
 679                                            // are group in one INTERFACE/END INTERFACE block.
 680                                            //
 681                                            if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
 682                                              endScope(current_root);
 683
 684                                            if (!endScope(current_root))
 685                                              yyterminate();
 686                                            subrCurrent.remove(0u);
 687                                            yy_pop_state() ;
 688                                         }
 689 <BlockData>{
 690 {ID}                                    {
 691                                         }
 692 }
 693 <Start,ModuleBody,TypedefBody,SubprogBody>{
 694 ^{BS}{TYPE_SPEC}/{SEPARATE}             {
 695                                           /* variable declaration starts */
 696                                           if(YY_START == Start)
 697                                           {
 698                                             addModule(NULL);
 699                                             yy_push_state(ModuleBody); //anon program
 700                                           }
 701                                           argType = QCString(yytext).simplifyWhiteSpace().lower();
 702                                           yy_push_state(AttributeList);
 703                                         }
 704   /*  Dimitri: macro expansion should already be done during preprocessing not here!
 705 ^{BS}{PP_ID}{KIND}?                     { // check for preprocessor symbol expand to type
 706                                           QCString str = yytext;
 707                                           str = str.stripWhiteSpace();
 708                                           //DefineDict* defines = getGlobalDefineDict();
 709                                           QCString name;
 710                                           int index = str.find("(");
 711                                           if (index != -1)
 712                                             name = str.left(index).stripWhiteSpace();
 713                                           else
 714                                             name = str;
 715
 716                                           Define *define = 0; //(*defines)[name];
 717                                           if (define != 0 && isTypeName(define->definition))
 718                                           {
 719                                             argType = str;
 720                                             yy_push_state(AttributeList);
 721                                           }
 722                                           else
 723                                           {
 724                                             yyColNr -= (int)yyleng;
 725                                             REJECT;
 726                                           }
 727                                         }
 728   */
 729 {ATTR_STMT}/{BS_}{ID}                  |
 730 {ATTR_STMT}/{BS}"::"                   {
 731                                           /* attribute statement starts */
 732                                           DBG_CTX((stderr,"5=========> Attribute statement: %s\n", yytext));
 733                                           QCString tmp = yytext;
 734                                           currentModifiers |= tmp.stripWhiteSpace();
 735                                           argType="";
 736                                           yy_push_state(YY_START);
 737                                           BEGIN( AttributeList ) ;
 738                                        }
 739 {ID}                                   {
 740                                        }
 741 ^{BS}"type"{BS_}"is"/{BS_}             { }
 742 }
 743 <AttributeList>{
 744 {COMMA}                                 {}
 745 {BS}                                    {}
 746 {ATTR_SPEC}.                            { /* update current modifierswhen it is an ATTR_SPEC and not a variable name */
 747                                           /* bug_625519 */
 748                                           QChar chr = yytext[(int)yyleng-1];
 749                                           if (chr.isLetter() || chr.isDigit() || (chr == '_'))
 750                                           {
 751                                             yyColNr -= (int)yyleng;
 752                                             REJECT;
 753                                           }
 754                                           else
 755                                           {
 756                                             QCString tmp = yytext;
 757                                             tmp = tmp.left(tmp.length() - 1);
 758                                             yyColNr -= 1;
 759                                             unput(yytext[(int)yyleng-1]);
 760                                             currentModifiers |= (tmp);
 761                                           }
 762                                         }
 763 "::"                                    { /* end attribute list */
 764                                           BEGIN( Variable );
 765                                         }
 766 .                                       { /* unknown attribute, consider variable name */
 767                                           //cout<<"start variables, unput "<<*yytext<<endl;
 768                                           yyColNr -= 1;
 769                                           unput(*yytext);
 770                                           BEGIN( Variable );
 771                                         }
 772 }
 773
 774 <Variable>{BS}                          { }
 775 <Variable>{ID}                          { /* parse variable declaration */
 776                                           //cout << "5=========> got variable: " << argType << "::" << yytext << endl;
 777                                           /* work around for bug in QCString.replace (QCString works) */
 778                                           QCString name=yytext;
 779                                           name = name.lower();
 780                                           /* remember attributes for the symbol */
 781                                           modifiers[current_root][name.lower()] |= currentModifiers;
 782                                           argName= name;
 783
 784                                           v_type= V_IGNORE;
 785                                           if (!argType.isEmpty() && current_root->section!=Entry::FUNCTION_SEC)
 786                                           { // new variable entry
 787                                             v_type = V_VARIABLE;
 788                                             current->section = Entry::VARIABLE_SEC;
 789                                             current->name = argName;
 790                                             current->type = argType;
 791                                             current->fileName = yyFileName;
 792                                             current->bodyLine  = yyLineNr; // used for source reference
 793                                             addCurrentEntry(1);
 794                                           }
 795                                           else if (!argType.isEmpty())
 796                                           { // declaration of parameter list: add type for corr. parameter
 797                                             parameter = getParameter(argName);
 798                                             if (parameter)
 799                                             {
 800                                               v_type= V_PARAMETER;
 801                                               if (!argType.isNull()) parameter->type=argType.stripWhiteSpace();
 802                                               if (!docBlock.isNull())
 803                                               {
 804                                                 subrHandleCommentBlock(docBlock,TRUE);
 805                                               }
 806                                             }
 807                                             // save, it may be function return type
 808                                             if (parameter)
 809                                             {
 810                                               modifiers[current_root][name.lower()].type = argType;
 811                                             }
 812                                             else
 813                                             {
 814                                               if ((current_root->name.lower() == argName.lower()) ||
 815                                                   (modifiers[current_root->parent()][current_root->name.lower()].returnName.lower() == argName.lower()))
 816                                               {
 817                                                 int strt = current_root->type.find("function");
 818                                                 QCString lft;
 819                                                 QCString rght;
 820                                                 if (strt != -1)
 821                                                 {
 822                                                   lft = "";
 823                                                   rght = "";
 824                                                   if (strt != 0) lft = current_root->type.left(strt).stripWhiteSpace();
 825                                                   if ((current_root->type.length() - strt - strlen("function"))!= 0)
 826                                                   {
 827                                                     rght = current_root->type.right(current_root->type.length() - strt - strlen("function")).stripWhiteSpace();
 828                                                   }
 829                                                   current_root->type = lft;
 830                                                   if (rght.length() > 0)
 831                                                   {
 832                                                     if (current_root->type.length() > 0) current_root->type += " ";
 833                                                     current_root->type += rght;
 834                                                   }
 835                                                   if (argType.stripWhiteSpace().length() > 0)
 836                                                   {
 837                                                     if (current_root->type.length() > 0) current_root->type += " ";
 838                                                     current_root->type += argType.stripWhiteSpace();
 839                                                   }
 840                                                   if (current_root->type.length() > 0) current_root->type += " ";
 841                                                   current_root->type += "function";
 842                                                 }
 843                                                 else
 844                                                 {
 845                                                   current_root->type += " " + argType.stripWhiteSpace();
 846                                                 }
 847                                                 current_root->type = current_root->type.stripWhiteSpace();
 848                                                 modifiers[current_root][name.lower()].type = current_root->type;
 849                                               }
 850                                               else
 851                                               {
 852                                                 modifiers[current_root][name.lower()].type = argType;
 853                                               }
 854                                             }
 855                                             // any accumulated doc for argument should be emptied,
 856                                             // because it is handled other way and this doc can be
 857                                             // unexpectedly passed to the next member.
 858                                             current->doc.resize(0);
 859                                             current->brief.resize(0);
 860                                           }
 861                                         }
 862 <Variable>{ARGS}                        { /* dimension of the previous entry. */
 863                                           QCString name(argName);
 864                                           QCString attr("dimension");
 865                                           attr += yytext;
 866                                           modifiers[current_root][name.lower()] |= attr;
 867                                         }
 868 <Variable>{COMMA}                       { //printf("COMMA: %d<=..<=%d\n", yyColNr-(int)yyleng, yyColNr);
 869                                           // locate !< comment
 870                                           updateVariablePrepassComment(yyColNr-(int)yyleng, yyColNr);
 871                                         }
 872 <Variable>{BS}"="                       { yy_push_state(YY_START);
 873                                           initializer="=";
 874                                           initializerScope = initializerArrayScope = 0;
 875                                           BEGIN(Initialization);
 876                                         }
 877 <Variable>"\n"                          { currentModifiers = SymbolModifiers();
 878                                           yy_pop_state(); // end variable declaration list
 879                                           newLine();
 880                                           docBlock.resize(0);
 881                                         }
 882 <Variable>";".*"\n"                     { currentModifiers = SymbolModifiers();
 883                                           yy_pop_state(); // end variable declaration list
 884                                           docBlock.resize(0);
 885                                           inputStringSemi =(const char*)(QCString(" \n") + QCString(yytext+1)).data();
 886                                           yyLineNr--;
 887                                           pushBuffer(inputStringSemi);
 888                                         }
 889 <*>";".*"\n"                            {
 890                                           if (YY_START == Variable) REJECT; // Just be on the safe side
 891                                           if (YY_START == String) REJECT; // ";" ignored in strings
 892                                           if (YY_START == StrIgnore) REJECT; // ";" ignored in regular comments
 893                                           inputStringSemi =(const char*)(QCString(" \n") + QCString(yytext+1)).data();
 894                                           yyLineNr--;
 895                                           pushBuffer(inputStringSemi);
 896                                         }
 897
 898 <Initialization,ArrayInitializer>"["    |
 899 <Initialization,ArrayInitializer>"(/"   { initializer+=yytext;
 900                                            initializerArrayScope++;
 901                                            BEGIN(ArrayInitializer); // initializer may contain comma
 902                                         }
 903 <ArrayInitializer>"]"                   |
 904 <ArrayInitializer>"/)"                  { initializer+=yytext;
 905                                            initializerArrayScope--;
 906                                            if(initializerArrayScope<=0)
 907                                            {
 908                                               initializerArrayScope = 0; // just in case
 909                                               BEGIN(Initialization);
 910                                            }
 911                                         }
 912 <ArrayInitializer>.                     { initializer+=yytext; }
 913 <Initialization>"("                     { initializerScope++;
 914                                           initializer+=yytext;
 915                                         }
 916 <Initialization>")"                     { initializerScope--;
 917                                           initializer+=yytext;
 918                                         }
 919 <Initialization>{COMMA}                 { if (initializerScope == 0)
 920                                           {
 921                                             updateVariablePrepassComment(yyColNr-(int)yyleng, yyColNr);
 922                                             yy_pop_state(); // end initialization
 923                                             if (v_type == V_VARIABLE) last_entry->initializer= initializer;
 924                                           }
 925                                           else
 926                                             initializer+=", ";
 927                                         }
 928 <Initialization>"\n"|"!"                { //|
 929                                           yy_pop_state(); // end initialization
 930                                           if (v_type == V_VARIABLE) last_entry->initializer= initializer;
 931                                           yyColNr -= 1;
 932                                           unput(*yytext);
 933                                         }
 934 <Initialization>.                       { initializer+=yytext; }
 935
 936  /*------ fortran subroutine/function handling ------------------------------------------------------------*/
 937  /*       Start is initial condition                                                                       */
 938
 939 <Start,ModuleBody,SubprogBody,InterfaceBody,ModuleBodyContains,SubprogBodyContains>^{BS}({PREFIX}{BS_})?{TYPE_SPEC}{BS}({PREFIX}{BS_})?/{SUBPROG}{BS_} {
 940                                          if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
 941                                          {
 942                                            addInterface("$interface$", ifType);
 943                                            startScope(last_entry);
 944                                          }
 945
 946                                          // TYPE_SPEC is for old function style function result
 947                                          result = QCString(yytext).stripWhiteSpace().lower();
 948                                          current->type = result;
 949                                          yy_push_state(SubprogPrefix);
 950                                        }
 951
 952 <SubprogPrefix>{BS}{SUBPROG}{BS_}     {
 953                                          // Fortran subroutine or function found
 954                                          v_type = V_IGNORE;
 955                                          result=yytext;
 956                                          result=result.stripWhiteSpace();
 957                                          addSubprogram(result);
 958                                          BEGIN(Subprog);
 959                                        }
 960
 961 <Start,ModuleBody,SubprogBody,InterfaceBody,ModuleBodyContains,SubprogBodyContains>^{BS}({PREFIX}{BS_})?{SUBPROG}{BS_} {
 962                                          // Fortran subroutine or function found
 963                                          v_type = V_IGNORE;
 964                                          if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
 965                                          {
 966                                            addInterface("$interface$", ifType);
 967                                            startScope(last_entry);
 968                                          }
 969
 970                                          result = QCString(yytext).stripWhiteSpace();
 971                                          addSubprogram(result);
 972                                          yy_push_state(Subprog);
 973                                        }
 974
 975 <Subprog>{BS}                          {   /* ignore white space */   }
 976 <Subprog>{ID}                          { current->name = yytext;
 977                                          //cout << "1a==========> got " << current->type << " " << yytext << " " << yyLineNr << endl;
 978                                          modifiers[current_root][current->name.lower()].returnName = current->name.lower();
 979
 980                                          if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
 981                                          {
 982                                            current_root->name.replace(QRegExp("\\$interface\\$"), yytext);
 983                                          }
 984
 985                                          BEGIN(Parameterlist);
 986                                        }
 987 <Parameterlist>"("                     { current->args = "("; }
 988 <Parameterlist>")"                     {
 989                                          current->args += ")";
 990                                          current->args = removeRedundantWhiteSpace(current->args);
 991                                          addCurrentEntry(1);
 992                                          startScope(last_entry);
 993                                          BEGIN(SubprogBody);
 994                                        }
 995 <Parameterlist>{COMMA}|{BS}            { current->args += yytext;
 996                                          CommentInPrepass *c = locatePrepassComment(yyColNr-(int)yyleng, yyColNr);
 997                                          if (c!=NULL) {
 998                                            if(current->argList->count()>0) {
 999                                              current->argList->at(current->argList->count()-1)->docs = c->str;
1000                                            }
1001                                          }
1002                                        }
1003 <Parameterlist>{ID}                    {
1004                                            //current->type not yet available
1005                                            QCString param = yytext;
1006                                            // std::cout << "3=========> got parameter " << param << std::endl;
1007                                            current->args += param;
1008                                            Argument *arg = new Argument;
1009                                            arg->name = param;
1010                                            arg->type = "";
1011                                            current->argList->append(arg);
1012                                        }
1013 <Parameterlist>{NOARGS}                {
1014                                            newLine();
1015                                            //printf("3=========> without parameterlist \n");
1016                                            //current->argList = ;
1017                                            addCurrentEntry(1);
1018                                            startScope(last_entry);
1019                                            BEGIN(SubprogBody);
1020 }
1021 <SubprogBody>result{BS}\({BS}{ID}      {
1022                                            if (functionLine)
1023                                            {
1024                                              result= yytext;
1025                                              result= result.right(result.length()-result.find("(")-1);
1026                                              result= result.stripWhiteSpace();
1027                                              modifiers[current_root->parent()][current_root->name.lower()].returnName = result;
1028                                            }
1029                                            //cout << "=====> got result " <<  result << endl;
1030                                        }
1031
1032  /*---- documentation comments --------------------------------------------------------------------*/
1033
1034 <Variable,SubprogBody,ModuleBody,TypedefBody,TypedefBodyContains>"!<"  { /* backward docu comment */
1035                                           if (v_type != V_IGNORE) {
1036                                            current->docLine  = yyLineNr;
1037                                            docBlockJavaStyle = FALSE;
1038                                            docBlock.resize(0);
1039                                            docBlockJavaStyle = Config_getBool("JAVADOC_AUTOBRIEF");
1040                                            startCommentBlock(TRUE);
1041                                            yy_push_state(DocBackLine);
1042                                           }
1043                                           else
1044                                           {
1045                                             /* handle out of place !< comment as a normal comment */
1046                                             if (YY_START == String) { yyColNr -= (int)yyleng; REJECT; } // "!" is ignored in strings
1047                                             // skip comment line (without docu comments "!>" "!<" )
1048                                             /* ignore further "!" and ignore comments in Strings */
1049                                             if ((YY_START != StrIgnore) && (YY_START != String))
1050                                             {
1051                                               yy_push_state(YY_START);
1052                                               BEGIN(StrIgnore);
1053                                               debugStr="*!";
1054                                               //fprintf(stderr,"start comment %d\n",yyLineNr);
1055                                             }
1056                                           }
1057                                          }
1058 <DocBackLine>.*                          { // contents of current comment line
1059                                           docBlock+=yytext;
1060                                         }
1061 <DocBackLine>"\n"{BS}"!"("<"|"!"+)              { // comment block (next line is also comment line)
1062                                           docBlock+="\n"; // \n is necessary for lists
1063                                           newLine();
1064                                         }
1065 <DocBackLine>"\n"                               { // comment block ends at the end of this line
1066                                           //cout <<"3=========> comment block : "<< docBlock << endl;
1067                                           yyColNr -= 1;
1068                                           unput(*yytext);
1069                                           if (v_type == V_VARIABLE)
1070                                           {
1071                                             Entry *tmp_entry = current;
1072                                             current = last_entry; // temporarily switch to the previous entry
1073                                             handleCommentBlock(docBlock,TRUE);
1074                                             current=tmp_entry;
1075                                           }
1076                                           else if (v_type == V_PARAMETER)
1077                                           {
1078                                             subrHandleCommentBlock(docBlock,TRUE);
1079                                           }
1080                                           yy_pop_state();
1081                                           docBlock.resize(0);
1082                                         }
1083
1084 <Start,SubprogBody,ModuleBody,TypedefBody,InterfaceBody,ModuleBodyContains,SubprogBodyContains,TypedefBodyContains>"!>"  {
1085                                           yy_push_state(YY_START);
1086                                           current->docLine  = yyLineNr;
1087                                           docBlockJavaStyle = FALSE;
1088                                           if (YY_START==SubprogBody) docBlockInBody = TRUE;
1089                                           docBlock.resize(0);
1090                                           docBlockJavaStyle = Config_getBool("JAVADOC_AUTOBRIEF");
1091                                           startCommentBlock(TRUE);
1092                                           BEGIN(DocBlock);
1093                                           //cout << "start DocBlock " << endl;
1094                                         }
1095
1096 <DocBlock>.*                            { // contents of current comment line
1097                                           docBlock+=yytext;
1098                                         }
1099 <DocBlock>"\n"{BS}"!"(">"|"!"+)         { // comment block (next line is also comment line)
1100                                           docBlock+="\n"; // \n is necessary for lists
1101                                           newLine();
1102                                         }
1103 <DocBlock>"\n"                          { // comment block ends at the end of this line
1104                                           //cout <<"3=========> comment block : "<< docBlock << endl;
1105                                           yyColNr -= 1;
1106                                           unput(*yytext);
1107                                           handleCommentBlock(docBlock,TRUE);
1108                                           yy_pop_state();
1109                                         }
1110
1111  /*-----Prototype parsing -------------------------------------------------------------------------*/
1112 <Prototype>{BS}{SUBPROG}{BS_}           {
1113                                           BEGIN(PrototypeSubprog);
1114                                         }
1115 <Prototype,PrototypeSubprog>{BS}{SCOPENAME}?{BS}{ID} {
1116                                           current->name = QCString(yytext).lower();
1117                                           current->name.stripWhiteSpace();
1118                                           BEGIN(PrototypeArgs);
1119                                         }
1120 <PrototypeArgs>{
1121 "("|")"|","|{BS_}                       { current->args += yytext; }
1122 {ID}                                    { current->args += yytext;
1123                                           Argument *a = new Argument;
1124                                           a->name = QCString(yytext).lower();
1125                                           current->argList->append(a);
1126                                         }
1127 }
1128
1129  /*------------------------------------------------------------------------------------------------*/
1130
1131 <*>"\n"                                 {
1132                                           newLine();
1133                                           //if (debugStr.stripWhiteSpace().length() > 0) cout << "ignored text: " << debugStr << " state: " <<YY_START << endl;
1134                                           debugStr="";
1135                                         }
1136
1137
1138  /*---- error: EOF in wrong state --------------------------------------------------------------------*/
1139
1140 <*><<EOF>>                              {
1141                                           if (parsingPrototype) {
1142                                             yyterminate();
1143
1144                                           } else if ( include_stack_ptr <= 0 ) {
1145                                             if (YY_START!=INITIAL && YY_START!=Start) {
1146                                               DBG_CTX((stderr,"==== Error: EOF reached in wrong state (end missing)"));
1147                                               scanner_abort();
1148                                             }
1149                                             yyterminate();
1150                                           } else {
1151                                             popBuffer();
1152                                           }
1153                                         }
1154 <*>{LOG_OPER}                           { // Fortran logical comparison keywords
1155                                         }
1156 <*>.                                    {
1157                                           //debugStr+=yytext;
1158                                           //printf("I:%c\n", *yytext);
1159                                         } // ignore remaining text
1160
1161  /**********************************************************************************/
1162  /**********************************************************************************/
1163  /**********************************************************************************/
1164 %%
1165 //----------------------------------------------------------------------------
1166
1167 #if 0
1168 static void extractPrefix(QCString &text)
1169 {
1170   int prefixIndex = 0;
1171   int curIndex = 0;
1172   bool cont = TRUE;
1173   const char* pre[] = {"RECURSIVE","IMPURE","PURE","ELEMENTAL"};
1174   while(cont)
1175   {
1176     cont = FALSE;
1177     for(unsigned int i=0; i<4; i++)
1178     {
1179       if((prefixIndex=text.find(pre[i], curIndex, FALSE))==0)
1180       {
1181         text.remove(0,strlen(pre[i]));
1182         text.stripWhiteSpace();
1183         cont = TRUE;
1184       }
1185     }
1186   }
1187 }
1188 #endif
1189
1190 static void newLine() {
1191   yyLineNr++;
1192   yyLineNr+=lineCountPrepass;
1193   lineCountPrepass=0;
1194   comments.clear();
1195 }
1196
1197 static CommentInPrepass* locatePrepassComment(int from, int to) {
1198   //printf("Locate %d-%d\n", from, to);
1199   for(uint i=0; i<comments.count(); i++) { // todo: optimize
1200     int c = comments.at(i)->column;
1201     //printf("Candidate %d\n", c);
1202     if (c>=from && c<=to) {
1203       // comment for previous variable or parameter
1204       return comments.at(i);
1205     }
1206   }
1207   return NULL;
1208 }
1209
1210 static void updateVariablePrepassComment(int from, int to) {
1211   CommentInPrepass *c = locatePrepassComment(from, to);
1212   if (c!=NULL && v_type == V_VARIABLE) {
1213     last_entry->brief = c->str;
1214   } else if (c!=NULL && v_type == V_PARAMETER) {
1215     Argument *parameter = getParameter(argName);
1216     if (parameter) parameter->docs = c->str;
1217   }
1218 }
1219
1220 static int getAmpersandAtTheStart(const char *buf, int length)
1221 {
1222   for(int i=0; i<length; i++) {
1223     switch(buf[i]) {
1224       case ' ':
1225       case '\t':
1226         break;
1227       case '&':
1228         return i;
1229       default:
1230         return -1;
1231     }
1232   }
1233   return -1;
1234 }
1235
1236 /* Returns ampersand index, comment start index or -1 if neither exist.*/
1237 static int getAmpOrExclAtTheEnd(const char *buf, int length)
1238 {
1239   // Avoid ampersands in string and comments
1240   int parseState = Start;
1241   char quoteSymbol = 0;
1242   int ampIndex = -1;
1243   int commentIndex = -1;
1244
1245   for(int i=0; i<length && parseState!=Comment; i++)
1246   {
1247     // When in string, skip backslashes
1248     // Legacy code, not sure whether this is correct?
1249     if(parseState==String)
1250     {
1251       if(buf[i]=='\\') i++;
1252     }
1253
1254     switch(buf[i])
1255     {
1256         case '\'':
1257         case '"':
1258           // Close string, if quote symbol matches.
1259           // Quote symbol is set iff parseState==String
1260           if(buf[i]==quoteSymbol)
1261           {
1262              parseState = Start;
1263              quoteSymbol = 0;
1264           }
1265           // Start new string, if not already in string or comment
1266           else if(parseState==Start)
1267           {
1268             parseState = String;
1269             quoteSymbol = buf[i];
1270           }
1271           ampIndex = -1; // invalidate prev ampersand
1272           break;
1273         case '!':
1274           // When in string or comment, ignore exclamation mark
1275           if(parseState==Start)
1276           {
1277             parseState = Comment;
1278             commentIndex = i;
1279           }
1280           break;
1281         case ' ':  // ignore whitespace
1282         case '\t':
1283         case '\n': // this may be at the end of line
1284           break;
1285         case '&':
1286           ampIndex = i;
1287           break;
1288         default:
1289           ampIndex = -1; // invalidate prev ampersand
1290     }
1291   }
1292
1293   if (ampIndex>=0)
1294     return ampIndex;
1295   else
1296    return commentIndex;
1297 }
1298
1299 /* Although comments at the end of continuation line are grabbed by this function,
1300 * we still do not know how to use them later in parsing.
1301 */
1302 void truncatePrepass(int index)
1303 {
1304   int length = inputStringPrepass.length();
1305   for (int i=index+1; i<length; i++) {
1306     if (inputStringPrepass[i]=='!' && i<length-1 && inputStringPrepass[i+1]=='<') { // save comment
1307       struct CommentInPrepass *c=new CommentInPrepass(index, inputStringPrepass.right(length-i-2));
1308       comments.append(c);
1309     }
1310   }
1311   inputStringPrepass.truncate(index);
1312 }
1313
1314 // simplified way to know if this is fixed form
1315 // duplicate in fortrancode.l
1316 static bool recognizeFixedForm(const char* contents, FortranFormat format)
1317 {
1318   int column=0;
1319   bool skipLine=FALSE;
1320
1321   if (format == FortranFormat_Fixed) return TRUE;
1322   if (format == FortranFormat_Free)  return FALSE;
1323
1324   for(int i=0;;i++) {
1325     column++;
1326
1327     switch(contents[i]) {
1328       case '\n':
1329         column=0;
1330         skipLine=FALSE;
1331         break;
1332       case ' ':
1333         break;
1334       case '\000':
1335         return FALSE;
1336       case 'C':
1337       case 'c':
1338       case '*':
1339         if(column==1) return TRUE;
1340         if(skipLine) break;
1341         return FALSE;
1342       case '!':
1343         if(column>1 && column<7) return FALSE;
1344         skipLine=TRUE;
1345         break;
1346       default:
1347         if(skipLine) break;
1348         if(column==7) return TRUE;
1349         return FALSE;
1350     }
1351   }
1352   return FALSE;
1353 }
1354
1355 /* This function assumes that contents has at least size=length+1 */
1356 static void insertCharacter(char *contents, int length, int pos, char c)
1357 {
1358   // shift tail by one character
1359   for(int i=length; i>pos; i--)
1360     contents[i]=contents[i-1];
1361   // set the character
1362   contents[pos] = c;
1363 }
1364
1365 /* change comments and bring line continuation character to previous line */
1366 static const char* prepassFixedForm(const char* contents)
1367 {
1368   int column=0;
1369   int prevLineLength=0;
1370   int prevLineAmpOrExclIndex=-1;
1371   bool emptyLabel=TRUE;
1372   int newContentsSize = strlen(contents)+3; // \000, \n (when necessary) and one spare character (to avoid reallocation)
1373   char* newContents = (char*)malloc(newContentsSize);
1374
1375   for(int i=0, j=0;;i++,j++) {
1376     if(j>=newContentsSize-1) { // check for one spare character, which may be eventually used below (by &)
1377       newContents = (char*)realloc(newContents, newContentsSize+1000);
1378       newContentsSize = newContentsSize+1000;
1379     }
1380
1381     column++;
1382     char c = contents[i];
1383     switch(c) {
1384       case '\n':
1385         prevLineLength=column;
1386         prevLineAmpOrExclIndex=getAmpOrExclAtTheEnd(&contents[i-prevLineLength+1], prevLineLength);
1387         column=0;
1388         emptyLabel=TRUE;
1389         newContents[j]=c;
1390         break;
1391       case ' ':
1392         newContents[j]=c;
1393         break;
1394       case '\000':
1395         newContents[j]='\000';
1396         newContentsSize = strlen(newContents);
1397         if (newContents[newContentsSize - 1] != '\n')
1398         {
1399           // to be on the safe side
1400           newContents = (char*)realloc(newContents, newContentsSize+2);
1401           newContents[newContentsSize] = '\n';
1402           newContents[newContentsSize + 1] = '\000';
1403         }
1404         return newContents;
1405       case 'C':
1406       case 'c':
1407       case '*':
1408         if (column!=6)
1409         {
1410           emptyLabel=FALSE;
1411           if(column==1)
1412             newContents[j]='!';
1413           else
1414             newContents[j]=c;
1415           break;
1416         }
1417       default:
1418         if(column==6 && emptyLabel) { // continuation
1419           if (c != '0') { // 0 not allowed as continuatioin character, see f95 standard paragraph 3.3.2.3
1420             newContents[j]=' ';
1421
1422             if(prevLineAmpOrExclIndex==-1) { // add & just before end of previous line
1423               insertCharacter(newContents, j+1, (j+1)-6-1, '&');
1424               j++;
1425             } else { // add & just before end of previous line comment
1426               insertCharacter(newContents, j+1, (j+1)-6-prevLineLength+prevLineAmpOrExclIndex, '&');
1427               j++;
1428             }
1429           } else {
1430             newContents[j]=c; // , just handle like space
1431           }
1432         } else {
1433           newContents[j]=c;
1434           emptyLabel=FALSE;
1435         }
1436         break;
1437     }
1438   }
1439
1440   newContentsSize = strlen(newContents);
1441   if (newContents[newContentsSize - 1] != '\n')
1442   {
1443     // to be on the safe side
1444     newContents = (char*)realloc(newContents, newContentsSize+2);
1445     newContents[newContentsSize] = '\n';
1446     newContents[newContentsSize + 1] = '\000';
1447   }
1448   return newContents;
1449 }
1450
1451 static void pushBuffer(QCString& buffer)
1452 {
1453   if (include_stack_cnt <= include_stack_ptr)
1454   {
1455      include_stack_cnt++;
1456      include_stack = (YY_BUFFER_STATE *)realloc(include_stack, include_stack_cnt * sizeof(YY_BUFFER_STATE));
1457   }
1458   include_stack[include_stack_ptr++] = YY_CURRENT_BUFFER;
1459   yy_switch_to_buffer(yy_scan_string(buffer));
1460
1461   DBG_CTX((stderr, "--PUSH--%s", (const char *)buffer));
1462   buffer = NULL;
1463 }
1464
1465 static void popBuffer() {
1466   DBG_CTX((stderr, "--POP--"));
1467   include_stack_ptr --;
1468   yy_delete_buffer( YY_CURRENT_BUFFER );
1469   yy_switch_to_buffer( include_stack[include_stack_ptr] );
1470 }
1471
1472 /** used to copy entry to an interface module procedure */
1473 static void copyEntry(Entry *dest, Entry *src)
1474 {
1475    dest->type     = src->type;
1476    dest->fileName = src->fileName;
1477    dest->bodyLine = src->bodyLine;
1478    dest->args     = src->args;
1479    dest->argList  = new ArgumentList(*src->argList);
1480    dest->doc      = src->doc;
1481    dest->brief    = src->brief;
1482 }
1483
1484 /** fill empty interface module procedures with info from
1485     corresponding module subprogs
1486     @TODO: handle procedures in used modules
1487 */
1488 void resolveModuleProcedures(QList<Entry> &moduleProcedures, Entry *current_root)
1489 {
1490   if (moduleProcedures.isEmpty()) return;
1491
1492   EntryListIterator eli1(moduleProcedures);
1493   // for all module procedures
1494   for (Entry *ce1; (ce1=eli1.current()); ++eli1)
1495   {
1496     // check all entries in this module
1497     EntryListIterator eli2(*current_root->children());
1498     for (Entry *ce2; (ce2=eli2.current()); ++eli2)
1499     {
1500       if (ce1->name == ce2->name)
1501       {
1502         copyEntry(ce1, ce2);
1503       }
1504     } // for procedures in current module
1505   } // for all interface module procedures
1506   moduleProcedures.clear();
1507 }
1508
1509 #if 0
1510 static bool isTypeName(QCString name)
1511 {
1512   name = name.lower();
1513   return name=="integer" || name == "real" ||
1514          name=="complex" || name == "logical";
1515 }
1516 #endif
1517
1518 /*! Extracts string which resides within parentheses of provided string. */
1519 static QCString extractFromParens(const QCString name)
1520 {
1521   QCString extracted = name;
1522   int start = extracted.find("(");
1523   if (start != -1)
1524   {
1525     extracted.remove(0, start+1);
1526   }
1527   int end = extracted.findRev(")");
1528   if (end != -1)
1529   {
1530     int length = extracted.length();
1531     extracted.remove(end, length);
1532   }
1533   extracted = extracted.stripWhiteSpace();
1534
1535   return extracted;
1536 }
1537
1538 /*! Adds passed modifiers to these modifiers.*/
1539 SymbolModifiers& SymbolModifiers::operator|=(const SymbolModifiers &mdfs)
1540 {
1541   if (mdfs.protection!=NONE_P) protection = mdfs.protection;
1542   if (mdfs.direction!=NONE_D) direction = mdfs.direction;
1543   optional |= mdfs.optional;
1544   if (!mdfs.dimension.isNull()) dimension = mdfs.dimension;
1545   allocatable |= mdfs.allocatable;
1546   external |= mdfs.external;
1547   intrinsic |= mdfs.intrinsic;
1548   protect |= mdfs.protect;
1549   parameter |= mdfs.parameter;
1550   pointer |= mdfs.pointer;
1551   target |= mdfs.target;
1552   save |= mdfs.save;
1553   deferred |= mdfs.deferred;
1554   nonoverridable |= mdfs.nonoverridable;
1555   nopass |= mdfs.nopass;
1556   pass |= mdfs.pass;
1557   passVar = mdfs.passVar;
1558   return *this;
1559 }
1560
1561 /*! Extracts  and adds passed modifier to these modifiers.*/
1562 SymbolModifiers& SymbolModifiers::operator|=(QCString mdfString)
1563 {
1564   mdfString = mdfString.lower();
1565   SymbolModifiers newMdf;
1566
1567   if (mdfString.find("dimension")==0)
1568   {
1569     newMdf.dimension=mdfString;
1570   }
1571   else if (mdfString.contains("intent"))
1572   {
1573     QCString tmp = extractFromParens(mdfString);
1574     bool isin = tmp.contains("in");
1575     bool isout = tmp.contains("out");
1576     if (isin && isout) newMdf.direction = SymbolModifiers::INOUT;
1577     else if (isin) newMdf.direction = SymbolModifiers::IN;
1578     else if (isout) newMdf.direction = SymbolModifiers::OUT;
1579   }
1580   else if (mdfString=="public")
1581   {
1582     newMdf.protection = SymbolModifiers::PUBLIC;
1583   }
1584   else if (mdfString=="private")
1585   {
1586     newMdf.protection = SymbolModifiers::PRIVATE;
1587   }
1588   else if (mdfString=="protected")
1589   {
1590     newMdf.protect = TRUE;
1591   }
1592   else if (mdfString=="optional")
1593   {
1594     newMdf.optional = TRUE;
1595   }
1596   else if (mdfString=="allocatable")
1597   {
1598     newMdf.allocatable = TRUE;
1599   }
1600   else if (mdfString=="external")
1601   {
1602     newMdf.external = TRUE;
1603   }
1604   else if (mdfString=="intrinsic")
1605   {
1606     newMdf.intrinsic = TRUE;
1607   }
1608   else if (mdfString=="parameter")
1609   {
1610     newMdf.parameter = TRUE;
1611   }
1612   else if (mdfString=="pointer")
1613   {
1614     newMdf.pointer = TRUE;
1615   }
1616   else if (mdfString=="target")
1617   {
1618     newMdf.target = TRUE;
1619   }
1620   else if (mdfString=="save")
1621   {
1622     newMdf.save = TRUE;
1623   }
1624   else if (mdfString=="nopass")
1625   {
1626     newMdf.nopass = TRUE;
1627   }
1628   else if (mdfString=="deferred")
1629   {
1630     newMdf.deferred = TRUE;
1631   }
1632   else if (mdfString=="non_overridable")
1633   {
1634     newMdf.nonoverridable = TRUE;
1635   }
1636   else if (mdfString.contains("pass"))
1637   {
1638     newMdf.pass = TRUE;
1639     if (mdfString.contains("("))
1640       newMdf.passVar = extractFromParens(mdfString);
1641     else
1642       newMdf.passVar = "";
1643   }
1644
1645   (*this) |= newMdf;
1646   return *this;
1647 }
1648
1649 /*! For debugging purposes. */
1650 //ostream& operator<<(ostream& out, const SymbolModifiers& mdfs)
1651 //{
1652 //  out<<mdfs.protection<<", "<<mdfs.direction<<", "<<mdfs.optional<<
1653 //    ", "<<(mdfs.dimension.isNull() ? "" : mdfs.dimension.latin1())<<
1654 //    ", "<<mdfs.allocatable<<", "<<mdfs.external<<", "<<mdfs.intrinsic;
1655 //
1656 //  return out;
1657 //}
1658
1659 /*! Find argument with given name in \a subprog entry. */
1660 static Argument *findArgument(Entry* subprog, QCString name, bool byTypeName = FALSE)
1661 {
1662   QCString cname(name.lower());
1663   for (unsigned int i=0; i<subprog->argList->count(); i++)
1664   {
1665     Argument *arg = subprog->argList->at(i);
1666     if ((!byTypeName && arg->name.lower() == cname) ||
1667         (byTypeName && arg->type.lower() == cname)
1668        )
1669     {
1670       return arg;
1671     }
1672   }
1673   return 0;
1674 }
1675
1676 /*! Find function with given name in \a entry. */
1677 #if 0
1678 static Entry *findFunction(Entry* entry, QCString name)
1679 {
1680   QCString cname(name.lower());
1681
1682   EntryListIterator eli(*entry->children());
1683   Entry *ce;
1684   for (;(ce=eli.current());++eli)
1685   {
1686     if (ce->section != Entry::FUNCTION_SEC)
1687       continue;
1688
1689     if (ce->name.lower() == cname)
1690       return ce;
1691   }
1692
1693   return 0;
1694 }
1695 #endif
1696
1697 /*! Apply modifiers stored in \a mdfs to the \a typeName string. */
1698 static QCString applyModifiers(QCString typeName, SymbolModifiers& mdfs)
1699 {
1700   if (!mdfs.dimension.isNull())
1701   {
1702     if (!typeName.isEmpty()) typeName += ", ";
1703     typeName += mdfs.dimension;
1704   }
1705   if (mdfs.direction!=SymbolModifiers::NONE_D)
1706   {
1707     if (!typeName.isEmpty()) typeName += ", ";
1708     typeName += directionStrs[mdfs.direction];
1709   }
1710   if (mdfs.optional)
1711   {
1712     if (!typeName.isEmpty()) typeName += ", ";
1713     typeName += "optional";
1714   }
1715   if (mdfs.allocatable)
1716   {
1717     if (!typeName.isEmpty()) typeName += ", ";
1718     typeName += "allocatable";
1719   }
1720   if (mdfs.external)
1721   {
1722     if (!typeName.isEmpty()) typeName += ", ";
1723     typeName += "external";
1724   }
1725   if (mdfs.intrinsic)
1726   {
1727     if (!typeName.isEmpty()) typeName += ", ";
1728     typeName += "intrinsic";
1729   }
1730   if (mdfs.parameter)
1731   {
1732     if (!typeName.isEmpty()) typeName += ", ";
1733     typeName += "parameter";
1734   }
1735   if (mdfs.pointer)
1736   {
1737     if (!typeName.isEmpty()) typeName += ", ";
1738     typeName += "pointer";
1739   }
1740   if (mdfs.target)
1741   {
1742     if (!typeName.isEmpty()) typeName += ", ";
1743     typeName += "target";
1744   }
1745   if (mdfs.save)
1746   {
1747     if (!typeName.isEmpty()) typeName += ", ";
1748     typeName += "save";
1749   }
1750   if (mdfs.deferred)
1751   {
1752     if (!typeName.isEmpty()) typeName += ", ";
1753     typeName += "deferred";
1754   }
1755   if (mdfs.nonoverridable)
1756   {
1757     if (!typeName.isEmpty()) typeName += ", ";
1758     typeName += "non_overridable";
1759   }
1760   if (mdfs.nopass)
1761   {
1762     if (!typeName.isEmpty()) typeName += ", ";
1763     typeName += "nopass";
1764   }
1765   if (mdfs.pass)
1766   {
1767     if (!typeName.isEmpty()) typeName += ", ";
1768     typeName += "pass";
1769     if (!mdfs.passVar.isEmpty())
1770       typeName += "(" + mdfs.passVar + ")";
1771   }
1772   if (mdfs.protection == SymbolModifiers::PUBLIC)
1773   {
1774     if (!typeName.isEmpty()) typeName += ", ";
1775     typeName += "public";
1776   }
1777   else if (mdfs.protection == SymbolModifiers::PRIVATE)
1778   {
1779     if (!typeName.isEmpty()) typeName += ", ";
1780     typeName += "private";
1781   }
1782   if (mdfs.protect)
1783   {
1784     if (!typeName.isEmpty()) typeName += ", ";
1785     typeName += "protected";
1786   }
1787
1788   return typeName;
1789 }
1790
1791 /*! Apply modifiers stored in \a mdfs to the \a arg argument. */
1792 static void applyModifiers(Argument *arg, SymbolModifiers& mdfs)
1793 {
1794   QCString tmp = arg->type;
1795   arg->type = applyModifiers(tmp, mdfs);
1796 }
1797
1798 /*! Apply modifiers stored in \a mdfs to the \a ent entry. */
1799 static void applyModifiers(Entry *ent, SymbolModifiers& mdfs)
1800 {
1801   QCString tmp = ent->type;
1802   ent->type = applyModifiers(tmp, mdfs);
1803
1804   if (mdfs.protection == SymbolModifiers::PUBLIC)
1805     ent->protection = Public;
1806   else if (mdfs.protection == SymbolModifiers::PRIVATE)
1807     ent->protection = Private;
1808 }
1809
1810 /*! Starts the new scope in fortran program. Consider using this function when
1811  * starting module, interface, function or other program block.
1812  * \see endScope()
1813  */
1814 static void startScope(Entry *scope)
1815 {
1816   //cout<<"start scope: "<<scope->name<<endl;
1817   current_root= scope; /* start substructure */
1818
1819   QMap<QCString,SymbolModifiers> mdfMap;
1820   modifiers.insert(scope, mdfMap);
1821 }
1822
1823 /*! Ends scope in fortran program: may update subprogram arguments or module variable attributes.
1824  * \see startScope()
1825  */
1826 static bool endScope(Entry *scope, bool isGlobalRoot)
1827 {
1828   //cout<<"end scope: "<<scope->name<<endl;
1829   if (current_root->parent() || isGlobalRoot)
1830   {
1831     current_root= current_root->parent(); /* end substructure */
1832   }
1833   else
1834   {
1835     fprintf(stderr,"parse error in end <scopename>");
1836     scanner_abort();
1837     return FALSE;
1838   }
1839
1840   // update variables or subprogram arguments with modifiers
1841   QMap<QCString,SymbolModifiers>& mdfsMap = modifiers[scope];
1842
1843   if (scope->section == Entry::FUNCTION_SEC)
1844   {
1845     // iterate all symbol modifiers of the scope
1846     for (QMap<QCString,SymbolModifiers>::Iterator it=mdfsMap.begin(); it!=mdfsMap.end(); it++)
1847     {
1848       //cout<<it.key()<<": "<<it.data()<<endl;
1849       Argument *arg = findArgument(scope, it.key());
1850
1851       if (arg)
1852         applyModifiers(arg, it.data());
1853     }
1854
1855     // find return type for function
1856     //cout<<"RETURN NAME "<<modifiers[current_root][scope->name.lower()].returnName<<endl;
1857     QCString returnName = modifiers[current_root][scope->name.lower()].returnName.lower();
1858     if (modifiers[scope].contains(returnName))
1859     {
1860       scope->type = modifiers[scope][returnName].type; // returning type works
1861       applyModifiers(scope, modifiers[scope][returnName]); // returning array works
1862     }
1863
1864   }
1865   if (scope->section == Entry::CLASS_SEC)
1866   { // was INTERFACE_SEC
1867     if (scope->parent()->section == Entry::FUNCTION_SEC)
1868     { // interface within function
1869       // iterate functions of interface and
1870       // try to find types for dummy(ie. argument) procedures.
1871       //cout<<"Search in "<<scope->name<<endl;
1872       EntryListIterator eli(*scope->children());
1873       Entry *ce;
1874       int count = 0;
1875       int found = FALSE;
1876       for (;(ce=eli.current());++eli)
1877       {
1878         count++;
1879         if (ce->section != Entry::FUNCTION_SEC)
1880           continue;
1881
1882         Argument *arg = findArgument(scope->parent(), ce->name, TRUE);
1883         if (arg != 0)
1884         {
1885           // set type of dummy procedure argument to interface
1886           arg->name = arg->type;
1887           arg->type = scope->name;
1888         }
1889         if (ce->name.lower() == scope->name.lower()) found = TRUE;
1890       }
1891       if ((count == 1) && found)
1892       {
1893         // clear all modifiers of the scope
1894         modifiers.remove(scope);
1895         delete scope->parent()->removeSubEntry(scope);
1896         scope = 0;
1897         return TRUE;
1898       }
1899     }
1900   }
1901   if (scope->section!=Entry::FUNCTION_SEC)
1902   { // not function section
1903     // iterate variables: get and apply modifiers
1904     EntryListIterator eli(*scope->children());
1905     Entry *ce;
1906     for (;(ce=eli.current());++eli)
1907     {
1908       if (ce->section != Entry::VARIABLE_SEC && ce->section != Entry::FUNCTION_SEC)
1909         continue;
1910
1911       //cout<<ce->name<<", "<<mdfsMap.contains(ce->name.lower())<<mdfsMap.count()<<endl;
1912       if (mdfsMap.contains(ce->name.lower()))
1913         applyModifiers(ce, mdfsMap[ce->name.lower()]);
1914     }
1915   }
1916
1917   // clear all modifiers of the scope
1918   modifiers.remove(scope);
1919
1920   return TRUE;
1921 }
1922
1923 #if 0
1924 //! Return full name of the entry. Sometimes we must combine several names recursively.
1925 static QCString getFullName(Entry *e)
1926 {
1927   QCString name = e->name;
1928   if (e->section == Entry::CLASS_SEC //  || e->section == Entry::INTERFACE_SEC
1929      || !e->parent() || e->parent()->name.isEmpty())
1930     return name;
1931
1932   return getFullName(e->parent())+"::"+name;
1933 }
1934 #endif
1935
1936 static int yyread(char *buf,int max_size)
1937 {
1938   int c=0;
1939
1940   while ( c < max_size && inputString[inputPosition] )
1941   {
1942     *buf = inputString[inputPosition++] ;
1943     c++; buf++;
1944   }
1945   return c;
1946 }
1947
1948 static void initParser()
1949 {
1950   last_entry = 0;
1951 }
1952
1953 static void initEntry()
1954 {
1955   if (typeMode)
1956   {
1957     current->protection = typeProtection;
1958   }
1959   else
1960   {
1961     current->protection = defaultProtection;
1962   }
1963   current->mtype      = mtype;
1964   current->virt       = virt;
1965   current->stat       = gstat;
1966   current->lang       = SrcLangExt_Fortran;
1967   initGroupInfo(current);
1968 }
1969
1970 /**
1971   adds current entry to current_root and creates new current
1972 */
1973 static void addCurrentEntry(int case_insens)
1974 {
1975   if (case_insens) current->name = current->name.lower();
1976   //printf("===Adding entry %s to %s\n", current->name.data(), current_root->name.data());
1977   current_root->addSubEntry(current);
1978   last_entry = current;
1979   current = new Entry ;
1980   initEntry();
1981 }
1982
1983 static int max(int a, int b) {return a>b?a:b;}
1984
1985 static void addModule(const char *name, bool isModule)
1986 {
1987   DBG_CTX((stderr, "0=========> got module %s\n", name));
1988
1989   if (isModule)
1990     current->section = Entry::CLASS_SEC;
1991   else
1992     current->section = Entry::FUNCTION_SEC;
1993
1994   if (name!=NULL)
1995   {
1996     current->name = name;
1997   }
1998   else
1999   {
2000     QCString fname = yyFileName;
2001     int index = max(fname.findRev('/'), fname.findRev('\\'));
2002     fname = fname.right(fname.length()-index-1);
2003     fname = fname.prepend("__").append("__");
2004     current->name = fname;
2005   }
2006   current->type = "program";
2007   current->fileName  = yyFileName;
2008   current->bodyLine  = yyLineNr; // used for source reference
2009   current->protection = Public ;
2010   addCurrentEntry(1);
2011   startScope(last_entry);
2012 }
2013
2014
2015 static void addSubprogram(const char *text)
2016 {
2017   DBG_CTX((stderr,"1=========> got subprog, type: %s\n",text));
2018   subrCurrent.prepend(current);
2019   current->section = Entry::FUNCTION_SEC ;
2020   QCString subtype = text; subtype=subtype.lower().stripWhiteSpace();
2021   functionLine = (subtype.find("function") != -1);
2022   current->type += " " + subtype;
2023   current->type = current->type.stripWhiteSpace();
2024   current->fileName  = yyFileName;
2025   current->bodyLine  = yyLineNr; // used for source reference
2026   current->startLine = -1; // ??? what is startLine for?
2027   current->args.resize(0);
2028   current->argList->clear();
2029   docBlock.resize(0);
2030 }
2031
2032 /*! Adds interface to the root entry.
2033  * \note Code was brought to this procedure from the parser,
2034  * because there was/is idea to use it in several parts of the parser.
2035  */
2036 static void addInterface(QCString name, InterfaceType type)
2037 {
2038   if (YY_START == Start)
2039   {
2040     addModule(NULL);
2041     yy_push_state(ModuleBody); //anon program
2042   }
2043
2044   current->section = Entry::CLASS_SEC; // was Entry::INTERFACE_SEC;
2045   current->spec = Entry::Interface;
2046   current->name = name;
2047
2048   switch (type)
2049   {
2050     case IF_ABSTRACT:
2051       current->type = "abstract";
2052       break;
2053
2054     case IF_GENERIC:
2055       current->type = "generic";
2056       break;
2057
2058     case IF_SPECIFIC:
2059     case IF_NONE:
2060     default:
2061       current->type = "";
2062   }
2063
2064   /* if type is part of a module, mod name is necessary for output */
2065   if ((current_root) &&
2066       (current_root->section ==  Entry::CLASS_SEC ||
2067        current_root->section ==  Entry::NAMESPACE_SEC))
2068   {
2069     current->name= current_root->name + "::" + current->name;
2070   }
2071
2072   current->fileName = yyFileName;
2073   current->bodyLine  = yyLineNr;
2074   addCurrentEntry(1);
2075 }
2076
2077
2078 //-----------------------------------------------------------------------------
2079
2080 /*! Get the argument \a name.
2081  */
2082 static Argument* getParameter(const QCString &name)
2083 {
2084   // std::cout<<"addFortranParameter(): "<<name<<" DOCS:"<<(docs.isNull()?QCString("null"):docs)<<std::endl;
2085   Argument *ret = 0;
2086   if (current_root->argList==0) return 0;
2087   ArgumentListIterator ali(*current_root->argList);
2088   Argument *a;
2089   for (ali.toFirst();(a=ali.current());++ali)
2090   {
2091     if (a->name.lower()==name.lower())
2092     {
2093       ret=a;
2094       //printf("parameter found: %s\n",(const char*)name);
2095       break;
2096     }
2097   } // for
2098   return ret;
2099 }
2100
2101   //----------------------------------------------------------------------------
2102 static void startCommentBlock(bool brief)
2103 {
2104   if (brief)
2105   {
2106     current->briefFile = yyFileName;
2107     current->briefLine = yyLineNr;
2108   }
2109   else
2110   {
2111     current->docFile = yyFileName;
2112     current->docLine = yyLineNr;
2113   }
2114 }
2115
2116 //----------------------------------------------------------------------------
2117
2118 static void handleCommentBlock(const QCString &doc,bool brief)
2119 {
2120   bool needsEntry = FALSE;
2121   static bool hideInBodyDocs = Config_getBool("HIDE_IN_BODY_DOCS");
2122   int position=0;
2123   if (docBlockInBody && hideInBodyDocs)
2124   {
2125     docBlockInBody = FALSE;
2126     return;
2127   }
2128   DBG_CTX((stderr,"call parseCommentBlock [%s]\n",doc.data()));
2129   int lineNr = brief ? current->briefLine : current->docLine;
2130   while (parseCommentBlock(
2131         g_thisParser,
2132         docBlockInBody ? subrCurrent.getFirst() : current,
2133         doc,        // text
2134         yyFileName, // file
2135         lineNr,
2136         docBlockInBody ? FALSE : brief,
2137         docBlockInBody ? FALSE : docBlockJavaStyle,
2138         docBlockInBody,
2139         defaultProtection,
2140         position,
2141         needsEntry
2142         ))
2143   {
2144            DBG_CTX((stderr,"parseCommentBlock position=%d [%s]  needsEntry=%d\n",position,doc.data()+position,needsEntry));
2145    if (needsEntry) addCurrentEntry(0);
2146   }
2147   DBG_CTX((stderr,"parseCommentBlock position=%d [%s]  needsEntry=%d\n",position,doc.data()+position,needsEntry));
2148
2149   if (needsEntry) addCurrentEntry(0);
2150   docBlockInBody = FALSE;
2151 }
2152
2153 //----------------------------------------------------------------------------
2154
2155 static void subrHandleCommentBlock(const QCString &doc,bool brief)
2156 {
2157   QCString loc_doc;
2158   Entry *tmp_entry = current;
2159   current = subrCurrent.getFirst(); // temporarily switch to the entry of the subroutine / function
2160
2161   // Still in the specification section so no inbodyDocs yet, but parameter documentation
2162   current->inbodyDocs = "";
2163
2164   if (docBlock.stripWhiteSpace().find("\\param") == 0)
2165   {
2166     handleCommentBlock("\n\n"+doc,brief);
2167   }
2168   else if (docBlock.stripWhiteSpace().find("@param") == 0)
2169   {
2170     handleCommentBlock("\n\n"+doc,brief);
2171   }
2172   else
2173   {
2174     int dir1 = modifiers[current_root][argName.lower()].direction;
2175     loc_doc = doc.stripWhiteSpace();
2176     if (loc_doc.lower().find(directionParam[SymbolModifiers::IN]) == 0)
2177     {
2178       if ((directionParam[dir1] == directionParam[SymbolModifiers::NONE_D]) ||
2179           (directionParam[dir1] == directionParam[SymbolModifiers::IN]))
2180       {
2181         handleCommentBlock(QCString("\n\n@param ") + directionParam[SymbolModifiers::IN] + " " +
2182                            argName + " " + loc_doc.right(loc_doc.length()-strlen(directionParam[SymbolModifiers::IN])),brief);
2183       }
2184       else
2185       {
2186         warn(yyFileName,yyLineNr, "inconsistency between intent attribute and documenation for variable: "+argName);
2187         handleCommentBlock(QCString("\n\n@param ") + directionParam[dir1] + " " +
2188                            argName + " " + doc,brief);
2189       }
2190     }
2191     else if (loc_doc.lower().find(directionParam[SymbolModifiers::OUT]) == 0)
2192     {
2193       if ((directionParam[dir1] == directionParam[SymbolModifiers::NONE_D]) ||
2194           (directionParam[dir1] == directionParam[SymbolModifiers::OUT]))
2195       {
2196         handleCommentBlock(QCString("\n\n@param ") + directionParam[SymbolModifiers::OUT] + " " +
2197                            argName + " " + loc_doc.right(loc_doc.length()-strlen(directionParam[SymbolModifiers::OUT])),brief);
2198       }
2199       else
2200       {
2201         warn(yyFileName,yyLineNr, "inconsistency between intent attribute and documenation for variable: "+argName);
2202         handleCommentBlock(QCString("\n\n@param ") + directionParam[dir1] + " " +
2203                            argName + " " + doc,brief);
2204       }
2205     }
2206     else if (loc_doc.lower().find(directionParam[SymbolModifiers::INOUT]) == 0)
2207     {
2208       if ((directionParam[dir1] == directionParam[SymbolModifiers::NONE_D]) ||
2209           (directionParam[dir1] == directionParam[SymbolModifiers::INOUT]))
2210       {
2211         handleCommentBlock(QCString("\n\n@param ") + directionParam[SymbolModifiers::INOUT] + " " +
2212                            argName + " " + loc_doc.right(loc_doc.length()-strlen(directionParam[SymbolModifiers::INOUT])),brief);
2213       }
2214       else
2215       {
2216         warn(yyFileName,yyLineNr, "inconsistency between intent attribute and documenation for variable: "+argName);
2217         handleCommentBlock(QCString("\n\n@param ") + directionParam[dir1] + " " +
2218                            argName + " " + doc,brief);
2219       }
2220     }
2221     else
2222     {
2223       handleCommentBlock(QCString("\n\n@param ") + directionParam[dir1] + " " +
2224                          argName + " " + doc,brief);
2225     }
2226   }
2227   current=tmp_entry;
2228 }
2229
2230 //----------------------------------------------------------------------------
2231 #if 0
2232 static int level=0;
2233
2234 static void debugCompounds(Entry *rt)  // print Entry structure (for debugging)
2235 {
2236  level++;
2237   printf("%d) debugCompounds(%s) line %d\n",level, rt->name.data(), rt->bodyLine);
2238   EntryListIterator eli(*rt->children());
2239   Entry *ce;
2240   for (;(ce=eli.current());++eli)
2241   {
2242      debugCompounds(ce);
2243   }
2244 level--;
2245 }
2246 #endif
2247
2248
2249 static void parseMain(const char *fileName,const char *fileBuf,Entry *rt, FortranFormat format)
2250 {
2251   char *tmpBuf = NULL;
2252   initParser();
2253
2254   defaultProtection = Public;
2255   inputString = fileBuf;
2256   inputPosition = 0;
2257   inputStringPrepass = NULL;
2258   inputPositionPrepass = 0;
2259
2260   //anonCount     = 0;  // don't reset per file
2261   mtype         = Method;
2262   gstat         = FALSE;
2263   virt          = Normal;
2264   current_root  = rt;
2265   global_root   = rt;
2266   inputFile.setName(fileName);
2267   if (inputFile.open(IO_ReadOnly))
2268   {
2269     isFixedForm = recognizeFixedForm(fileBuf,format);
2270
2271     if (isFixedForm)
2272     {
2273       msg("Prepassing fixed form of %s\n", fileName);
2274       //printf("---strlen=%d\n", strlen(fileBuf));
2275       //clock_t start=clock();
2276
2277       inputString = prepassFixedForm(fileBuf);
2278
2279       //clock_t end=clock();
2280       //printf("CPU time used=%f\n", ((double) (end-start))/CLOCKS_PER_SEC);
2281     }
2282     else if (inputString[strlen(fileBuf)-1] != '\n')
2283     {
2284       tmpBuf = (char *)malloc(strlen(fileBuf)+2);
2285       strcpy(tmpBuf,fileBuf);
2286       tmpBuf[strlen(fileBuf)]= '\n';
2287       tmpBuf[strlen(fileBuf)+1]= '\000';
2288       inputString = tmpBuf;
2289     }
2290
2291     yyLineNr= 1 ;
2292     yyFileName = fileName;
2293     msg("Parsing file %s...\n",yyFileName.data());
2294
2295     startScope(rt); // implies current_root = rt
2296     initParser();
2297     groupEnterFile(yyFileName,yyLineNr);
2298
2299     current          = new Entry;
2300     current->lang    = SrcLangExt_Fortran;
2301     current->name    = yyFileName;
2302     current->section = Entry::SOURCE_SEC;
2303     current_root->addSubEntry(current);
2304     file_root        = current;
2305     current          = new Entry;
2306     current->lang    = SrcLangExt_Fortran;
2307
2308     fortranscannerYYrestart( fortranscannerYYin );
2309     {
2310       BEGIN( Start );
2311     }
2312
2313     fortranscannerYYlex();
2314     groupLeaveFile(yyFileName,yyLineNr);
2315
2316     endScope(current_root, TRUE); // TRUE - global root
2317
2318     //debugCompounds(rt); //debug
2319
2320     rt->program.resize(0);
2321     delete current; current=0;
2322     moduleProcedures.clear();
2323     if (tmpBuf) {
2324       free((char*)tmpBuf);
2325       inputString=NULL;
2326     }
2327     if (isFixedForm) {
2328       free((char*)inputString);
2329       inputString=NULL;
2330     }
2331
2332     inputFile.close();
2333   }
2334 }
2335
2336 //----------------------------------------------------------------------------
2337
2338 void FortranLanguageScanner::parseInput(const char *fileName,
2339                                         const char *fileBuf,
2340                                         Entry *root,
2341                                         bool /*sameTranslationUnit*/,
2342                                         QStrList & /*filesInSameTranslationUnit*/)
2343 {
2344   g_thisParser = this;
2345
2346   printlex(yy_flex_debug, TRUE, __FILE__, fileName);
2347
2348   ::parseMain(fileName,fileBuf,root,m_format);
2349
2350   printlex(yy_flex_debug, FALSE, __FILE__, fileName);
2351 }
2352
2353 void FortranLanguageScanner::parseCode(CodeOutputInterface & codeOutIntf,
2354                    const char * scopeName,
2355                    const QCString & input,
2356                    SrcLangExt /*lang*/,
2357                    bool isExampleBlock,
2358                    const char * exampleName,
2359                    FileDef * fileDef,
2360                    int startLine,
2361                    int endLine,
2362                    bool inlineFragment,
2363                    MemberDef *memberDef,
2364                    bool showLineNumbers,
2365                    Definition *searchCtx,
2366                    bool collectXRefs
2367                   )
2368 {
2369   ::parseFortranCode(codeOutIntf,scopeName,input,isExampleBlock,exampleName,
2370                      fileDef,startLine,endLine,inlineFragment,memberDef,
2371                      showLineNumbers,searchCtx,collectXRefs,m_format);
2372 }
2373
2374 bool FortranLanguageScanner::needsPreprocessing(const QCString &extension)
2375 {
2376   return extension!=extension.lower(); // use preprocessor only for upper case extensions
2377 }
2378 void FortranLanguageScanner::resetCodeParserState()
2379 {
2380   ::resetFortranCodeParserState();
2381 }
2382
2383 void FortranLanguageScanner::parsePrototype(const char *text)
2384 {
2385   QCString buffer = QCString(text);
2386   pushBuffer(buffer);
2387   parsingPrototype = TRUE;
2388   BEGIN(Prototype);
2389   fortranscannerYYlex();
2390   parsingPrototype = FALSE;
2391   popBuffer();
2392 }
2393
2394 static void scanner_abort()
2395 {
2396   fprintf(stderr,"********************************************************************\n");
2397   fprintf(stderr,"Error in file %s line: %d, state: %d\n",yyFileName.data(),yyLineNr,YY_START);
2398   fprintf(stderr,"********************************************************************\n");
2399
2400   EntryListIterator eli(*global_root->children());
2401   Entry *ce;
2402   bool start=FALSE;
2403
2404   for (;(ce=eli.current());++eli)
2405   {
2406      if (ce == file_root) start=TRUE;
2407      if (start) ce->reset();
2408   }
2409
2410   // dummy call to avoid compiler warning
2411   (void)yy_top_state();
2412
2413   return;
2414   //exit(-1);
2415 }
2416
2417 //----------------------------------------------------------------------------
2418
2419 #if !defined(YY_FLEX_SUBMINOR_VERSION)
2420 //----------------------------------------------------------------------------
2421 extern "C" { // some bogus code to keep the compiler happy
2422   void fortranscannernerYYdummy() { yy_flex_realloc(0,0); }
2423 }
2424 #endif
2425