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