path: root/src/fortranscanner.l

/* -*- mode: fundamental; indent-tabs-mode: 1; -*- */
/*****************************************************************************
 * Parser for Fortran90 F subset
 *
 * Copyright (C) by Anke Visser
 * based on the work of Dimitri van Heesch.
 *
 * Permission to use, copy, modify, and distribute this software and its
 * documentation under the terms of the GNU General Public License is hereby 
 * granted. No representations are made about the suitability of this software 
 * for any purpose. It is provided "as is" without express or implied warranty.
 * See the GNU General Public License for more details.
 *
 * Documents produced by Doxygen are derivative works derived from the
 * input used in their production; they are not affected by this license.
 *
 */ 

/* Developer notes.
 *
 * - Consider using startScope(), endScope() functions with  module, program, 
 * subroutine or any other scope in fortran program.
 *
 * - Symbol modifiers (attributes) are collected using SymbolModifiers |= operator during
 * substructure parsing. When substructure ends all modifiers are applied to actual
 * entries in applyModifiers() functions.
 * 
 * - How case insensitiveness should be handled in code?
 * On one side we have arg->name and entry->name, on another side modifierMap[name].
 * In entries and arguments case is the same as in code, in modifier map case is lowered and
 * then it is compared to lowered entry/argument names.
 *
 * - Do not like constructs like aa{BS} or {BS}bb. Should try to handle blank space
 * with separate rule?: It seems it is often necessary, because we may parse something like 
 * "functionA" or "MyInterface". So constructs like `(^|[ \t])interface({BS_}{ID})?/[ \t\n]'
 * are desired.
 *
 * - Must track yyLineNr when using REJECT, unput() or similar commands.
 */

%{

#include <stdio.h> 
#include <stdlib.h>
#include <assert.h>
#include <ctype.h>

#include <qarray.h>
#include <qstack.h>
#include <qregexp.h>
#include <unistd.h> 
#include <qfile.h>
#include <qmap.h>
  
#include "fortranscanner.h"
#include "entry.h"
#include "message.h"
#include "config.h"
#include "doxygen.h"
#include "util.h"
#include "defargs.h"
#include "language.h"
#include "commentscan.h" 
#include "fortrancode.h"
#include "pre.h"
#include "arguments.h"

// Toggle for some debugging info
//#define DBG_CTX(x) fprintf x
#define DBG_CTX(x) do { } while(0)

#define YY_NEVER_INTERACTIVE 1
#define YY_NO_INPUT 1

enum ScanVar { V_IGNORE, V_VARIABLE, V_PARAMETER};
enum InterfaceType { IF_NONE, IF_SPECIFIC, IF_GENERIC, IF_ABSTRACT };

// {{{ ----- Helper structs -----
//! Holds modifiers (ie attributes) for one symbol (variable, function, etc)
struct SymbolModifiers {
  enum Protection {NONE_P, PUBLIC, PRIVATE};
  enum Direction {NONE_D, IN, OUT, INOUT};

  //!< This is only used with function return value.
  QCString type, returnName;
  Protection protection;
  Direction direction;
  bool optional;
  bool protect;
  QCString dimension;
  bool allocatable;
  bool external;
  bool intrinsic;
  bool parameter;
  bool pointer;
  bool target;
  bool save;
  bool deferred;
  bool nonoverridable;
  bool nopass;
  bool pass;
  QCString passVar;

  SymbolModifiers() : type(), returnName(), protection(NONE_P), direction(NONE_D),
    optional(FALSE), protect(FALSE), dimension(), allocatable(FALSE),
    external(FALSE), intrinsic(FALSE), parameter(FALSE),
    pointer(FALSE), target(FALSE), save(FALSE), deferred(FALSE), nonoverridable(FALSE),
    nopass(FALSE), pass(FALSE), passVar() {}

  SymbolModifiers& operator|=(const SymbolModifiers &mdfs);
  SymbolModifiers& operator|=(QCString mdfrString);
};

//ostream& operator<<(ostream& out, const SymbolModifiers& mdfs);

static const char *directionStrs[] = 
{
   "", "intent(in)", "intent(out)", "intent(inout)"
};
static const char *directionParam[] = 
{
   "", "[in]", "[out]", "[in,out]"
};

// }}}

/* -----------------------------------------------------------------
 *
 *	statics
 */
static ParserInterface *g_thisParser; 
static const char *     inputString;
static int		inputPosition;
static bool             isFixedForm;
static QCString         inputStringPrepass; ///< Input string for prepass of line cont. '&'
static QCString         inputStringSemi; ///< Input string after command separetor ';'
static unsigned int     inputPositionPrepass;
static int              lineCountPrepass = 0;

static QList<Entry>  subrCurrent;

struct CommentInPrepass {
  int column;
  QCString str;
  CommentInPrepass(int column, QCString str) : column(column), str(str) {}
};
static QList<CommentInPrepass>  comments;

YY_BUFFER_STATE *include_stack = NULL;
int include_stack_ptr = 0;
int include_stack_cnt = 0;

static QFile            inputFile;
static QCString		yyFileName;
static int		yyLineNr     = 1 ;
static int		yyColNr     = 0 ;
static Entry*		current_root = 0 ;
static Entry*		global_root  = 0 ;
static Entry*		file_root    = 0 ;
static Entry*		current      = 0 ;
static Entry*		last_entry   = 0 ;
static ScanVar          v_type       = V_IGNORE; // type of parsed variable
static QList<Entry>     moduleProcedures; // list of all interfaces which contain unresolved 
                                          // module procedures
static QCString         docBlock;
static QCString         docBlockName;
static bool             docBlockInBody = FALSE;
static bool             docBlockJavaStyle;

static MethodTypes 	mtype;
static bool    		gstat;
static Specifier 	virt;

static QCString          debugStr;
static QCString          result; // function result
static Argument          *parameter; // element of parameter list
static QCString          argType;  // fortran type of an argument of a parameter list
static QCString          argName;  // last identifier name in variable list
static QCString          initializer;  // initial value of a variable
static int               initializerArrayScope;  // number if nested array scopes in initializer
static int               initializerScope;  // number if nested function calls in initializer
static QCString          useModuleName;  // name of module in the use statement
static Protection        defaultProtection;
static Protection        typeProtection;
static int               typeMode = false;
static InterfaceType     ifType = IF_NONE;
static bool              functionLine = FALSE;

static char              stringStartSymbol; // single or double quote
static bool              parsingPrototype = FALSE; // see parsePrototype()

//! Accumulated modifiers of current statement, eg variable declaration.
static SymbolModifiers currentModifiers;
//! Holds program scope->symbol name->symbol modifiers.
static QMap<Entry*,QMap<QCString,SymbolModifiers> > modifiers;

//-----------------------------------------------------------------------------

static int yyread(char *buf,int max_size);
static void startCommentBlock(bool);
static void handleCommentBlock(const QCString &doc,bool brief);
static void subrHandleCommentBlock(const QCString &doc,bool brief);
static void addCurrentEntry(int case_insens);
static void addModule(const char *name, bool isModule=FALSE);
static void addSubprogram(const char *text);
static void addInterface(QCString name, InterfaceType type);
static Argument *getParameter(const QCString &name);
static void scanner_abort();

static void startScope(Entry *scope);
static bool endScope(Entry *scope, bool isGlobalRoot=FALSE);
//static bool isTypeName(QCString name);
static void resolveModuleProcedures(QList<Entry> &moduleProcedures, Entry *current_root);
static int getAmpersandAtTheStart(const char *buf, int length);
static int getAmpOrExclAtTheEnd(const char *buf, int length);
static void truncatePrepass(int index);
static void pushBuffer(QCString &buffer);
static void popBuffer();
//static void extractPrefix(QCString& text);
static QCString extractFromParens(const QCString name);
static CommentInPrepass* locatePrepassComment(int from, int to);
static void updateVariablePrepassComment(int from, int to);
static void newLine();

//-----------------------------------------------------------------------------
#undef	YY_INPUT
#define	YY_INPUT(buf,result,max_size) result=yyread(buf,max_size);
#define YY_USER_ACTION yyColNr+=(int)yyleng;
//-----------------------------------------------------------------------------

%}

 //-----------------------------------------------------------------------------
 //-----------------------------------------------------------------------------
IDSYM	  [a-z_A-Z0-9]
NOTIDSYM  [^a-z_A-Z0-9]
SEPARATE  [:, \t]
ID        [a-z_A-Z%]+{IDSYM}*
ID_       [a-z_A-Z%]*{IDSYM}*
PP_ID     {ID}
LABELID   [a-z_A-Z]+[a-z_A-Z0-9\-]*
SUBPROG   (subroutine|function)
B         [ \t]
BS        [ \t]*
BS_       [ \t]+
COMMA     {BS},{BS}
ARGS_L0   ("("[^)]*")")
ARGS_L1a  [^()]*"("[^)]*")"[^)]*
ARGS_L1   ("("{ARGS_L1a}*")")
ARGS_L2   "("({ARGS_L0}|[^()]|{ARGS_L1a}|{ARGS_L1})*")"
ARGS      {BS}({ARGS_L0}|{ARGS_L1}|{ARGS_L2})
NOARGS    {BS}"\n"

NUM_TYPE  (complex|integer|logical|real)
LOG_OPER  (\.and\.|\.eq\.|\.eqv\.|\.ge\.|\.gt\.|\.le\.|\.lt\.|\.ne\.|\.neqv\.|\.or\.|\.not\.)
KIND      {ARGS}
CHAR      (CHARACTER{ARGS}?|CHARACTER{BS}"*"({BS}[0-9]+|{ARGS}))
TYPE_SPEC (({NUM_TYPE}({BS}"*"{BS}[0-9]+)?)|({NUM_TYPE}{KIND})|DOUBLE{BS}COMPLEX|DOUBLE{BS}PRECISION|{CHAR}|TYPE{ARGS}|CLASS{ARGS}|PROCEDURE{ARGS}?)

INTENT_SPEC intent{BS}"("{BS}(in|out|in{BS}out){BS}")"
ATTR_SPEC (ALLOCATABLE|DIMENSION{ARGS}|EXTERNAL|{INTENT_SPEC}|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PROTECTED|PRIVATE|PUBLIC|SAVE|TARGET|NOPASS|PASS{ARGS}?|DEFERRED|NON_OVERRIDABLE)
ACCESS_SPEC (PRIVATE|PUBLIC)
LANGUAGE_BIND_SPEC BIND{BS}"("{BS}C{BS}(,{BS}NAME{BS}"="{BS}"\""(.*)"\""{BS})?")"
/* Assume that attribute statements are almost the same as attributes. */
ATTR_STMT {ATTR_SPEC}|DIMENSION|{ACCESS_SPEC}

CONTAINS  CONTAINS
PREFIX    (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|IMPURE|PURE|ELEMENTAL)?
SCOPENAME ({ID}{BS}"::"{BS})*

%option noyywrap
%option stack
%option caseless
/*%option debug */

 //---------------------------------------------------------------------------------

 /** fortran parsing states */
%x	Subprog
%x	SubprogPrefix
%x	Parameterlist
%x	SubprogBody
%x	SubprogBodyContains
%x	Start
%x	Comment
%x      Module
%x      Program
%x      ModuleBody
%x	ModuleBodyContains
%x	AttributeList
%x      Variable
%x      Initialization
%x      ArrayInitializer
%x      Typedef
%x      TypedefBody
%x      TypedefBodyContains
%x      InterfaceBody
%x      StrIgnore
%x      String
%x      Use
%x      UseOnly
%x      ModuleProcedure

%x      Prepass

 /** comment parsing states */
%x	DocBlock
%x	DocBackLine
%x	EndDoc

%x      BlockData

/** prototype parsing */
%x  	Prototype
%x  	PrototypeSubprog
%x	PrototypeArgs

%%

 /*-----------------------------------------------------------------------------------*/

<*>^.*\n                                { // prepass: look for line continuations
  					  functionLine = FALSE;

                                          DBG_CTX((stderr, "---%s", yytext));

                                            int indexStart = getAmpersandAtTheStart(yytext, (int)yyleng);
                                            int indexEnd = getAmpOrExclAtTheEnd(yytext, (int)yyleng);
					    if (indexEnd>=0 && yytext[indexEnd]!='&') //we are only interested in amp
					      indexEnd=-1;

                                            if(indexEnd<0){ // ----- no ampersand as line continuation
                                               if(YY_START == Prepass) { // last line in "continuation"

                                                 // Only take input after initial ampersand
                                                 inputStringPrepass+=(const char*)(yytext+(indexStart+1));
   
						 //printf("BUFFER:%s\n", (const char*)inputStringPrepass);
                                                 pushBuffer(inputStringPrepass);
						 yyColNr = 0;						 
                                                 yy_pop_state();
                                               } else { // simple line
					         yyColNr = 0;
                                                 REJECT;
                                               }

                                            } else { // ----- line with continuation
                                              if(YY_START != Prepass) {
                                                comments.setAutoDelete(TRUE);
						comments.clear();
                                                yy_push_state(Prepass);
                                              }

                                              int length = inputStringPrepass.length();

                                              // Only take input after initial ampersand
                                              inputStringPrepass+=(const char*)(yytext+(indexStart+1));
                                              lineCountPrepass ++;

                                              // cut off & and remove following comment if present
					      truncatePrepass(length+indexEnd-(indexStart+1));
                                            }

                                        }


 /*------ ignore strings that are not initialization strings */ 
<*>"\\\\"				{ if (yy_top_state() == Initialization
					      || yy_top_state() == ArrayInitializer)
					    initializer+=yytext;
					}
<*>"\\\""|\\\'                          { if (yy_top_state() == Initialization
					      || yy_top_state() == ArrayInitializer)
					    initializer+=yytext;
					}
<String>\"|\'                           { // string ends with next quote without previous backspace
                                          if (yytext[0]!=stringStartSymbol) { yyColNr -= (int)yyleng; REJECT; } // single vs double quote
					  if (yy_top_state() == Initialization
					      || yy_top_state() == ArrayInitializer)
					    initializer+=yytext;
                                          yy_pop_state();
                                        }           
<String>.                               { if (yy_top_state() == Initialization
					      || yy_top_state() == ArrayInitializer)
					    initializer+=yytext;
					} 
<*>\"|\'                                { /* string starts */
					  if (YY_START == StrIgnore) { yyColNr -= (int)yyleng; REJECT; }; // ignore in simple comments
                                          yy_push_state(YY_START);
                                          if (yy_top_state() == Initialization
					      || yy_top_state() == ArrayInitializer)
					    initializer+=yytext;
                                          stringStartSymbol=yytext[0]; // single or double quote
                                          BEGIN(String);
                                        }

 /*------ ignore simple comment (not documentation comments) */

<*>"!"/[^<>\n]                         {  if (YY_START == String) { yyColNr -= (int)yyleng; REJECT; } // "!" is ignored in strings
                                          // skip comment line (without docu comments "!>" "!<" ) 
                                          /* ignore further "!" and ignore comments in Strings */
                                          if ((YY_START != StrIgnore) && (YY_START != String)) 
					  {
                                            yy_push_state(YY_START);
                                            BEGIN(StrIgnore); 
                                            debugStr="*!";
                                            DBG_CTX((stderr,"start comment %d\n",yyLineNr));
                                           }      
                                        }
<StrIgnore>.?/\n                        { yy_pop_state(); // comment ends with endline character
                                          DBG_CTX((stderr,"end comment %d %s\n",yyLineNr,debugStr.data()));
                                        } // comment line ends
<StrIgnore>.                            { debugStr+=yytext; } 


 /*------ use handling ------------------------------------------------------------*/

<Start,ModuleBody,SubprogBody>"use"{BS_} {
                                          if(YY_START == Start)
                                          {
                                            addModule(NULL); 
                                            yy_push_state(ModuleBody); //anon program
                                          }
                                          yy_push_state(Use);
                                        }
<Use>{ID}                               { 
                                          DBG_CTX((stderr,"using dir %s\n",yytext));
                                          current->name=yytext;
                                          current->fileName = yyFileName; 
  					  current->section=Entry::USINGDIR_SEC;
					  current_root->addSubEntry(current);
					  current = new Entry;
                                          current->lang = SrcLangExt_Fortran; 
                                          yy_pop_state();
                                        }
<Use>{ID}/,                             { 
                                          useModuleName=yytext;
                                        }
<Use>,{BS}"ONLY"                        { BEGIN(UseOnly); 
                                        }           
<UseOnly>{BS},{BS}                      {}
<UseOnly>{ID}                           {
  					  current->name= useModuleName+"::"+yytext;
                                          current->fileName = yyFileName; 
  					  current->section=Entry::USINGDECL_SEC;
					  current_root->addSubEntry(current);
					  current = new Entry ;
                                          current->lang = SrcLangExt_Fortran; 
  					}
<Use,UseOnly>"\n"                       {
					  yyColNr -= 1;
                                          unput(*yytext);
                                          yy_pop_state();
                                        }

 /* INTERFACE definitions */
<Start,ModuleBody,SubprogBody>{
^{BS}interface{IDSYM}+			{ /* variable with interface prefix */ }
^{BS}interface                          { ifType = IF_SPECIFIC;
                                          yy_push_state(InterfaceBody);
                                          // do not start a scope here, every
                                          // interface body is a scope of its own
                                        }

^{BS}abstract{BS_}interface             { ifType = IF_ABSTRACT;
                                          yy_push_state(InterfaceBody);
                                          // do not start a scope here, every
                                          // interface body is a scope of its own
                                        }

^{BS}interface{BS_}{ID}{ARGS}?          { ifType = IF_GENERIC;
                                          yy_push_state(InterfaceBody);

                                          // extract generic name
                                          QCString name = QCString(yytext).stripWhiteSpace();
                                          name = name.right(name.length() - 9).stripWhiteSpace().lower();
                                          addInterface(name, ifType);
                                          startScope(last_entry);
                                        }
}

<InterfaceBody>^{BS}end{BS}interface({BS_}{ID})? {
                                          // end scope only if GENERIC interface
                                          if (ifType == IF_GENERIC && !endScope(current_root))
                                            yyterminate();

                                          ifType = IF_NONE;
                                          yy_pop_state();
                                        }
<InterfaceBody>module{BS}procedure      { yy_push_state(YY_START);
                                          BEGIN(ModuleProcedure);
                                        }
<ModuleProcedure>{ID}                   { if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
                                          {
                                            addInterface(yytext, ifType);
                                            startScope(last_entry);
                                          }

                                          current->section = Entry::FUNCTION_SEC ;
                                          current->name = yytext; 
                                          moduleProcedures.append(current);
                                          addCurrentEntry(1);
                                        }
<ModuleProcedure>"\n"                   { yyColNr -= 1;
					  unput(*yytext); 
                                          yy_pop_state();
                                        }
<InterfaceBody>.                        {}

 /*-- Contains handling --*/
<Start>^{BS}{CONTAINS}/({BS}|\n|!)      {
                                          if(YY_START == Start)
                                          {
                                            addModule(NULL); 
                                            yy_push_state(ModuleBodyContains); //anon program
                                          }                                            
                                        }
<ModuleBody>^{BS}{CONTAINS}/({BS}|\n|!)   { BEGIN(ModuleBodyContains); }
<SubprogBody>^{BS}{CONTAINS}/({BS}|\n|!)  { BEGIN(SubprogBodyContains); }
<TypedefBody>^{BS}{CONTAINS}/({BS}|\n|!)  { BEGIN(TypedefBodyContains); }

 /*------ module handling ------------------------------------------------------------*/ 
<Start>block{BS}data{BS}{ID_}        {  //
                                         v_type = V_IGNORE;
					    yy_push_state(BlockData);
                                            defaultProtection = Public;
                                       }
<Start>module|program{BS_}             {  //
                                         v_type = V_IGNORE;
					    if(yytext[0]=='m' || yytext[0]=='M')
					      yy_push_state(Module);
					    else
					      yy_push_state(Program);
                                            defaultProtection = Public;
                                       }
<BlockData>^{BS}"end"({BS}(block{BS}data)({BS_}{ID})?)?{BS}/(\n|!) { // end block data
					    //if (!endScope(current_root))
					    //  yyterminate();
                                            defaultProtection = Public;
					    yy_pop_state();
                                       }
<Start,ModuleBody,ModuleBodyContains>^{BS}"end"({BS}(module|program)({BS_}{ID})?)?{BS}/(\n|!) { // end module	
					    resolveModuleProcedures(moduleProcedures, current_root);
					    if (!endScope(current_root))
					      yyterminate();
                                            defaultProtection = Public;
					    yy_pop_state();
                                       }
<Module>{ID}                           {  
                                            addModule(yytext, TRUE);
					    BEGIN(ModuleBody);
                                       }

<Program>{ID}                           {  
                                            addModule(yytext, FALSE);
					    BEGIN(ModuleBody);
                                       }

  /*------- access specification --------------------------------------------------------------------------*/

<ModuleBody>private/{BS}(\n|"!")         { defaultProtection = Private;
                                           current->protection = defaultProtection ;
                                         }
<ModuleBody>public/{BS}(\n|"!")          { defaultProtection = Public;
                                           current->protection = defaultProtection ;
                                         }

 /*------- type definition  -------------------------------------------------------------------------------*/

<Start,ModuleBody>^{BS}type/[^a-z0-9_]   {
                                          if(YY_START == Start)
                                          {
                                            addModule(NULL); 
                                            yy_push_state(ModuleBody); //anon program
                                          }

                                          yy_push_state(Typedef);
                                          current->protection = defaultProtection;
                                          typeProtection = defaultProtection;
                                          typeMode = true;
                                        }
<Typedef>{
{COMMA}                                 {}

{BS}"::"{BS}                            {}

abstract                                {
                                          current->spec |= Entry::AbstractClass;
                                        }
extends{ARGS}                           {
                                          QCString basename = extractFromParens(yytext);
                                          current->extends->append(new BaseInfo(basename, Public, Normal));
                                        }
public                                  {
                                          current->protection = Public;
                                          typeProtection = Public;
                                        }
private                                 {
                                          current->protection = Private;
                                          typeProtection = Private;
                                        }
{LANGUAGE_BIND_SPEC}                    {
                                          /* ignored for now */
                                        }
{ID}                                    { /* type name found */
                                          current->section = Entry::CLASS_SEC;
                                          current->spec |= Entry::Struct;
                                          current->name = yytext;
                                          current->fileName = yyFileName;
                                          current->bodyLine  = yyLineNr; 

                                          /* if type is part of a module, mod name is necessary for output */
                                          if ((current_root) && 
                                              (current_root->section == Entry::CLASS_SEC
                                               || current_root->section == Entry::NAMESPACE_SEC))
                                          {
                                            current->name = current_root->name + "::" + current->name;
                                          }

                                          addCurrentEntry(1);
                                          startScope(last_entry); 
                                          BEGIN(TypedefBody);
                                        }
}

<TypedefBodyContains>{                  /* Type Bound Procedures */
^{BS}PROCEDURE{ARGS}?                   {
                                          current->type = QCString(yytext).simplifyWhiteSpace();
                                        }
^{BS}final                              {
                                          current->spec |= Entry::Final;
                                          current->type = QCString(yytext).simplifyWhiteSpace();
                                        }
^{BS}generic                            {
                                          current->type = QCString(yytext).simplifyWhiteSpace();
                                        }
{COMMA}                                 {
                                        }
{ATTR_SPEC}                             {
                                          currentModifiers |= QCString(yytext);
                                        }
{BS}"::"{BS}                            {
                                        }
{ID}                                    {
                                          QCString name = yytext;
                                          modifiers[current_root][name.lower()] |= currentModifiers;
                                          current->section  = Entry::FUNCTION_SEC;
                                          current->name     = name;
                                          current->fileName = yyFileName;
                                          current->bodyLine = yyLineNr;
                                          addCurrentEntry(1);
                                        }
{BS}"=>"[^(\n|\!)]*                     { /* Specific bindings come after the ID. */
                                          last_entry->args = yytext;
                                        }
"\n"                                    {
                                          currentModifiers = SymbolModifiers();
					  newLine();
                                          docBlock.resize(0);
                                        }
}


<TypedefBody,TypedefBodyContains>{
^{BS}"end"{BS}"type"({BS_}{ID})?{BS}/(\n|!) { /* end type definition */
                                          if (!endScope(current_root))
                                            yyterminate();
                                          typeMode = false;
                                          yy_pop_state();
                                        }
}

 /*------- module/global/typedef variable ---------------------------------------------------*/

<SubprogBody,SubprogBodyContains>^{BS}[0-9]*{BS}"end"({BS}{SUBPROG}({BS_}{ID})?)?{BS}/(\n|!) {  
                                           //
                                           // ABSTRACT and specific interfaces are stored
                                           // in a scope of their own, even if multiple
                                           // are group in one INTERFACE/END INTERFACE block.
                                           //
                                           if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
                                             endScope(current_root);

					   if (!endScope(current_root))
					     yyterminate();
                                           subrCurrent.remove(0u);
					   yy_pop_state() ;
				        }
<BlockData>{
{ID}                                    {
                                        }
}
<Start,ModuleBody,TypedefBody,SubprogBody>{
^{BS}{TYPE_SPEC}/{SEPARATE}             {
                                          /* variable declaration starts */
                                          if(YY_START == Start)
                                          {
                                            addModule(NULL); 
                                            yy_push_state(ModuleBody); //anon program
                                          }
					  argType = QCString(yytext).simplifyWhiteSpace().lower();
					  yy_push_state(AttributeList);
                                        }
  /*  Dimitri: macro expansion should already be done during preprocessing not here!
^{BS}{PP_ID}{KIND}?			{ // check for preprocessor symbol expand to type
					  QCString str = yytext;
					  str = str.stripWhiteSpace();
					  //DefineDict* defines = getGlobalDefineDict();
					  QCString name;
					  int index = str.find("(");
					  if (index != -1)
					    name = str.left(index).stripWhiteSpace();
					  else
					    name = str;

					  Define *define = 0; //(*defines)[name];
					  if (define != 0 && isTypeName(define->definition)) 
					  {
					    argType = str;
					    yy_push_state(AttributeList);
					  } 
					  else 
					  {
					    yyColNr -= (int)yyleng;
					    REJECT;
					  }
					}
  */
{ATTR_STMT}/{BS_}{ID}		       |
{ATTR_STMT}/{BS}"::"                   { 
                                          /* attribute statement starts */
                                          DBG_CTX((stderr,"5=========> Attribute statement: %s\n", yytext)); 
                                          QCString tmp = yytext;
                                          currentModifiers |= tmp.stripWhiteSpace();
					  argType="";
					  yy_push_state(YY_START);
					  BEGIN( AttributeList ) ;
  				       }
{ID}	                               {
                                       }  
^{BS}"type"{BS_}"is"/{BS_}             { }
^{BS}"type"{BS}"="                     { }
}
<AttributeList>{
{COMMA}					{}
{BS}					{}
{ATTR_SPEC}.				{ /* update current modifierswhen it is an ATTR_SPEC and not a variable name */
            				  /* bug_625519 */
                                          QChar chr = yytext[(int)yyleng-1];
                                          if (chr.isLetter() || chr.isDigit() || (chr == '_'))
                                          {
					    yyColNr -= (int)yyleng;
                                            REJECT;
                                          }
                                          else
                                          {
                                            QCString tmp = yytext;
                                            tmp = tmp.left(tmp.length() - 1);
					    yyColNr -= 1;
                                            unput(yytext[(int)yyleng-1]);
                                            currentModifiers |= (tmp);
                                          }
					}
"::"					{ /* end attribute list */
					  BEGIN( Variable );
					}
.					{ /* unknown attribute, consider variable name */
					  //cout<<"start variables, unput "<<*yytext<<endl;
					  yyColNr -= 1;
					  unput(*yytext);
					  BEGIN( Variable );
					}
}

<Variable>{BS}				{ }
<Variable>{ID}				{ /* parse variable declaration */
                                          //cout << "5=========> got variable: " << argType << "::" << yytext << endl;
 					  /* work around for bug in QCString.replace (QCString works) */
					  QCString name=yytext;
                                          name = name.lower();
					  /* remember attributes for the symbol */
					  modifiers[current_root][name.lower()] |= currentModifiers;
					  argName= name;

					  v_type= V_IGNORE;
  					  if (!argType.isEmpty() && current_root->section!=Entry::FUNCTION_SEC) 
					  { // new variable entry
					    v_type = V_VARIABLE;
                                            current->section = Entry::VARIABLE_SEC;
 					    current->name = argName;
					    current->type = argType;
					    current->fileName = yyFileName;
					    current->bodyLine  = yyLineNr; // used for source reference
                                            addCurrentEntry(1);
                                          } 
					  else if (!argType.isEmpty())
					  { // declaration of parameter list: add type for corr. parameter 
					    parameter = getParameter(argName);
					    if (parameter) 
					    {
					      v_type= V_PARAMETER;
					      if (!argType.isNull()) parameter->type=argType.stripWhiteSpace();
					      if (!docBlock.isNull()) 
					      {
  					        subrHandleCommentBlock(docBlock,TRUE);
					      }					    
					    }
					    // save, it may be function return type
					    if (parameter)
					    {
					      modifiers[current_root][name.lower()].type = argType;
					    }
					    else
					    {
					      if ((current_root->name.lower() == argName.lower()) ||
						  (modifiers[current_root->parent()][current_root->name.lower()].returnName.lower() == argName.lower()))
					      {
						int strt = current_root->type.find("function");
						QCString lft;
						QCString rght;
						if (strt != -1)
						{
						  lft = "";
						  rght = "";
						  if (strt != 0) lft = current_root->type.left(strt).stripWhiteSpace();
						  if ((current_root->type.length() - strt - strlen("function"))!= 0)
						  {
						    rght = current_root->type.right(current_root->type.length() - strt - strlen("function")).stripWhiteSpace();
						  }
						  current_root->type = lft;
						  if (rght.length() > 0)
						  {
						    if (current_root->type.length() > 0) current_root->type += " ";
						    current_root->type += rght;
						  }
						  if (argType.stripWhiteSpace().length() > 0)
						  {
						    if (current_root->type.length() > 0) current_root->type += " ";
						    current_root->type += argType.stripWhiteSpace();
						  }
						  if (current_root->type.length() > 0) current_root->type += " ";
						  current_root->type += "function";
						}
						else
						{
						  current_root->type += " " + argType.stripWhiteSpace();
						}
						current_root->type = current_root->type.stripWhiteSpace();
						modifiers[current_root][name.lower()].type = current_root->type;
					      }
					      else
					      {
						modifiers[current_root][name.lower()].type = argType;
					      }
					    }
					    // any accumulated doc for argument should be emptied,
					    // because it is handled other way and this doc can be
					    // unexpectedly passed to the next member.
					    current->doc.resize(0);
					    current->brief.resize(0);
					  } 
  					}
<Variable>{ARGS}			{ /* dimension of the previous entry. */
					  QCString name(argName);
					  QCString attr("dimension");
					  attr += yytext;
					  modifiers[current_root][name.lower()] |= attr;
					}
<Variable>{COMMA}	                { //printf("COMMA: %d<=..<=%d\n", yyColNr-(int)yyleng, yyColNr);
					  // locate !< comment
					  updateVariablePrepassComment(yyColNr-(int)yyleng, yyColNr);
					}
<Variable>{BS}"="                       { yy_push_state(YY_START);
                                          initializer="=";
                                          initializerScope = initializerArrayScope = 0;
					  BEGIN(Initialization);
                                        }
<Variable>"\n"	                        { currentModifiers = SymbolModifiers();
                                          yy_pop_state(); // end variable declaration list
					  newLine();
                                          docBlock.resize(0);
                                        }
<Variable>";".*"\n"                     { currentModifiers = SymbolModifiers();
                                          yy_pop_state(); // end variable declaration list
                                          docBlock.resize(0);
                                          inputStringSemi =(const char*)(QCString(" \n") + QCString(yytext+1)).data();
                                          yyLineNr--;
                                          pushBuffer(inputStringSemi);
                                        }
<*>";".*"\n"                            {
					  if (YY_START == Variable) REJECT; // Just be on the safe side
                                          if (YY_START == String) REJECT; // ";" ignored in strings
                                          if (YY_START == StrIgnore) REJECT; // ";" ignored in regular comments
                                          inputStringSemi =(const char*)(QCString(" \n") + QCString(yytext+1)).data();
                                          yyLineNr--;
                                          pushBuffer(inputStringSemi);
                                        }

<Initialization,ArrayInitializer>"["    |
<Initialization,ArrayInitializer>"(/"   { initializer+=yytext;
                                           initializerArrayScope++;
                                           BEGIN(ArrayInitializer); // initializer may contain comma
                                        }
<ArrayInitializer>"]"                   |
<ArrayInitializer>"/)"                  { initializer+=yytext;
                                           initializerArrayScope--;
                                           if(initializerArrayScope<=0)
                                           {
                                              initializerArrayScope = 0; // just in case
                                              BEGIN(Initialization);
                                           }
                                        }
<ArrayInitializer>.                     { initializer+=yytext; }
<Initialization>"("			{ initializerScope++;
					  initializer+=yytext;
					}
<Initialization>")"			{ initializerScope--;
					  initializer+=yytext;
					}
<Initialization>{COMMA}                 { if (initializerScope == 0)
					  {
					    updateVariablePrepassComment(yyColNr-(int)yyleng, yyColNr);
					    yy_pop_state(); // end initialization
                                            if (v_type == V_VARIABLE) last_entry->initializer= initializer;
					  }
					  else
					    initializer+=", ";
					}
<Initialization>"\n"|"!"                { //|
                                          yy_pop_state(); // end initialization
                                          if (v_type == V_VARIABLE) last_entry->initializer= initializer;
					  yyColNr -= 1;
 					  unput(*yytext);
                                        }
<Initialization>.                       { initializer+=yytext; }
 
 /*------ fortran subroutine/function handling ------------------------------------------------------------*/
 /*       Start is initial condition                                                                       */
 
<Start,ModuleBody,SubprogBody,InterfaceBody,ModuleBodyContains,SubprogBodyContains>^{BS}({PREFIX}{BS_})?{TYPE_SPEC}{BS}({PREFIX}{BS_})?/{SUBPROG}{BS_} {
                                         if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
                                         {
                                           addInterface("$interface$", ifType);
                                           startScope(last_entry);
                                         }

                                         // TYPE_SPEC is for old function style function result
                                         result = QCString(yytext).stripWhiteSpace().lower();
                                         current->type = result;
                                         yy_push_state(SubprogPrefix);
                                       }

<SubprogPrefix>{BS}{SUBPROG}{BS_}     {
                                         // Fortran subroutine or function found
                                         v_type = V_IGNORE;
                                         result=yytext;
                                         result=result.stripWhiteSpace();
                                         addSubprogram(result);
                                         BEGIN(Subprog);
                                       }

<Start,ModuleBody,SubprogBody,InterfaceBody,ModuleBodyContains,SubprogBodyContains>^{BS}({PREFIX}{BS_})?{SUBPROG}{BS_} {
                                         // Fortran subroutine or function found
                                         v_type = V_IGNORE;
                                         if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
                                         {
                                           addInterface("$interface$", ifType);
                                           startScope(last_entry);
                                         }

                                         result = QCString(yytext).stripWhiteSpace();
                                         addSubprogram(result);
                                         yy_push_state(Subprog);
                                       }

<Subprog>{BS}                          {   /* ignore white space */   }
<Subprog>{ID}                          { current->name = yytext;
                                         //cout << "1a==========> got " << current->type << " " << yytext << " " << yyLineNr << endl;
                                         modifiers[current_root][current->name.lower()].returnName = current->name.lower();

                                         if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
                                         {
                                           current_root->name.replace(QRegExp("\\$interface\\$"), yytext);
                                         }

                                         BEGIN(Parameterlist);
                                       }
<Parameterlist>"("                     { current->args = "("; }
<Parameterlist>")"                     {
				         current->args += ")";
				         current->args = removeRedundantWhiteSpace(current->args);
                                         addCurrentEntry(1);
					 startScope(last_entry);
					 BEGIN(SubprogBody);
				       }
<Parameterlist>{COMMA}|{BS}            { current->args += yytext;
					 CommentInPrepass *c = locatePrepassComment(yyColNr-(int)yyleng, yyColNr);
					 if (c!=NULL) {
                                           if(current->argList->count()>0) {
					     current->argList->at(current->argList->count()-1)->docs = c->str;
					   }
					 }		         
				       }
<Parameterlist>{ID}                    {
				           //current->type not yet available
                                           QCString param = yytext;
					   // std::cout << "3=========> got parameter " << param << std::endl;
					   current->args += param;
					   Argument *arg = new Argument;
					   arg->name = param;
					   arg->type = "";
					   current->argList->append(arg);
 				       } 
<Parameterlist>{NOARGS}                {   
				           newLine();
					   //printf("3=========> without parameterlist \n");
 					   //current->argList = ;
                                           addCurrentEntry(1);
					   startScope(last_entry);
					   BEGIN(SubprogBody);				           
}
<SubprogBody>result{BS}\({BS}{ID}      {  
  					   if (functionLine)
					   {
                                             result= yytext;
                                             result= result.right(result.length()-result.find("(")-1);
                                             result= result.stripWhiteSpace();
 					     modifiers[current_root->parent()][current_root->name.lower()].returnName = result;
					   }
                                           //cout << "=====> got result " <<  result << endl;
 				       } 

 /*---- documentation comments --------------------------------------------------------------------*/

<Variable,SubprogBody,ModuleBody,TypedefBody,TypedefBodyContains>"!<"  { /* backward docu comment */
                                          if (v_type != V_IGNORE) {
					   current->docLine  = yyLineNr;
 					   docBlockJavaStyle = FALSE;
					   docBlock.resize(0);
					   docBlockJavaStyle = Config_getBool("JAVADOC_AUTOBRIEF");
					   startCommentBlock(TRUE);
                                           yy_push_state(DocBackLine);
                                          }
                                          else
                                          {
                                            /* handle out of place !< comment as a normal comment */
                                            if (YY_START == String) { yyColNr -= (int)yyleng; REJECT; } // "!" is ignored in strings
                                            // skip comment line (without docu comments "!>" "!<" ) 
                                            /* ignore further "!" and ignore comments in Strings */
                                            if ((YY_START != StrIgnore) && (YY_START != String)) 
					    {
                                              yy_push_state(YY_START);
                                              BEGIN(StrIgnore); 
                                              debugStr="*!";
                                              //fprintf(stderr,"start comment %d\n",yyLineNr);
                                            }      
                                          }
  					 }
<DocBackLine>.*    			 { // contents of current comment line
                                          docBlock+=yytext;
  					}
<DocBackLine>"\n"{BS}"!"("<"|"!"+)		{ // comment block (next line is also comment line)
					  docBlock+="\n"; // \n is necessary for lists
					  newLine();
  					}
<DocBackLine>"\n"        			{ // comment block ends at the end of this line
                                          //cout <<"3=========> comment block : "<< docBlock << endl;
					  yyColNr -= 1;
					  unput(*yytext);                                        
					  if (v_type == V_VARIABLE) 
					  {
					    Entry *tmp_entry = current; 
					    current = last_entry; // temporarily switch to the previous entry
  					    handleCommentBlock(docBlock,TRUE);
 					    current=tmp_entry;
                                          }
					  else if (v_type == V_PARAMETER) 
					  {
					    subrHandleCommentBlock(docBlock,TRUE);
                                          }
					  yy_pop_state();
					  docBlock.resize(0);
                                        }

<Start,SubprogBody,ModuleBody,TypedefBody,InterfaceBody,ModuleBodyContains,SubprogBodyContains,TypedefBodyContains>"!>"  {
                                          yy_push_state(YY_START);
					  current->docLine  = yyLineNr;
 					  docBlockJavaStyle = FALSE;
					  if (YY_START==SubprogBody) docBlockInBody = TRUE;
					  docBlock.resize(0);
					  docBlockJavaStyle = Config_getBool("JAVADOC_AUTOBRIEF");
					  startCommentBlock(TRUE);
					  BEGIN(DocBlock);
                                          //cout << "start DocBlock " << endl;
					}

<DocBlock>.*    			{ // contents of current comment line
                                          docBlock+=yytext;
  					}
<DocBlock>"\n"{BS}"!"(">"|"!"+)		{ // comment block (next line is also comment line)
					  docBlock+="\n"; // \n is necessary for lists
					  newLine();
  					}
<DocBlock>"\n"        			{ // comment block ends at the end of this line
                                          //cout <<"3=========> comment block : "<< docBlock << endl;
					  yyColNr -= 1;
					  unput(*yytext);                                        
 					  handleCommentBlock(docBlock,TRUE);
                                          yy_pop_state();                                          
  					}

 /*-----Prototype parsing -------------------------------------------------------------------------*/
<Prototype>{BS}{SUBPROG}{BS_}		{
					  BEGIN(PrototypeSubprog);
					}
<Prototype,PrototypeSubprog>{BS}{SCOPENAME}?{BS}{ID} { 
					  current->name = QCString(yytext).lower();
					  current->name.stripWhiteSpace();
					  BEGIN(PrototypeArgs);
					}
<PrototypeArgs>{
"("|")"|","|{BS_}			{ current->args += yytext; }
{ID}					{ current->args += yytext; 
					  Argument *a = new Argument;
					  a->name = QCString(yytext).lower();
					  current->argList->append(a);
					}
}

 /*------------------------------------------------------------------------------------------------*/

<*>"\n"                                 {
					  newLine();
                                          //if (debugStr.stripWhiteSpace().length() > 0) cout << "ignored text: " << debugStr << " state: " <<YY_START << endl;
                                          debugStr="";
                                        }


 /*---- error: EOF in wrong state --------------------------------------------------------------------*/

<*><<EOF>>                              {
					  if (parsingPrototype) {
					    yyterminate();

					  } else if ( include_stack_ptr <= 0 ) {
                                            if (YY_START!=INITIAL && YY_START!=Start) {
                                              DBG_CTX((stderr,"==== Error: EOF reached in wrong state (end missing)"));
                                              scanner_abort();
                                            }
                                            yyterminate();
                                          } else {
                                            popBuffer();
                                          }
                                        }
<*>{LOG_OPER}                           { // Fortran logical comparison keywords
                                        }
<*>.                 	                {
                                          //debugStr+=yytext;
					  //printf("I:%c\n", *yytext);
                                        } // ignore remaining text 

 /**********************************************************************************/
 /**********************************************************************************/
 /**********************************************************************************/
%%
//----------------------------------------------------------------------------

#if 0
static void extractPrefix(QCString &text) 
{
  int prefixIndex = 0;
  int curIndex = 0;
  bool cont = TRUE;
  const char* pre[] = {"RECURSIVE","IMPURE","PURE","ELEMENTAL"};
  while(cont)
  {
    cont = FALSE;
    for(unsigned int i=0; i<4; i++)
    {
      if((prefixIndex=text.find(pre[i], curIndex, FALSE))==0)
      {
        text.remove(0,strlen(pre[i]));
        text.stripWhiteSpace();
        cont = TRUE;
      }
    }
  }
}
#endif

static void newLine() {
  yyLineNr++;
  yyLineNr+=lineCountPrepass;
  lineCountPrepass=0;
  comments.clear();
}

static CommentInPrepass* locatePrepassComment(int from, int to) {
  //printf("Locate %d-%d\n", from, to);
  for(uint i=0; i<comments.count(); i++) { // todo: optimize
    int c = comments.at(i)->column;
    //printf("Candidate %d\n", c);
    if (c>=from && c<=to) {
      // comment for previous variable or parameter
      return comments.at(i);
    }
  }
  return NULL;
}

static void updateVariablePrepassComment(int from, int to) {
  CommentInPrepass *c = locatePrepassComment(from, to);
  if (c!=NULL && v_type == V_VARIABLE) {
    last_entry->brief = c->str;
  } else if (c!=NULL && v_type == V_PARAMETER) {
    Argument *parameter = getParameter(argName);
    if (parameter) parameter->docs = c->str;
  }
}

static int getAmpersandAtTheStart(const char *buf, int length)
{
  for(int i=0; i<length; i++) {
    switch(buf[i]) {
      case ' ':
      case '\t':
        break;
      case '&':
        return i;
      default:
        return -1;
    }
  }
  return -1;
}

/* Returns ampersand index, comment start index or -1 if neither exist.*/ 
static int getAmpOrExclAtTheEnd(const char *buf, int length)
{
  // Avoid ampersands in string and comments
  int parseState = Start;
  char quoteSymbol = 0;
  int ampIndex = -1;
  int commentIndex = -1;

  for(int i=0; i<length && parseState!=Comment; i++)
  {
    // When in string, skip backslashes
    // Legacy code, not sure whether this is correct?
    if(parseState==String)
    {
      if(buf[i]=='\\') i++;
    }

    switch(buf[i])
    {
        case '\'':
        case '"':
          // Close string, if quote symbol matches.
          // Quote symbol is set iff parseState==String
          if(buf[i]==quoteSymbol)
          {
             parseState = Start;
             quoteSymbol = 0;
          }
          // Start new string, if not already in string or comment
          else if(parseState==Start)
          {
            parseState = String;
            quoteSymbol = buf[i];
          }
          ampIndex = -1; // invalidate prev ampersand
          break;
        case '!':
          // When in string or comment, ignore exclamation mark
          if(parseState==Start)
          {
            parseState = Comment;
            commentIndex = i;
          }
          break;
        case ' ':  // ignore whitespace
        case '\t':
        case '\n': // this may be at the end of line
          break;
        case '&':
          ampIndex = i;
          break;
        default:
          ampIndex = -1; // invalidate prev ampersand
    }
  }

  if (ampIndex>=0)
    return ampIndex;
  else
   return commentIndex;
}

/* Although comments at the end of continuation line are grabbed by this function,
* we still do not know how to use them later in parsing.
*/
void truncatePrepass(int index)
{
  int length = inputStringPrepass.length();
  for (int i=index+1; i<length; i++) {
    if (inputStringPrepass[i]=='!' && i<length-1 && inputStringPrepass[i+1]=='<') { // save comment 
      struct CommentInPrepass *c=new CommentInPrepass(index, inputStringPrepass.right(length-i-2));
      comments.append(c);
    }
  }
  inputStringPrepass.truncate(index);
}

// simplified way to know if this is fixed form
// duplicate in fortrancode.l
static bool recognizeFixedForm(const char* contents, FortranFormat format)
{
  int column=0;
  bool skipLine=FALSE;

  if (format == FortranFormat_Fixed) return TRUE;
  if (format == FortranFormat_Free)  return FALSE;

  for(int i=0;;i++) {
    column++;

    switch(contents[i]) {
      case '\n':
        column=0;
        skipLine=FALSE;
        break;
      case ' ':
        break;
      case '\000':
        return FALSE;
      case '#':
        skipLine=TRUE;
        break;
      case 'C':
      case 'c':
      case '*':
        if(column==1) return TRUE;
        if(skipLine) break;
        return FALSE;
      case '!':
        if(column>1 && column<7) return FALSE;
        skipLine=TRUE;
        break;
      default:
        if(skipLine) break;
        if(column==7) return TRUE;
        return FALSE;
    }
  }
  return FALSE;
}

/* This function assumes that contents has at least size=length+1 */
static void insertCharacter(char *contents, int length, int pos, char c)
{
  // shift tail by one character
  for(int i=length; i>pos; i--)
    contents[i]=contents[i-1];
  // set the character
  contents[pos] = c;
}

/* change comments and bring line continuation character to previous line */
static const char* prepassFixedForm(const char* contents)
{
  int column=0;
  int prevLineLength=0;
  int prevLineAmpOrExclIndex=-1;
  bool emptyLabel=TRUE;
  int newContentsSize = strlen(contents)+3; // \000, \n (when necessary) and one spare character (to avoid reallocation)
  char* newContents = (char*)malloc(newContentsSize);

  for(int i=0, j=0;;i++,j++) {
    if(j>=newContentsSize-1) { // check for one spare character, which may be eventually used below (by &)
      newContents = (char*)realloc(newContents, newContentsSize+1000);
      newContentsSize = newContentsSize+1000;
    }

    column++;
    char c = contents[i];
    switch(c) {
      case '\n':
        prevLineLength=column;
        prevLineAmpOrExclIndex=getAmpOrExclAtTheEnd(&contents[i-prevLineLength+1], prevLineLength);
        column=0;
	emptyLabel=TRUE;
        newContents[j]=c;
        break;
      case ' ':
        newContents[j]=c;
        break;
      case '\000':
        newContents[j]='\000';
        newContentsSize = strlen(newContents);
        if (newContents[newContentsSize - 1] != '\n')
        {
          // to be on the safe side
          newContents = (char*)realloc(newContents, newContentsSize+2);
          newContents[newContentsSize] = '\n';
          newContents[newContentsSize + 1] = '\000';
        }
        return newContents;
      case 'C':
      case 'c':
      case '*':
        if (column!=6)
	{
	  emptyLabel=FALSE;
	  if(column==1)
	    newContents[j]='!';
	  else
	    newContents[j]=c;
	  break;
	}
      default:
        if(column==6 && emptyLabel) { // continuation
          if (c != '0') { // 0 not allowed as continuatioin character, see f95 standard paragraph 3.3.2.3
            newContents[j]=' ';

            if(prevLineAmpOrExclIndex==-1) { // add & just before end of previous line
              insertCharacter(newContents, j+1, (j+1)-6-1, '&');
              j++;
            } else { // add & just before end of previous line comment
              insertCharacter(newContents, j+1, (j+1)-6-prevLineLength+prevLineAmpOrExclIndex, '&');
              j++;
            }
	  } else {
	    newContents[j]=c; // , just handle like space
          }
	} else {
	  newContents[j]=c;
	  emptyLabel=FALSE;
	}
        break;
    }
  }

  newContentsSize = strlen(newContents);
  if (newContents[newContentsSize - 1] != '\n')
  {
    // to be on the safe side
    newContents = (char*)realloc(newContents, newContentsSize+2);
    newContents[newContentsSize] = '\n';
    newContents[newContentsSize + 1] = '\000';
  }
  return newContents;
}

static void pushBuffer(QCString& buffer)
{
  if (include_stack_cnt <= include_stack_ptr)
  {
     include_stack_cnt++;
     include_stack = (YY_BUFFER_STATE *)realloc(include_stack, include_stack_cnt * sizeof(YY_BUFFER_STATE));
  }
  include_stack[include_stack_ptr++] = YY_CURRENT_BUFFER;
  yy_switch_to_buffer(yy_scan_string(buffer));

  DBG_CTX((stderr, "--PUSH--%s", (const char *)buffer));
  buffer = NULL;
}

static void popBuffer() {
  DBG_CTX((stderr, "--POP--"));
  include_stack_ptr --;
  yy_delete_buffer( YY_CURRENT_BUFFER );
  yy_switch_to_buffer( include_stack[include_stack_ptr] );
}

/** used to copy entry to an interface module procedure */
static void copyEntry(Entry *dest, Entry *src) 
{
   dest->type     = src->type;
   dest->fileName = src->fileName;
   dest->bodyLine = src->bodyLine;
   dest->args     = src->args;
   dest->argList  = new ArgumentList(*src->argList);
   dest->doc      = src->doc;
   dest->brief    = src->brief;
}

/** fill empty interface module procedures with info from 
    corresponding module subprogs 
    @TODO: handle procedures in used modules
*/
void resolveModuleProcedures(QList<Entry> &moduleProcedures, Entry *current_root)
{
  if (moduleProcedures.isEmpty()) return;
 
  EntryListIterator eli1(moduleProcedures);
  // for all module procedures
  for (Entry *ce1; (ce1=eli1.current()); ++eli1) 
  {
    // check all entries in this module
    EntryListIterator eli2(*current_root->children());
    for (Entry *ce2; (ce2=eli2.current()); ++eli2) 
    {
      if (ce1->name == ce2->name) 
      {
        copyEntry(ce1, ce2);
      }
    } // for procedures in current module
  } // for all interface module procedures
  moduleProcedures.clear();
}

#if 0
static bool isTypeName(QCString name)
{
  name = name.lower();
  return name=="integer" || name == "real" || 
         name=="complex" || name == "logical";
}
#endif

/*! Extracts string which resides within parentheses of provided string. */
static QCString extractFromParens(const QCString name)
{
  QCString extracted = name;
  int start = extracted.find("(");
  if (start != -1) 
  {
    extracted.remove(0, start+1);
  }
  int end = extracted.findRev(")");
  if (end != -1) 
  {
    int length = extracted.length();
    extracted.remove(end, length);
  }
  extracted = extracted.stripWhiteSpace();

  return extracted;
}

/*! Adds passed modifiers to these modifiers.*/
SymbolModifiers& SymbolModifiers::operator|=(const SymbolModifiers &mdfs)
{
  if (mdfs.protection!=NONE_P) protection = mdfs.protection;
  if (mdfs.direction!=NONE_D) direction = mdfs.direction;
  optional |= mdfs.optional;
  if (!mdfs.dimension.isNull()) dimension = mdfs.dimension;
  allocatable |= mdfs.allocatable;
  external |= mdfs.external;
  intrinsic |= mdfs.intrinsic;
  protect |= mdfs.protect;
  parameter |= mdfs.parameter;
  pointer |= mdfs.pointer;
  target |= mdfs.target;
  save |= mdfs.save;
  deferred |= mdfs.deferred;
  nonoverridable |= mdfs.nonoverridable;
  nopass |= mdfs.nopass;
  pass |= mdfs.pass;
  passVar = mdfs.passVar;
  return *this;
}

/*! Extracts  and adds passed modifier to these modifiers.*/
SymbolModifiers& SymbolModifiers::operator|=(QCString mdfString)
{
  mdfString = mdfString.lower();
  SymbolModifiers newMdf;

  if (mdfString.find("dimension")==0) 
  {
    newMdf.dimension=mdfString;
  }
  else if (mdfString.contains("intent")) 
  {
    QCString tmp = extractFromParens(mdfString);
    bool isin = tmp.contains("in");
    bool isout = tmp.contains("out");
    if (isin && isout) newMdf.direction = SymbolModifiers::INOUT;
    else if (isin) newMdf.direction = SymbolModifiers::IN;
    else if (isout) newMdf.direction = SymbolModifiers::OUT;
  }
  else if (mdfString=="public") 
  {
    newMdf.protection = SymbolModifiers::PUBLIC;
  }
  else if (mdfString=="private") 
  {
    newMdf.protection = SymbolModifiers::PRIVATE;
  }
  else if (mdfString=="protected") 
  {
    newMdf.protect = TRUE;
  }
  else if (mdfString=="optional") 
  {
    newMdf.optional = TRUE;
  }
  else if (mdfString=="allocatable") 
  {
    newMdf.allocatable = TRUE;
  }
  else if (mdfString=="external") 
  {
    newMdf.external = TRUE;
  }
  else if (mdfString=="intrinsic") 
  {
    newMdf.intrinsic = TRUE;
  }
  else if (mdfString=="parameter") 
  {
    newMdf.parameter = TRUE;
  }
  else if (mdfString=="pointer") 
  {
    newMdf.pointer = TRUE;
  }
  else if (mdfString=="target") 
  {
    newMdf.target = TRUE;
  }
  else if (mdfString=="save") 
  {
    newMdf.save = TRUE;
  }
  else if (mdfString=="nopass")
  {
    newMdf.nopass = TRUE;
  }
  else if (mdfString=="deferred")
  {
    newMdf.deferred = TRUE;
  }
  else if (mdfString=="non_overridable")
  {
    newMdf.nonoverridable = TRUE;
  }
  else if (mdfString.contains("pass"))
  {
    newMdf.pass = TRUE;
    if (mdfString.contains("("))
      newMdf.passVar = extractFromParens(mdfString);
    else
      newMdf.passVar = "";
  }

  (*this) |= newMdf;
  return *this;
}

/*! For debugging purposes. */
//ostream& operator<<(ostream& out, const SymbolModifiers& mdfs)
//{
//  out<<mdfs.protection<<", "<<mdfs.direction<<", "<<mdfs.optional<<
//    ", "<<(mdfs.dimension.isNull() ? "" : mdfs.dimension.latin1())<<
//    ", "<<mdfs.allocatable<<", "<<mdfs.external<<", "<<mdfs.intrinsic;
//
//  return out;
//}

/*! Find argument with given name in \a subprog entry. */
static Argument *findArgument(Entry* subprog, QCString name, bool byTypeName = FALSE)
{
  QCString cname(name.lower());
  for (unsigned int i=0; i<subprog->argList->count(); i++) 
  {
    Argument *arg = subprog->argList->at(i);
    if ((!byTypeName && arg->name.lower() == cname) ||
	(byTypeName && arg->type.lower() == cname)
       )
    {
      return arg;
    }
  }
  return 0;
}

/*! Find function with given name in \a entry. */
#if 0
static Entry *findFunction(Entry* entry, QCString name)
{
  QCString cname(name.lower());

  EntryListIterator eli(*entry->children());
  Entry *ce;
  for (;(ce=eli.current());++eli) 
  {
    if (ce->section != Entry::FUNCTION_SEC)
      continue;

    if (ce->name.lower() == cname)
      return ce;
  }

  return 0;
}
#endif

/*! Apply modifiers stored in \a mdfs to the \a typeName string. */
static QCString applyModifiers(QCString typeName, SymbolModifiers& mdfs) 
{
  if (!mdfs.dimension.isNull()) 
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += mdfs.dimension;
  }
  if (mdfs.direction!=SymbolModifiers::NONE_D) 
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += directionStrs[mdfs.direction];
  }
  if (mdfs.optional) 
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "optional";
  }
  if (mdfs.allocatable) 
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "allocatable";
  }
  if (mdfs.external) 
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "external";
  }
  if (mdfs.intrinsic) 
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "intrinsic";
  }
  if (mdfs.parameter) 
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "parameter";
  }
  if (mdfs.pointer) 
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "pointer";
  }
  if (mdfs.target) 
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "target";
  }
  if (mdfs.save) 
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "save";
  }
  if (mdfs.deferred) 
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "deferred";
  }
  if (mdfs.nonoverridable) 
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "non_overridable";
  }
  if (mdfs.nopass) 
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "nopass";
  }
  if (mdfs.pass) 
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "pass";
    if (!mdfs.passVar.isEmpty())
      typeName += "(" + mdfs.passVar + ")";
  }
  if (mdfs.protection == SymbolModifiers::PUBLIC)
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "public";
  }
  else if (mdfs.protection == SymbolModifiers::PRIVATE)
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "private";
  }
  if (mdfs.protect)
  {
    if (!typeName.isEmpty()) typeName += ", ";
    typeName += "protected";
  }

  return typeName;
}

/*! Apply modifiers stored in \a mdfs to the \a arg argument. */
static void applyModifiers(Argument *arg, SymbolModifiers& mdfs)
{
  QCString tmp = arg->type;
  arg->type = applyModifiers(tmp, mdfs);
}

/*! Apply modifiers stored in \a mdfs to the \a ent entry. */
static void applyModifiers(Entry *ent, SymbolModifiers& mdfs)
{
  QCString tmp = ent->type;
  ent->type = applyModifiers(tmp, mdfs);

  if (mdfs.protection == SymbolModifiers::PUBLIC)
    ent->protection = Public;
  else if (mdfs.protection == SymbolModifiers::PRIVATE)
    ent->protection = Private;
}

/*! Starts the new scope in fortran program. Consider using this function when
 * starting module, interface, function or other program block.
 * \see endScope()
 */
static void startScope(Entry *scope) 
{
  //cout<<"start scope: "<<scope->name<<endl;
  current_root= scope; /* start substructure */

  QMap<QCString,SymbolModifiers> mdfMap;
  modifiers.insert(scope, mdfMap);
}

/*! Ends scope in fortran program: may update subprogram arguments or module variable attributes.
 * \see startScope()
 */
static bool endScope(Entry *scope, bool isGlobalRoot)
{
  //cout<<"end scope: "<<scope->name<<endl;
  if (current_root->parent() || isGlobalRoot)
  {
    current_root= current_root->parent(); /* end substructure */
  }
  else 
  {
    fprintf(stderr,"parse error in end <scopename>");
    scanner_abort();
    return FALSE;
  }

  // update variables or subprogram arguments with modifiers
  QMap<QCString,SymbolModifiers>& mdfsMap = modifiers[scope];

  if (scope->section == Entry::FUNCTION_SEC) 
  {
    // iterate all symbol modifiers of the scope
    for (QMap<QCString,SymbolModifiers>::Iterator it=mdfsMap.begin(); it!=mdfsMap.end(); it++) 
    {
      //cout<<it.key()<<": "<<it.data()<<endl;
      Argument *arg = findArgument(scope, it.key());

      if (arg)
        applyModifiers(arg, it.data());
    }

    // find return type for function
    //cout<<"RETURN NAME "<<modifiers[current_root][scope->name.lower()].returnName<<endl;
    QCString returnName = modifiers[current_root][scope->name.lower()].returnName.lower();
    if (modifiers[scope].contains(returnName)) 
    {
      scope->type = modifiers[scope][returnName].type; // returning type works
      applyModifiers(scope, modifiers[scope][returnName]); // returning array works
    }

  } 
  if (scope->section == Entry::CLASS_SEC) 
  { // was INTERFACE_SEC
    if (scope->parent()->section == Entry::FUNCTION_SEC) 
    { // interface within function
      // iterate functions of interface and 
      // try to find types for dummy(ie. argument) procedures.
      //cout<<"Search in "<<scope->name<<endl;
      EntryListIterator eli(*scope->children());
      Entry *ce;
      int count = 0;
      int found = FALSE;
      for (;(ce=eli.current());++eli) 
      {
        count++;
        if (ce->section != Entry::FUNCTION_SEC)
          continue;

        Argument *arg = findArgument(scope->parent(), ce->name, TRUE);
        if (arg != 0) 
	{
          // set type of dummy procedure argument to interface
	  arg->name = arg->type;
          arg->type = scope->name;
        }
        if (ce->name.lower() == scope->name.lower()) found = TRUE;
      }
      if ((count == 1) && found)
      {
        // clear all modifiers of the scope
        modifiers.remove(scope);
        delete scope->parent()->removeSubEntry(scope);
        scope = 0;
        return TRUE;
      }
    }
  } 
  if (scope->section!=Entry::FUNCTION_SEC) 
  { // not function section 
    // iterate variables: get and apply modifiers
    EntryListIterator eli(*scope->children());
    Entry *ce;
    for (;(ce=eli.current());++eli) 
    {
      if (ce->section != Entry::VARIABLE_SEC && ce->section != Entry::FUNCTION_SEC)
        continue;

      //cout<<ce->name<<", "<<mdfsMap.contains(ce->name.lower())<<mdfsMap.count()<<endl;
      if (mdfsMap.contains(ce->name.lower()))
        applyModifiers(ce, mdfsMap[ce->name.lower()]);
    }
  }

  // clear all modifiers of the scope
  modifiers.remove(scope);

  return TRUE;
}

#if 0
//! Return full name of the entry. Sometimes we must combine several names recursively.
static QCString getFullName(Entry *e) 
{
  QCString name = e->name;
  if (e->section == Entry::CLASS_SEC //  || e->section == Entry::INTERFACE_SEC
     || !e->parent() || e->parent()->name.isEmpty())
    return name;

  return getFullName(e->parent())+"::"+name;
}
#endif

static int yyread(char *buf,int max_size)
{
  int c=0;

  while ( c < max_size && inputString[inputPosition] )
  {
    *buf = inputString[inputPosition++] ;
    c++; buf++;
  }
  return c;
}

static void initParser()
{
  last_entry = 0;
}

static void initEntry()
{
  if (typeMode)
  {
    current->protection = typeProtection;
  }
  else
  {
    current->protection = defaultProtection;
  }
  current->mtype      = mtype;
  current->virt       = virt;
  current->stat       = gstat;
  current->lang       = SrcLangExt_Fortran; 
  initGroupInfo(current);
}

/**
  adds current entry to current_root and creates new current
*/
static void addCurrentEntry(int case_insens)
{
  if (case_insens) current->name = current->name.lower();
  //printf("===Adding entry %s to %s\n", current->name.data(), current_root->name.data());
  current_root->addSubEntry(current);
  last_entry = current;
  current = new Entry ;
  initEntry();
}

static int max(int a, int b) {return a>b?a:b;}

static void addModule(const char *name, bool isModule)
{
  DBG_CTX((stderr, "0=========> got module %s\n", name));

  if (isModule)
    current->section = Entry::CLASS_SEC;
  else
    current->section = Entry::FUNCTION_SEC;

  if (name!=NULL)
  {
    current->name = name;
  } 
  else
  {
    QCString fname = yyFileName;
    int index = max(fname.findRev('/'), fname.findRev('\\'));
    fname = fname.right(fname.length()-index-1);
    fname = fname.prepend("__").append("__");
    current->name = fname;
  }
  current->type = "program";
  current->fileName  = yyFileName;
  current->bodyLine  = yyLineNr; // used for source reference
  current->protection = Public ;
  addCurrentEntry(1);
  startScope(last_entry);
}


static void addSubprogram(const char *text)
{
  DBG_CTX((stderr,"1=========> got subprog, type: %s\n",text)); 
  subrCurrent.prepend(current);
  current->section = Entry::FUNCTION_SEC ;
  QCString subtype = text; subtype=subtype.lower().stripWhiteSpace();
  functionLine = (subtype.find("function") != -1);
  current->type += " " + subtype;
  current->type = current->type.stripWhiteSpace();
  current->fileName  = yyFileName;
  current->bodyLine  = yyLineNr; // used for source reference
  current->startLine = -1; // ??? what is startLine for?
  current->args.resize(0);
  current->argList->clear();
  docBlock.resize(0);
}

/*! Adds interface to the root entry.
 * \note Code was brought to this procedure from the parser,
 * because there was/is idea to use it in several parts of the parser.
 */ 
static void addInterface(QCString name, InterfaceType type)
{
  if (YY_START == Start)
  {
    addModule(NULL);
    yy_push_state(ModuleBody); //anon program
  }

  current->section = Entry::CLASS_SEC; // was Entry::INTERFACE_SEC;
  current->spec = Entry::Interface;
  current->name = name;

  switch (type)
  {
    case IF_ABSTRACT:
      current->type = "abstract";
      break;

    case IF_GENERIC:
      current->type = "generic";
      break;

    case IF_SPECIFIC:
    case IF_NONE:
    default:
      current->type = "";
  }

  /* if type is part of a module, mod name is necessary for output */
  if ((current_root) && 
      (current_root->section ==  Entry::CLASS_SEC ||
       current_root->section ==  Entry::NAMESPACE_SEC)) 
  {
    current->name= current_root->name + "::" + current->name;
  }

  current->fileName = yyFileName;
  current->bodyLine  = yyLineNr; 
  addCurrentEntry(1);
}


//-----------------------------------------------------------------------------

/*! Get the argument \a name.
 */
static Argument* getParameter(const QCString &name)
{
  // std::cout<<"addFortranParameter(): "<<name<<" DOCS:"<<(docs.isNull()?QCString("null"):docs)<<std::endl;
  Argument *ret = 0;
  if (current_root->argList==0) return 0;
  ArgumentListIterator ali(*current_root->argList);
  Argument *a;
  for (ali.toFirst();(a=ali.current());++ali)
  {
    if (a->name.lower()==name.lower())
    {
      ret=a;
      //printf("parameter found: %s\n",(const char*)name);
      break;
    }
  } // for
  return ret;
}

  //----------------------------------------------------------------------------
static void startCommentBlock(bool brief)
{
  if (brief)
  {
    current->briefFile = yyFileName;
    current->briefLine = yyLineNr;
  }
  else
  {
    current->docFile = yyFileName;
    current->docLine = yyLineNr;
  }
}

//----------------------------------------------------------------------------

static void handleCommentBlock(const QCString &doc,bool brief)
{
  bool needsEntry = FALSE;
  static bool hideInBodyDocs = Config_getBool("HIDE_IN_BODY_DOCS");
  int position=0;
  if (docBlockInBody && hideInBodyDocs)
  {
    docBlockInBody = FALSE;
    return;
  }
  DBG_CTX((stderr,"call parseCommentBlock [%s]\n",doc.data()));
  int lineNr = brief ? current->briefLine : current->docLine;
  while (parseCommentBlock(
	g_thisParser,
	docBlockInBody ? subrCurrent.getFirst() : current,
	doc,        // text
	yyFileName, // file
	lineNr,
	docBlockInBody ? FALSE : brief, 
	docBlockInBody ? FALSE : docBlockJavaStyle,
	docBlockInBody,
	defaultProtection,
        position,
        needsEntry
        )) 
  {
	   DBG_CTX((stderr,"parseCommentBlock position=%d [%s]  needsEntry=%d\n",position,doc.data()+position,needsEntry));
   if (needsEntry) addCurrentEntry(0);
  }
  DBG_CTX((stderr,"parseCommentBlock position=%d [%s]  needsEntry=%d\n",position,doc.data()+position,needsEntry));

  if (needsEntry) addCurrentEntry(0);
  docBlockInBody = FALSE;
}

//----------------------------------------------------------------------------
/// Handle parameter description as defined after the declaration of the parameter
static void subrHandleCommentBlock(const QCString &doc,bool brief)
{
  QCString loc_doc;
  loc_doc = doc.stripWhiteSpace();

  Entry *tmp_entry = current; 
  current = subrCurrent.getFirst(); // temporarily switch to the entry of the subroutine / function

  // Still in the specification section so no inbodyDocs yet, but parameter documentation
  current->inbodyDocs = "";

  // strip \\param or @param, so we can do some extra checking. We will add it later on again.
  if (loc_doc.find("\\param") == 0)
  {
    loc_doc = loc_doc.right(loc_doc.length()-strlen("\\param")).stripWhiteSpace();
  }
  else if (loc_doc.find("@param") == 0)
  {
    loc_doc = loc_doc.right(loc_doc.length()-strlen("@param")).stripWhiteSpace();
  }

  // direction as defined with the declaration of the parameter
  int dir1 = modifiers[current_root][argName.lower()].direction;
  // in description [in] is specified
  if (loc_doc.lower().find(directionParam[SymbolModifiers::IN]) == 0)
  {
    // check if with the declaration intent(in) or nothing has been specified
    if ((directionParam[dir1] == directionParam[SymbolModifiers::NONE_D]) ||
        (directionParam[dir1] == directionParam[SymbolModifiers::IN]))
    {
      // strip direction
      loc_doc = loc_doc.right(loc_doc.length()-strlen(directionParam[SymbolModifiers::IN]));
      // in case of emty documentation or (now) just name, consider it as no documemntation
      if (loc_doc.isEmpty() || (loc_doc.lower() == argName.lower()))
      {
        // reset current back to the part inside the routine
        current=tmp_entry;
        return;
      }
      handleCommentBlock(QCString("\n\n@param ") + directionParam[SymbolModifiers::IN] + " " + 
                         argName + " " + loc_doc,brief);
    }
    else
    {
      // something different specified, give warning and leave error.
      warn(yyFileName,yyLineNr, "Routine: " + current->name + current->args +
           " inconsistency between intent attribute and documentation for parameter: " + argName);
      handleCommentBlock(QCString("\n\n@param ") + directionParam[dir1] + " " + 
                         argName + " " + loc_doc,brief);
    }
  }
  // analogous to the [in] case, here [out] direction specified
  else if (loc_doc.lower().find(directionParam[SymbolModifiers::OUT]) == 0)
  {
    if ((directionParam[dir1] == directionParam[SymbolModifiers::NONE_D]) ||
        (directionParam[dir1] == directionParam[SymbolModifiers::OUT]))
    {
      loc_doc = loc_doc.right(loc_doc.length()-strlen(directionParam[SymbolModifiers::OUT]));
      if (loc_doc.isEmpty() || (loc_doc.lower() == argName.lower()))
      {
        current=tmp_entry;
        return;
      }
      handleCommentBlock(QCString("\n\n@param ") + directionParam[SymbolModifiers::OUT] + " " + 
                         argName + " " + loc_doc,brief);
    }
    else
    {
      warn(yyFileName,yyLineNr, "Routine: " + current->name + current->args +
           " inconsistency between intent attribute and documentation for parameter: " + argName);
      handleCommentBlock(QCString("\n\n@param ") + directionParam[dir1] + " " + 
                         argName + " " + loc_doc,brief);
    }
  }
  // analogous to the [in] case, here [in,out] direction specified
  else if (loc_doc.lower().find(directionParam[SymbolModifiers::INOUT]) == 0)
  {
    if ((directionParam[dir1] == directionParam[SymbolModifiers::NONE_D]) ||
        (directionParam[dir1] == directionParam[SymbolModifiers::INOUT]))
    {
      loc_doc = loc_doc.right(loc_doc.length()-strlen(directionParam[SymbolModifiers::INOUT]));
      if (loc_doc.isEmpty() || (loc_doc.lower() == argName.lower()))
      {
        current=tmp_entry;
        return;
      }
      handleCommentBlock(QCString("\n\n@param ") + directionParam[SymbolModifiers::INOUT] + " " + 
                         argName + " " + loc_doc,brief);
    }
    else
    {
      warn(yyFileName,yyLineNr, "Routine: " + current->name + current->args +
           " inconsistency between intent attribute and documentation for parameter: " + argName);
      handleCommentBlock(QCString("\n\n@param ") + directionParam[dir1] + " " + 
                         argName + " " + loc_doc,brief);
    }
  }
  // analogous to the [in] case; here no direction specified
  else
  {
    if (loc_doc.isEmpty() || (loc_doc.lower() == argName.lower()))
    {
      current=tmp_entry;
      return;
    }
    handleCommentBlock(QCString("\n\n@param ") + directionParam[dir1] + " " + 
                       argName + " " + loc_doc,brief);
  }

  // reset current back to the part inside the routine
  current=tmp_entry;
}

//----------------------------------------------------------------------------
#if 0
static int level=0;

static void debugCompounds(Entry *rt)  // print Entry structure (for debugging)
{
 level++;
  printf("%d) debugCompounds(%s) line %d\n",level, rt->name.data(), rt->bodyLine);
  EntryListIterator eli(*rt->children());
  Entry *ce;
  for (;(ce=eli.current());++eli)
  {
     debugCompounds(ce); 
  } 
level--;
}
#endif


static void parseMain(const char *fileName,const char *fileBuf,Entry *rt, FortranFormat format)
{
  char *tmpBuf = NULL;
  initParser();

  defaultProtection = Public;
  inputString = fileBuf;
  inputPosition = 0;
  inputStringPrepass = NULL;
  inputPositionPrepass = 0;

  //anonCount     = 0;  // don't reset per file
  mtype         = Method;
  gstat         = FALSE;
  virt          = Normal;
  current_root  = rt;
  global_root   = rt;
  inputFile.setName(fileName);
  if (inputFile.open(IO_ReadOnly))
  {
    isFixedForm = recognizeFixedForm(fileBuf,format);

    if (isFixedForm) 
    {
      msg("Prepassing fixed form of %s\n", fileName);
      //printf("---strlen=%d\n", strlen(fileBuf));
      //clock_t start=clock();

      inputString = prepassFixedForm(fileBuf);

      //clock_t end=clock();
      //printf("CPU time used=%f\n", ((double) (end-start))/CLOCKS_PER_SEC);
    }
    else if (inputString[strlen(fileBuf)-1] != '\n')
    {
      tmpBuf = (char *)malloc(strlen(fileBuf)+2);
      strcpy(tmpBuf,fileBuf);
      tmpBuf[strlen(fileBuf)]= '\n';
      tmpBuf[strlen(fileBuf)+1]= '\000';
      inputString = tmpBuf;
    }

    yyLineNr= 1 ; 
    yyFileName = fileName;
    msg("Parsing file %s...\n",yyFileName.data());

    startScope(rt); // implies current_root = rt
    initParser();
    groupEnterFile(yyFileName,yyLineNr);

    current          = new Entry;
    current->lang    = SrcLangExt_Fortran; 
    current->name    = yyFileName;
    current->section = Entry::SOURCE_SEC;
    current_root->addSubEntry(current);
    file_root        = current;
    current          = new Entry;
    current->lang    = SrcLangExt_Fortran; 

    fortranscannerYYrestart( fortranscannerYYin );
    {
      BEGIN( Start );
    }

    fortranscannerYYlex();
    groupLeaveFile(yyFileName,yyLineNr);

    endScope(current_root, TRUE); // TRUE - global root

    //debugCompounds(rt); //debug 

    rt->program.resize(0);
    delete current; current=0;
    moduleProcedures.clear();
    if (tmpBuf) {
      free((char*)tmpBuf);
      inputString=NULL;
    }
    if (isFixedForm) {
      free((char*)inputString);
      inputString=NULL;
    }

    inputFile.close();
  }
}

//----------------------------------------------------------------------------

void FortranLanguageScanner::parseInput(const char *fileName,
                                        const char *fileBuf,
                                        Entry *root,
                                        bool /*sameTranslationUnit*/,
                                        QStrList & /*filesInSameTranslationUnit*/)
{
  g_thisParser = this;

  printlex(yy_flex_debug, TRUE, __FILE__, fileName);

  ::parseMain(fileName,fileBuf,root,m_format);

  printlex(yy_flex_debug, FALSE, __FILE__, fileName);
}

void FortranLanguageScanner::parseCode(CodeOutputInterface & codeOutIntf,
                   const char * scopeName,
                   const QCString & input,
                   SrcLangExt /*lang*/,
                   bool isExampleBlock,
                   const char * exampleName,
                   FileDef * fileDef,
                   int startLine,
                   int endLine,
                   bool inlineFragment,
		   MemberDef *memberDef,
                   bool showLineNumbers,
                   Definition *searchCtx,
                   bool collectXRefs
                  )
{
  ::parseFortranCode(codeOutIntf,scopeName,input,isExampleBlock,exampleName,
                     fileDef,startLine,endLine,inlineFragment,memberDef,
                     showLineNumbers,searchCtx,collectXRefs,m_format);
}

bool FortranLanguageScanner::needsPreprocessing(const QCString &extension)
{
  return extension!=extension.lower(); // use preprocessor only for upper case extensions
}
void FortranLanguageScanner::resetCodeParserState()
{
  ::resetFortranCodeParserState();
}

void FortranLanguageScanner::parsePrototype(const char *text)
{
  QCString buffer = QCString(text);
  pushBuffer(buffer);
  parsingPrototype = TRUE;
  BEGIN(Prototype);
  fortranscannerYYlex();
  parsingPrototype = FALSE;
  popBuffer();
}

static void scanner_abort() 
{
  fprintf(stderr,"********************************************************************\n");
  fprintf(stderr,"Error in file %s line: %d, state: %d\n",yyFileName.data(),yyLineNr,YY_START);
  fprintf(stderr,"********************************************************************\n");
   
  EntryListIterator eli(*global_root->children());
  Entry *ce;
  bool start=FALSE;

  for (;(ce=eli.current());++eli)
  {
     if (ce == file_root) start=TRUE;
     if (start) ce->reset(); 
  } 

  // dummy call to avoid compiler warning
  (void)yy_top_state();
  
  return;
  //exit(-1);
}

//----------------------------------------------------------------------------

#if !defined(YY_FLEX_SUBMINOR_VERSION) 
//----------------------------------------------------------------------------
extern "C" { // some bogus code to keep the compiler happy
  void fortranscannernerYYdummy() { yy_flex_realloc(0,0); } 
}
#endif