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 

    39 %{

    40 

    41 #include <stdio.h> 

    42 #include <stdlib.h>

    43 #include <assert.h>

    44 #include <ctype.h>

    45 

    46 #include "qtbc.h"

    47 #include <qarray.h>

    48 #include <qstack.h>

    49 #include <qregexp.h>

    50 #include <unistd.h> 

    51 #include <qfile.h>

    52 #include <qmap.h>

    53   

    54 #include "fortranscanner.h"

    55 #include "entry.h"

    56 #include "message.h"

    57 #include "config.h"

    58 #include "doxygen.h"

    59 #include "util.h"

    60 #include "defargs.h"

    61 #include "language.h"

    62 #include "commentscan.h" 

    63 #include "fortrancode.h"

    64 #include "pre.h"

    65 

    66 #define YY_NEVER_INTERACTIVE 1

    67 

    68 enum ScanVar { V_IGNORE, V_VARIABLE, V_PARAMETER};

    69 

    70 // {{{ ----- Helper structs -----

    71 //! Holds modifiers (ie attributes) for one symbol (variable, function, etc)

    72 struct SymbolModifiers {

    73   enum Protection {NONE_P, PUBLIC, PRIVATE};

    74   enum Direction {NONE_D, IN, OUT, INOUT};

    75 

    76   //!< This is only used with function return value.

    77   QCString type, returnName;

    78   Protection protection;

    79   Direction direction;

    80   bool optional;

    81   QCString dimension;

    82   bool allocatable;

    83   bool external;

    84   bool intrinsic;

    85   bool parameter;

    86   bool pointer;

    87   bool target;

    88   bool save;

    89 

    90   SymbolModifiers() : type(), returnName(), protection(NONE_P), direction(NONE_D),

    91     optional(FALSE), dimension(), allocatable(FALSE),

    92     external(FALSE), intrinsic(FALSE), parameter(FALSE),

    93     pointer(FALSE), target(FALSE), save(FALSE) {}

    94 

    95   SymbolModifiers& operator|=(const SymbolModifiers &mdfs);

    96   SymbolModifiers& operator|=(QCString mdfrString);

    97 };

    98 

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

   100 

   101 static const char *directionStrs[] = 

   102 {

   103    "", "intent(in)", "intent(out)", "intent(inout)"

   104 };

   105 

   106 // }}}

   107 

   108 /* -----------------------------------------------------------------

   109  *

   110  *	statics

   111  */

   112 static ParserInterface *g_thisParser; 

   113 static const char *     inputString;

   114 static int		inputPosition;

   115 static bool             isFixedForm;

   116 static QCString         inputStringPrepass; ///< Input string for prepass of line cont. '&'

   117 static unsigned int     inputPositionPrepass;

   118 static int              lineCountPrepass = 0;

   119 

   120 struct CommentInPrepass {

   121   int column;

   122   QCString str;

   123   CommentInPrepass(int column, QCString str) : column(column), str(str) {}

   124 };

   125 static QList<CommentInPrepass>  comments;

   126 

   127 #define MAX_INCLUDE_DEPTH 10

   128 YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];

   129 int include_stack_ptr = 0;

   130 

   131 static QFile            inputFile;

   132 static QCString		yyFileName;

   133 static int		yyLineNr     = 1 ;

   134 static Entry*		current_root = 0 ;

   135 static Entry*		global_root  = 0 ;

   136 static Entry*		file_root    = 0 ;

   137 static Entry*		current      = 0 ;

   138 static Entry*		last_entry   = 0 ;

   139 static ScanVar          v_type       = V_IGNORE; // type of parsed variable

   140 static QList<Entry>     moduleProcedures; // list of all interfaces which contain unresolved 

   141                                           // module procedures

   142 static QCString         docBlock;

   143 static QCString         docBlockName;

   144 static bool             docBlockInBody;

   145 static bool             docBlockJavaStyle;

   146 

   147 static MethodTypes 	mtype;

   148 static bool    		gstat;

   149 static Specifier 	virt;

   150 

   151 static QCString          debugStr;

   152 static QCString          result; // function result

   153 static Argument          *parameter; // element of parameter list

   154 static QCString          argType;  // fortran type of an argument of a parameter list

   155 static QCString          argName;  // last identifier name in variable list

   156 static QCString          initializer;  // initial value of a variable

   157 static int               initializerScope;  // number if nested array scopes in initializer

   158 static QCString          useModuleName;  // name of module in the use statement

   159 static Protection        defaultProtection;

   160 

   161 static char              stringStartSymbol; // single or double quote

   162 

   163 //! Accumulated modifiers of current statement, eg variable declaration.

   164 static SymbolModifiers currentModifiers;

   165 //! Holds program scope->symbol name->symbol modifiers.

   166 static QMap<Entry*,QMap<QCString,SymbolModifiers> > modifiers;

   167 

   168 //-----------------------------------------------------------------------------

   169 

   170 static int yyread(char *buf,int max_size);

   171 static void startCommentBlock(bool);

   172 static void handleCommentBlock(const QCString &doc,bool brief);

   173 static void addCurrentEntry();

   174 static void addModule(const char *name, bool isModule=FALSE);

   175 static void addSubprogram(const char *text);

   176 static void addInterface(QCString name);

   177 static Argument *addFortranParameter(const QCString &type,const QCString &name, const QCString docs);

   178 static void scanner_abort();

   179 

   180 static void startScope(Entry *scope);

   181 static bool endScope(Entry *scope, bool isGlobalRoot=FALSE);

   182 static QCString getFullName(Entry *e);

   183 static bool isTypeName(QCString name);

   184 static void resolveModuleProcedures(QList<Entry> &moduleProcedures, Entry *current_root);

   185 static int getAmpersandAtTheStart(const char *buf, int length);

   186 static int getAmpOrExclAtTheEnd(const char *buf, int length);

   187 static void truncatePrepass(int index);

   188 static void pushBuffer(QCString &buffer);

   189 static void popBuffer();

   190 static void extractPrefix(QCString& text);

   191 

   192 //-----------------------------------------------------------------------------

   193 #undef	YY_INPUT

   194 #define	YY_INPUT(buf,result,max_size) result=yyread(buf,max_size);

   195 //-----------------------------------------------------------------------------

   196 

   197 %}

   198 

   199  //-----------------------------------------------------------------------------

   200  //-----------------------------------------------------------------------------

   201 IDSYM	  [a-z_A-Z0-9]

   202 NOTIDSYM  [^a-z_A-Z0-9]

   203 SEPARATE  [:, \t]

   204 ID        [a-z_A-Z%]+{IDSYM}*

   205 PP_ID     {ID}

   206 LABELID   [a-z_A-Z]+[a-z_A-Z0-9\-]*

   207 SUBPROG   (subroutine|function|block)

   208 B         [ \t]

   209 BS        [ \t]*

   210 BS_       [ \t]+

   211 COMMA     {BS},{BS}

   212 ARGS      {BS}("("[^)]*")")

   213 NOARGS    {BS}"\n"

   214 

   215 NUM_TYPE  (complex|integer|logical|real)

   216 KIND      {ARGS}

   217 CHAR      (CHARACTER{ARGS}?|CHARACTER{BS}"*"({BS}[0-9]+|{ARGS}))

   218 TYPE_SPEC (({NUM_TYPE}({BS}"*"{BS}[0-9]+)?)|({NUM_TYPE}{KIND})|DOUBLE{BS_}PRECISION|{CHAR}|TYPE{ARGS})

   219 

   220 INTENT_SPEC intent{BS}"("{BS}(in|out|in{BS}out){BS}")"

   221 ATTR_SPEC (ALLOCATABLE|DIMENSION{ARGS}|EXTERNAL|{INTENT_SPEC}|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PRIVATE|PUBLIC|SAVE|TARGET)

   222 ACCESS_SPEC (PRIVATE|PUBLIC)

   223 /* Assume that attribute statements are almost the same as attributes. */

   224 ATTR_STMT {ATTR_SPEC}|DIMENSION|{ACCESS_SPEC}

   225 

   226 CONTAINS  CONTAINS

   227 PREFIX    (RECURSIVE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,2}(RECURSIVE|PURE|ELEMENTAL)?

   228 

   229 %option noyywrap

   230 %option stack

   231 %option caseless

   232 /*%option debug */

   233 

   234  //---------------------------------------------------------------------------------

   235 

   236  /** fortran parsing states */

   237 %x	Subprog

   238 %x	SubprogPrefix

   239 %x	Parameterlist

   240 %x	SubprogBody

   241 %x	SubprogBodyContains

   242 %x	Start

   243 %x	Comment

   244 %x      Module

   245 %x      Program

   246 %x      ModuleBody

   247 %x	ModuleBodyContains

   248 %x	AttributeList

   249 %x      Variable

   250 %x      Initialization

   251 %x      ArrayInitializer

   252 %x      Typedef

   253 %x      TypedefBody

   254 %x      InterfaceBody

   255 %x      StrIgnore

   256 %x      String

   257 %x      Use

   258 %x      UseOnly

   259 %x      ModuleProcedure

   260 

   261 %x      Prepass

   262 

   263  /** comment parsing states */

   264 %x	DocBlock

   265 %x	DocBackLine

   266 %x	EndDoc

   267 

   268 %%

   269 

   270  /*-----------------------------------------------------------------------------------*/

   271 

   272 <*>^.*\n                                { // prepass: look for line continuations

   273 

   274                                           //fprintf(stderr, "---%s", yytext);

   275 

   276                                             int indexStart = getAmpersandAtTheStart(yytext, yyleng);                              

   277                                             int indexEnd = getAmpOrExclAtTheEnd(yytext, yyleng);

   278 					    if (indexEnd>=0 && yytext[indexEnd]!='&') //we are only interested in amp

   279 					      indexEnd=-1;

   280 

   281                                             if(indexEnd<0){ // ----- no ampersand as line continuation

   282                                                if(YY_START == Prepass) { // last line in "continuation"

   283 

   284                                                  // Only take input after initial ampersand

   285                                                  inputStringPrepass+=(const char*)(yytext+(indexStart+1));

   286    

   287                                                  pushBuffer(inputStringPrepass);

   288                                                  yy_pop_state();

   289                                                } else { // simple line

   290                                                  REJECT;

   291                                                }

   292 

   293                                             } else { // ----- line with continuation

   294                                               if(YY_START != Prepass) {

   295                                                 comments.setAutoDelete(TRUE);

   296 						comments.clear();

   297                                                 yy_push_state(Prepass);

   298                                               }

   299 

   300                                               int length = inputStringPrepass.length();

   301 

   302                                               // Only take input after initial ampersand

   303                                               inputStringPrepass+=(const char*)(yytext+(indexStart+1));

   304                                               lineCountPrepass ++;

   305 

   306                                               // cut off & and remove following comment if present

   307 					      truncatePrepass(length+indexEnd-(indexStart+1));

   308                                             }

   309 

   310                                         }

   311 

   312 

   313  /*------ ignore strings */ 

   314 <*>"\\\\"                               { /* ignore \\  */}

   315 <*>"\\\""|\\\'                          { /* ignore \" and \'  */}

   316 

   317 <String>\"|\'                           { // string ends with next quote without previous backspace

   318                                           if (yytext[0]!=stringStartSymbol) REJECT; // single vs double quote

   319                                           // fprintf(stderr,"string end: %s\n",debugStr.data());

   320                                           yy_pop_state();

   321                                         }           

   322 

   323 <String>.                               { debugStr+=yytext; } // ignore String contents (especially '!') 

   324 

   325 <*>\"|\'                                { /* string starts */

   326 					  if (YY_START == StrIgnore) REJECT; // ignore in simple comments

   327                                           // fprintf(stderr,"string start: %c %d\n",yytext[0],yyLineNr);

   328                                           yy_push_state(YY_START);

   329                                           stringStartSymbol=yytext[0]; // single or double quote

   330                                           BEGIN(String); debugStr="!^!";

   331                                         }

   332 

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

   334 

   335 <*>"!"/[^<>\n]                         {  if (YY_START == String) REJECT; // "!" is ignored in strings

   336                                           // skip comment line (without docu comments "!>" "!<" ) 

   337                                           /* ignore further "!" and ignore comments in Strings */

   338                                           if ((YY_START != StrIgnore) && (YY_START != String)) 

   339 					  {

   340                                             yy_push_state(YY_START);

   341                                             BEGIN(StrIgnore); 

   342                                             debugStr="*!";

   343                                             //fprintf(stderr,"start comment %d\n",yyLineNr);

   344                                            }      

   345                                         }

   346 <StrIgnore>.?/\n                        { yy_pop_state(); // comment ends with endline character

   347                                           //fprintf(stderr,"end comment %d %s\n",yyLineNr,debugStr.data());

   348                                         } // comment line ends

   349 <StrIgnore>.                            { debugStr+=yytext; } 

   350 

   351 

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

   353 

   354 <Start,ModuleBody,TypedefBody,SubprogBody>"use"{BS_} {

   355                                           if(YY_START == Start)

   356                                           {

   357                                             addModule(NULL); 

   358                                             yy_push_state(ModuleBody); //anon program

   359                                           }

   360                                           yy_push_state(Use);

   361                                         }

   362 <Use>{ID}                               { 

   363                                           //fprintf(stderr,"using dir %s\n",yytext);

   364                                           current->name=yytext;

   365                                           current->fileName = yyFileName; 

   366   					  current->section=Entry::USINGDIR_SEC;

   367 					  current_root->addSubEntry(current);

   368 					  current = new Entry;

   369                                           yy_pop_state();

   370                                         }

   371 <Use>{ID}/,                             { 

   372                                           useModuleName=yytext;

   373                                         }

   374 <Use>,{BS}"ONLY"                        { BEGIN(UseOnly); 

   375                                         }           

   376 <UseOnly>{BS},{BS}                      {}

   377 <UseOnly>{ID}                           {

   378   					  current->name= useModuleName+"::"+yytext;

   379                                           current->fileName = yyFileName; 

   380   					  current->section=Entry::USINGDECL_SEC;

   381 					  current_root->addSubEntry(current);

   382 					  current = new Entry ;

   383   					}

   384 <Use,UseOnly>"\n"                       {

   385                                           unput(*yytext);

   386                                           yy_pop_state();

   387                                         }

   388 

   389  /*------ ignore special fortran statements */

   390 <Start,ModuleBody,SubprogBody>^[ \t]*interface({BS_}{ID}({BS}\({BS}[^ \t()]+{BS}\))?)?/{BS}(!|\n) { // handle interface block

   391                                           if(YY_START == Start)

   392                                           {

   393                                             addModule(NULL); 

   394                                             yy_push_state(ModuleBody); //anon program

   395                                           }

   396 

   397 					  QCString name = yytext;

   398 					  int index = name.find("interface", 0, FALSE);

   399 					  index = name.find(QRegExp("[^ \\t]"), index+9);

   400 					  //printf(stderr,"%s,%d\n",name.data(),index);

   401 					  if (index!=-1)

   402 					    name = name.right(name.length()-index);

   403 					  else // interface without name, must be inside subprog

   404 					    name = "interface"; 

   405 					  addInterface(name);

   406 					  yy_push_state(InterfaceBody);

   407  					  startScope(last_entry);

   408                                         }

   409 <InterfaceBody>^{BS}"end"({BS}"interface"({BS_}{ID})?)?{BS}/(\n|!)   {

   410 					  if (!endScope(current_root))

   411 					    yyterminate();

   412 					  yy_pop_state();

   413                                         }

   414 <InterfaceBody>module{BS}procedure      { yy_push_state(YY_START);

   415                                           BEGIN(ModuleProcedure);

   416                                         }

   417 <ModuleProcedure>{ID}                   {                       			

   418                                           current->section = Entry::FUNCTION_SEC ;

   419                                           current->name = yytext; 

   420  	                                  moduleProcedures.append(current);

   421                                           addCurrentEntry();

   422                                         }

   423 <ModuleProcedure>"\n"                   { unput(*yytext); 

   424                                           yy_pop_state();

   425                                         }

   426 <InterfaceBody>.                        {}

   427 

   428  /*-- Contains handling --*/

   429 <Start>^{BS}{CONTAINS}/({BS}|\n|!)      {

   430                                           if(YY_START == Start)

   431                                           {

   432                                             addModule(NULL); 

   433                                             yy_push_state(ModuleBodyContains); //anon program

   434                                           }                                            

   435                                         }

   436 <ModuleBody>^{BS}{CONTAINS}/({BS}|\n|!)   { BEGIN(ModuleBodyContains); }

   437 <SubprogBody>^{BS}{CONTAINS}/({BS}|\n|!)  { BEGIN(SubprogBodyContains); }

   438 

   439  /*------ module handling ------------------------------------------------------------*/ 

   440 <Start>module|program{BS_}             {  //

   441 					    if(yytext[0]=='m' || yytext[0]=='M')

   442 					      yy_push_state(Module);

   443 					    else

   444 					      yy_push_state(Program);

   445                                             defaultProtection = Public;

   446                                        }

   447 <Start,ModuleBody,ModuleBodyContains>^{BS}"end"({BS}(module|program)({BS_}{ID})?)?{BS}/(\n|!) { // end module	

   448 					    resolveModuleProcedures(moduleProcedures, current_root);

   449 					    if (!endScope(current_root))

   450 					      yyterminate();

   451                                             defaultProtection = Public;

   452 					    yy_pop_state();

   453                                        }

   454 <Module>{ID}                           {  

   455                                             addModule(yytext, TRUE);

   456 					    BEGIN(ModuleBody);

   457                                        }

   458 

   459 <Program>{ID}                           {  

   460                                             addModule(yytext, FALSE);

   461 					    BEGIN(ModuleBody);

   462                                        }

   463 

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

   465 

   466 <ModuleBody>private/{BS}(\n|"!")         { defaultProtection = Private; }

   467 <ModuleBody>public/{BS}(\n|"!")          { defaultProtection = Public; }

   468 

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

   470 

   471 <Start,ModuleBody>"type"({BS_}|({COMMA}{ACCESS_SPEC})) { /* type definition found : TYPE , access-spec::type-name |*/

   472                                           if(YY_START == Start)

   473                                           {

   474                                             addModule(NULL); 

   475                                             yy_push_state(ModuleBody); //anon program

   476                                           }

   477 

   478  					    yy_push_state(Typedef);

   479 					    current->protection = defaultProtection;

   480                                         }

   481 <Typedef>{ACCESS_SPEC}          	{ 	

   482                                             QCString type= yytext;				    

   483                                         }

   484 <Typedef>{ID}                        	{ /* type name found */

   485                                             //cout << "=========> got typedef " << yytext << ": " << yyLineNr << endl; 

   486                                             current->section = Entry::CLASS_SEC; // was Entry::STRUCT_SEC;

   487    					    current->spec = Entry::Struct;        	

   488   					    current->name = yytext;

   489 

   490                                             /* if type is part of a module, mod name is necessary for output */

   491                                             if ((current_root) && 

   492                                                (current_root->section ==  Entry::CLASS_SEC ||

   493 					        current_root->section ==  Entry::NAMESPACE_SEC))

   494 						//current_root->section ==  Entry::INTERFACE_SEC)) 

   495 					    {

   496                                               current->name= current_root->name+"::"+current->name;

   497                                             }

   498 					    current->fileName = yyFileName;

   499 					    current->bodyLine  = yyLineNr; 

   500                                             addCurrentEntry();

   501 					    startScope(last_entry); 

   502                                             BEGIN(TypedefBody);

   503                                         }

   504 <TypedefBody>^{BS}"end"{BS}"type"({BS_}{ID})?{BS}/(\n|!)         { /* end type definition */

   505                                            //printf("=========> got typedef end \n"); 

   506 					   if (!endScope(current_root))

   507 					     yyterminate();

   508                                            yy_pop_state();

   509                                         } 

   510 

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

   512 

   513 <SubprogBody,SubprogBodyContains>^{BS}"end"({BS}{SUBPROG}({BS_}{ID})?)?{BS}/(\n|!) {  

   514                                            //fprintf(stderr,"1e=========> got end subprog: %s\n", yytext);

   515 

   516                                            /* args is used for parameters in list of functions, argList for 

   517                                              parameters in detailed function descripttion */

   518                                            //current->args = argListToString(current->argList); 

   519 					   //current->endBodyLine  = yyLineNr; // ??? what ist endBodyLine for

   520 					   if (!endScope(current_root))

   521 					     yyterminate();

   522 					   yy_pop_state() ;

   523 				       } 

   524 <Start,ModuleBody,TypedefBody,SubprogBody>{

   525 ^{BS}{TYPE_SPEC}/{SEPARATE}			{

   526                                           /* variable declaration starts */

   527                                           if(YY_START == Start)

   528                                           {

   529                                             addModule(NULL); 

   530                                             yy_push_state(ModuleBody); //anon program

   531                                           }

   532                                           //fprintf(stderr,"4=========> got variable type: %s\n",yytext);

   533  					  QCString help=yytext;

   534 					  help= help.simplifyWhiteSpace();

   535 					  argType= help;

   536 					  yy_push_state(AttributeList);

   537                                         }

   538 ^{BS}{PP_ID}{KIND}?			{ /* check for preprocessor symbol expand to type */

   539 					  QCString str = yytext;

   540 					  str = str.stripWhiteSpace();

   541 					  DefineDict* defines = getFileDefineDict();

   542 					  QCString name;

   543 					  int index = str.find("(");

   544 					  if (index != -1)

   545 					    name = str.left(index).stripWhiteSpace();

   546 					  else

   547 					    name = str;

   548 

   549 					  Define *define = (*defines)[name];

   550 					  if (define != 0 && isTypeName(define->definition)) 

   551 					  {

   552 					    argType = str;

   553 					    yy_push_state(AttributeList);

   554 					  } 

   555 					  else 

   556 					  {

   557 					    REJECT;

   558 					  }

   559 					}

   560 {ATTR_STMT}/{BS_}{ID}		       |

   561 {ATTR_STMT}/{BS}"::"                   { 

   562                                           /* attribute statement starts */

   563                                           //fprintf(stderr,"5=========> Attribute statement: %s\n", yytext); 

   564                                           QCString tmp = yytext;

   565                                           currentModifiers |= tmp.stripWhiteSpace();

   566 					  argType="";

   567 					  yy_push_state(YY_START);

   568 					  BEGIN( AttributeList ) ;

   569   				       }

   570 {ID}	                               {

   571                                        }  

   572 }

   573 <AttributeList>{

   574 {COMMA}					{}

   575 {BS}					{}

   576 {ATTR_SPEC}				{ /* update current modifiers */

   577                                           QCString tmp = yytext;

   578                                           currentModifiers |= (tmp);

   579 					}

   580 "::"					{ /* end attribute list */

   581 					  BEGIN( Variable );

   582 					}

   583 .					{ /* unknown attribute, consider variable name */

   584 					  //cout<<"start variables, unput "<<*yytext<<endl;

   585 					  unput(*yytext);

   586 					  BEGIN( Variable );

   587 					}

   588 }

   589 

   590 <Variable>{BS}				{}

   591 <Variable>{ID}				{ /* parse variable declaration */

   592                                           //cout << "5=========> got variable: " << argType << "::" << yytext << endl;

   593  					  /* work around for bug in QCString.replace (QCString works) */

   594 					  QCString name=yytext;

   595 					  /* remember attributes for the symbol */

   596 					  modifiers[current_root][name.lower()] |= currentModifiers;

   597 					  argName= name;

   598 

   599 					  v_type= V_IGNORE;

   600   					  if (!argType.isEmpty() && current_root->section!=Entry::FUNCTION_SEC) 

   601 					  { // new variable entry

   602 					    v_type = V_VARIABLE;

   603                                             current->section = Entry::VARIABLE_SEC;

   604  					    current->name = argName;

   605 					    current->type = argType;

   606 					    current->fileName = yyFileName;

   607 					    current->bodyLine  = yyLineNr; // used for source reference

   608                                             addCurrentEntry();

   609                                           } 

   610 					  else if (!argType.isEmpty())

   611 					  { // deklaration of parameter list: add type for corr. parameter 

   612 					    parameter= addFortranParameter(argType,argName,docBlock);

   613 					    if (parameter) v_type= V_PARAMETER;

   614 					    // save, it may be function return type

   615 					    modifiers[current_root][name.lower()].type = argType;

   616 					    // any accumulated doc for argument should be emptied,

   617 					    // because it is handled other way and this doc can be

   618 					    // unexpectedly passed to the next member.

   619 					    current->doc.resize(0);

   620 					    current->brief.resize(0);

   621                                           } 

   622   					}

   623 <Variable>{ARGS}			{ /* dimension of the previous entry. */

   624 					  QCString name(argName);

   625 					  QCString attr("dimension");

   626 					  attr += yytext;

   627 					  modifiers[current_root][name] |= attr;

   628 					}

   629 <Variable>{COMMA}	                {}

   630 <Variable>{BS}"="                       { yy_push_state(YY_START);

   631                                           initializer="";

   632                                           initializerScope = 0;

   633 					  BEGIN(Initialization);

   634                                         }

   635 <Variable>"\n"	                        { currentModifiers = SymbolModifiers();

   636                                           yy_pop_state(); // end variable deklaration list

   637                                           yyLineNr++; yyLineNr+=lineCountPrepass; lineCountPrepass=0;

   638                                           docBlock.resize(0);

   639                                         }

   640 

   641 <Initialization,ArrayInitializer>"(/"   { initializer+=yytext;

   642                                            initializerScope++;

   643                                            BEGIN(ArrayInitializer); // initializer may contain comma

   644                                         }

   645 <ArrayInitializer>"/)"                   { initializer+=yytext;

   646                                            initializerScope--;

   647                                            if(initializerScope<=0)

   648                                            {

   649                                               initializerScope = 0; // just in case

   650                                               BEGIN(Initialization);

   651                                            }

   652                                         }

   653 <ArrayInitializer>.                     { initializer+=yytext; }

   654 <Initialization>{COMMA}                 { yy_pop_state(); // end initialization

   655                                           if (v_type == V_VARIABLE) last_entry->initializer= initializer;

   656                                         }

   657 <Initialization>"\n"|"!"                { //| 

   658                                           yy_pop_state(); // end initialization

   659                                           if (v_type == V_VARIABLE) last_entry->initializer= initializer;

   660  					  unput(*yytext);

   661                                         }

   662 <Initialization>.                       { initializer+=yytext; }

   663  

   664  /*------ fortran subroutine/function handling ------------------------------------------------------------*/

   665  /*       Start is initial condition                                                                       */

   666  

   667 <Start,ModuleBody,SubprogBody,InterfaceBody,ModuleBodyContains,SubprogBodyContains>^{BS}({PREFIX}{BS_})?{TYPE_SPEC}{BS}/{SUBPROG}{BS_} {   

   668 		                           // TYPE_SPEC is for old function style function result

   669                                            result= yytext;

   670                                            result= result.stripWhiteSpace();

   671                                            extractPrefix(result);

   672                                            //fprintf(stderr, "===%s\n", (const char*)result);

   673   					   current->type = result;

   674                                            yy_push_state(SubprogPrefix);

   675                                        }          

   676 

   677 <SubprogPrefix>{BS}{SUBPROG}{BS_}     {

   678                                          // Fortran subroutine or function found

   679                                          addSubprogram(yytext);

   680                                          BEGIN(Subprog);

   681                                        }

   682 

   683 <Start,ModuleBody,SubprogBody,InterfaceBody,ModuleBodyContains,SubprogBodyContains>^{BS}({PREFIX}{BS_})?{SUBPROG}{BS_} {

   684                                          // Fortran subroutine or function found

   685                                          result= yytext;

   686                                          result= result.stripWhiteSpace();

   687                                          extractPrefix(result);

   688                                          addSubprogram(result);

   689                                          yy_push_state(Subprog);

   690                                        }

   691 

   692 <Subprog>{BS}                          {   /* ignore white space */   }

   693 <Subprog>{ID}                          {   current->name = yytext;

   694 					   //cout << "1a==========> got " << current->type << " " << yytext << " " << yyLineNr << endl;

   695 					   modifiers[current_root][current->name.lower()].returnName = current->name;

   696 					   BEGIN(Parameterlist);

   697                                        } 

   698 <Parameterlist>{ARGS}                  {   

   699 				           //current->type not yet available

   700                                            QCString arglist= yytext;

   701 					   //cout << "3=========> got parameterlist " << yytext << endl;

   702                                            //yyLineNr+= arglist.contains('\n');

   703 					   //static QRegExp re("&[^\n]*\n");

   704                                            //arglist = arglist.replace(re,"");

   705 					   //cout << "3=========> got parameterlist " << arglist << endl;

   706 					   current->args = arglist;

   707 					   current->args = removeRedundantWhiteSpace(current->args);

   708 					   stringToArgumentList(current->args, current->argList);

   709                                            addCurrentEntry();

   710 					   startScope(last_entry);

   711 					   BEGIN(SubprogBody);

   712  				       } 

   713 <Parameterlist>{NOARGS}                {   

   714                                            yyLineNr++; yyLineNr+=lineCountPrepass; lineCountPrepass=0;

   715 					   //printf("3=========> without parameterlist \n");

   716  					   stringToArgumentList("", current->argList);

   717                                            addCurrentEntry();

   718 					   startScope(last_entry);

   719 					   BEGIN(SubprogBody);				           

   720 }

   721 <SubprogBody>result{BS}\({BS}{ID}      {  

   722                                            result= yytext;

   723                                            result= result.right(result.length()-result.find("(")-1);

   724                                            result= result.stripWhiteSpace();

   725  					   modifiers[current_root->parent()][current_root->name.lower()].returnName = result;

   726                                            //cout << "=====> got result " <<  result << endl;

   727  				       } 

   728 

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

   730 

   731 <Variable>"!<"                           { /* backward docu comment (only one line) */

   732                                           if (v_type != V_IGNORE) {

   733                                            yy_push_state(YY_START);

   734 					   current->docLine  = yyLineNr;

   735  					   docBlockJavaStyle = FALSE;

   736 					   docBlock.resize(0);

   737 					   docBlockJavaStyle = Config_getBool("JAVADOC_AUTOBRIEF");

   738 					   startCommentBlock(TRUE);

   739 					   BEGIN(DocBackLine);

   740                                           }

   741   					 }

   742 <DocBackLine>.*    			 { // contents of current comment line

   743                                           docBlock=yytext;

   744 					  if (v_type == V_VARIABLE) 

   745 					  {

   746 					    Entry *tmp_entry = current; 

   747 					    current = last_entry; // temporarily switch to the previous entry

   748   					    handleCommentBlock(docBlock,TRUE);

   749  					    current=tmp_entry;

   750                                           }

   751 					  else if (v_type == V_PARAMETER) 

   752 					  {

   753 					    parameter->docs=docBlock;

   754                                           }

   755                                           yy_pop_state();

   756  					 }

   757    

   758 <Start,SubprogBody,ModuleBody,TypedefBody,InterfaceBody,ModuleBodyContains,SubprogBodyContains>"!>"  {

   759                                           yy_push_state(YY_START);

   760 					  current->docLine  = yyLineNr;

   761  					  docBlockJavaStyle = FALSE;

   762 					  docBlock.resize(0);

   763 					  docBlockJavaStyle = Config_getBool("JAVADOC_AUTOBRIEF");

   764 					  startCommentBlock(TRUE);

   765 					  BEGIN(DocBlock);

   766                                           //cout << "start DocBlock " << endl;

   767 					}

   768 

   769 <DocBlock>.*    			{ // contents of current comment line

   770                                           docBlock+=yytext;

   771   					}

   772 <DocBlock>"\n"{BS}"!"(">"|"!"+)		{ // comment block (next line is also comment line)

   773 					  docBlock+="\n"; // \n is necessary for lists

   774                                           yyLineNr++; yyLineNr+=lineCountPrepass; lineCountPrepass=0;

   775   					}

   776 <DocBlock>"\n"        			{ // comment block ends at the end of this line

   777                                           //cout <<"3=========> comment block : "<< docBlock << endl;

   778 					  unput(*yytext);                                        

   779  					  handleCommentBlock(docBlock,TRUE);

   780                                           yy_pop_state();                                          

   781   					}

   782 

   783  /*------------------------------------------------------------------------------------------------*/

   784 

   785 <*>"\n"                                 {

   786                                           yyLineNr++; yyLineNr+=lineCountPrepass; lineCountPrepass=0;

   787                                           //if (debugStr.stripWhiteSpace().length() > 0) cout << "ignored text: " << debugStr << " state: " <<YY_START << endl;

   788                                           debugStr="";

   789                                         }

   790 

   791 

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

   793 

   794 <*><<EOF>>                              {

   795                                           if ( include_stack_ptr <= 0 ) {

   796                                             if (YY_START!=INITIAL && YY_START!=Start) {

   797                                               //fprintf(stderr,"==== Error: EOF reached in wrong state (end missing)");

   798                                               scanner_abort();

   799                                             }

   800                                             yyterminate();

   801                                           } else {

   802                                             popBuffer();

   803                                           }

   804                                         }

   805  <*>.                 	                {

   806                                           //debugStr+=yytext;

   807 					  //printf("I:%c\n", *yytext);

   808                                         } // ignore remaining text 

   809 

   810  /**********************************************************************************/

   811  /**********************************************************************************/

   812  /**********************************************************************************/

   813 %%

   814 //----------------------------------------------------------------------------

   815 

   816 static void extractPrefix(QCString &text) {

   817   int prefixIndex = 0;

   818   int curIndex = 0;

   819   bool cont = TRUE;

   820   const char* pre[] = {"RECURSIVE","PURE","ELEMENTAL"};

   821   while(cont)

   822   {

   823     cont = FALSE;

   824     for(unsigned int i=0; i<3; i++)

   825     {

   826       if((prefixIndex=text.find(pre[i], curIndex, FALSE))==0)

   827       {

   828         text.remove(0,strlen(pre[i]));

   829         text.stripWhiteSpace();

   830         cont = TRUE;

   831       }

   832     }

   833   }

   834 }

   835 

   836 static int getAmpersandAtTheStart(const char *buf, int length)

   837 {

   838   for(int i=0; i<length; i++) {

   839     switch(buf[i]) {

   840       case ' ':

   841       case '\t':

   842         break;

   843       case '&':

   844         return i;

   845       default:

   846         return -1;

   847     }

   848   }

   849   return -1;

   850 }

   851 

   852 /* Returns ampersand index, comment start index or -1 if neither exist.*/ 

   853 static int getAmpOrExclAtTheEnd(const char *buf, int length)

   854 {

   855   // Avoid ampersands in string and comments

   856   int parseState = Start;

   857   char quoteSymbol = 0;

   858   int ampIndex = -1;

   859   int commentIndex = -1;

   860 

   861   for(int i=0; i<length && parseState!=Comment; i++)

   862   {

   863     // When in string, skip backslashes

   864     // Legacy code, not sure whether this is correct?

   865     if(parseState==String)

   866     {

   867       if(buf[i]=='\\') i++;

   868     }

   869 

   870     switch(buf[i])

   871     {

   872         case '\'':

   873         case '"':

   874           // Close string, if quote symbol matches.

   875           // Quote symbol is set iff parseState==String

   876           if(buf[i]==quoteSymbol)

   877           {

   878              parseState = Start;

   879              quoteSymbol = 0;

   880           }

   881           // Start new string, if not already in string or comment

   882           else if(parseState==Start)

   883           {

   884             parseState = String;

   885             quoteSymbol = buf[i];

   886           }

   887           ampIndex = -1; // invalidate prev ampersand

   888           break;

   889         case '!':

   890           // When in string or comment, ignore exclamation mark

   891           if(parseState==Start)

   892           {

   893             parseState = Comment;

   894             commentIndex = i;

   895           }

   896           break;

   897         case ' ':  // ignore whitespace

   898         case '\t':

   899         case '\n': // this may be at the end of line

   900           break;

   901         case '&':

   902           ampIndex = i;

   903           break;

   904         default:

   905           ampIndex = -1; // invalidate prev ampersand

   906     }

   907   }

   908 

   909   if (ampIndex>=0)

   910     return ampIndex;

   911   else

   912    return commentIndex;

   913 }

   914 

   915 /* Although comments at the end of continuation line are grabbed by this function,

   916 * we still do not know how to use them later in parsing.

   917 */

   918 void truncatePrepass(int index)

   919 {

   920   int length = inputStringPrepass.length();

   921   for (int i=index+1; i<length; i++) {

   922     if (inputStringPrepass[i]=='!') { // save comment 

   923       //printf("-----SAVE----- %d:%s", i, (const char*)inputStringPrepass.right(length-i));

   924       struct CommentInPrepass *c=new CommentInPrepass(index, inputStringPrepass.right(length-i));

   925       comments.append(c);

   926     }

   927   }

   928   inputStringPrepass.truncate(index);

   929 }

   930 

   931 // simplified way to know if this is fixed form

   932 // duplicate in fortrancode.l

   933 static bool recognizeFixedForm(const char* contents)

   934 {

   935   int column=0;

   936   bool skipLine=FALSE;

   937 

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

   939     column++;

   940 

   941     switch(contents[i]) {

   942       case '\n':

   943         column=0;

   944         skipLine=FALSE;

   945         break;

   946       case ' ':

   947         break;

   948       case '\000':

   949         return FALSE;

   950       case 'C':

   951       case 'c':

   952       case '*':

   953         if(column==1) return TRUE;

   954         if(skipLine) break;

   955         return FALSE;

   956       case '!':

   957         if(column>1 && column<7) return FALSE;

   958         skipLine=TRUE;

   959         break;

   960       default:

   961         if(skipLine) break;

   962         if(column==7) return TRUE;

   963         return FALSE;

   964     }

   965   }

   966   return FALSE;

   967 }

   968 

   969 /* This function assumes that contents has at least size=length+1 */

   970 static void insertCharacter(char *contents, int length, int pos, char c)

   971 {

   972   // shift tail by one character

   973   for(int i=length; i>pos; i--)

   974     contents[i]=contents[i-1];

   975   // set the character

   976   contents[pos] = c;

   977 }

   978 

   979 /* change comments and bring line continuation character to previous line */

   980 static const char* prepassFixedForm(const char* contents)

   981 {

   982   int column=0;

   983   int prevLineLength=0;

   984   int prevLineAmpOrExclIndex=-1;

   985   bool emptyLabel=TRUE;

   986   int newContentsSize = strlen(contents)+2; // \000 and one spare character (to avoid reallocation)

   987   char* newContents = (char*)malloc(newContentsSize);

   988 

   989   for(int i=0, j=0;;i++,j++) {

   990     if(j>=newContentsSize-1) { // check for one spare character, which may be eventually used below (by &)

   991       newContents = (char*)realloc(newContents, newContentsSize+1000);

   992       newContentsSize = newContentsSize+1000;

   993     }

   994 

   995     column++;

   996     char c = contents[i];

   997     switch(c) {

   998       case '\n':

   999         prevLineLength=column;

  1000         prevLineAmpOrExclIndex=getAmpOrExclAtTheEnd(&contents[i-prevLineLength+1], prevLineLength);

  1001         column=0;

  1002 	emptyLabel=TRUE;

  1003         newContents[j]=c;

  1004         break;

  1005       case ' ':

  1006         newContents[j]=c;

  1007         break;

  1008       case '\000':

  1009         newContents[j]='\000';

  1010         return newContents;

  1011       case 'C':

  1012       case 'c':

  1013       case '*':

  1014 	emptyLabel=FALSE;

  1015         if(column==1)

  1016 	  newContents[j]='!';

  1017         else

  1018           newContents[j]=c;

  1019         break;

  1020       default:

  1021         if(column==6 && emptyLabel) { // continuation

  1022           newContents[j]=' ';

  1023 

  1024           if(prevLineAmpOrExclIndex==-1) { // add & just before end of previous line

  1025             insertCharacter(newContents, j+1, (j+1)-6-1, '&');

  1026             j++;

  1027           } else { // add & just before end of previous line comment

  1028             insertCharacter(newContents, j+1, (j+1)-6-prevLineLength+prevLineAmpOrExclIndex, '&');

  1029             j++;

  1030           }

  1031 	} else {

  1032 	  newContents[j]=c;

  1033 	  emptyLabel=FALSE;

  1034 	}

  1035         break;

  1036     }

  1037   }

  1038   return newContents;

  1039 }

  1040 

  1041 static void pushBuffer(QCString& buffer)

  1042 {

  1043   if ( include_stack_ptr >= MAX_INCLUDE_DEPTH )

  1044   {

  1045     fprintf( stderr, "Stack buffers nested too deeply" );

  1046     exit( 1 );

  1047   }

  1048   include_stack[include_stack_ptr++] = YY_CURRENT_BUFFER;

  1049   yy_switch_to_buffer(yy_scan_string(buffer));

  1050 

  1051   //fprintf(stderr, "--PUSH--%s", (const char *)buffer);

  1052   buffer = NULL;

  1053 }

  1054 

  1055 static void popBuffer() {

  1056   //fprintf(stderr, "--POP--");

  1057   include_stack_ptr --;

  1058   yy_delete_buffer( YY_CURRENT_BUFFER );

  1059   yy_switch_to_buffer( include_stack[include_stack_ptr] );

  1060 }

  1061 

  1062 /** used to copy entry to an interface module procedure */

  1063 static void copyEntry(Entry *dest, Entry *src) 

  1064 {

  1065    dest->type     = src->type;

  1066    dest->fileName = src->fileName;

  1067    dest->bodyLine = src->bodyLine;

  1068    dest->args     = src->args;

  1069    dest->argList  = new ArgumentList(*src->argList);

  1070 }

  1071 

  1072 /** fill empty interface module procedures with info from 

  1073     corresponding module subprogs 

  1074     @TODO: handle procedures in used modules

  1075 */

  1076 void resolveModuleProcedures(QList<Entry> &moduleProcedures, Entry *current_root)

  1077 {

  1078   if (moduleProcedures.isEmpty()) return;

  1079  

  1080   EntryListIterator eli1(moduleProcedures);

  1081   // for all module procedures

  1082   for (Entry *ce1; (ce1=eli1.current()); ++eli1) 

  1083   {

  1084     // check all entries in this module

  1085     EntryListIterator eli2(*current_root->children());

  1086     for (Entry *ce2; (ce2=eli2.current()); ++eli2) 

  1087     {

  1088       if (ce1->name == ce2->name) 

  1089       {

  1090         copyEntry(ce1, ce2);

  1091       }

  1092     } // for procedures in current module

  1093   } // for all interface module procedures

  1094   moduleProcedures.clear();

  1095 }

  1096 

  1097 static bool isTypeName(QCString name)

  1098 {

  1099   name = name.lower();

  1100   return name=="integer" || name == "real" || 

  1101     name=="complex" || name == "logical";

  1102 }

  1103 

  1104 /*! Extracts string which resides within parentheses of provided string. */

  1105 static QCString extractFromParens(const QCString name)

  1106 {

  1107   QCString extracted = name;

  1108   int start = extracted.find("(");

  1109   if (start != -1) 

  1110   {

  1111     extracted.remove(0, start+1);

  1112   }

  1113   int end = extracted.findRev(")");

  1114   if (end != -1) 

  1115   {

  1116     int length = extracted.length();

  1117     extracted.remove(end, length);

  1118   }

  1119   extracted = extracted.stripWhiteSpace();

  1120 

  1121   return extracted;

  1122 }

  1123 

  1124 /*! Adds passed modifiers to these modifiers.*/

  1125 SymbolModifiers& SymbolModifiers::operator|=(const SymbolModifiers &mdfs)

  1126 {

  1127   if (mdfs.protection!=NONE_P) protection = mdfs.protection;

  1128   if (mdfs.direction!=NONE_D) direction = mdfs.direction;

  1129   optional |= mdfs.optional;

  1130   if (!mdfs.dimension.isNull()) dimension = mdfs.dimension;

  1131   allocatable |= mdfs.allocatable;

  1132   external |= mdfs.external;

  1133   intrinsic |= mdfs.intrinsic;

  1134   parameter |= mdfs.parameter;