diff -r 932c358ece3e -r d8fccb2cd802 Orb/Doxygen/src/fortranscanner.l --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Orb/Doxygen/src/fortranscanner.l Fri Apr 23 20:47:58 2010 +0100 @@ -0,0 +1,1785 @@ +/* -*- 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. + */ + +%{ + +#include +#include +#include +#include + +#include "qtbc.h" +#include +#include +#include +#include +#include +#include + +#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" + +#define YY_NEVER_INTERACTIVE 1 + +enum ScanVar { V_IGNORE, V_VARIABLE, V_PARAMETER}; + +// {{{ ----- 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; + QCString dimension; + bool allocatable; + bool external; + bool intrinsic; + bool parameter; + bool pointer; + bool target; + bool save; + + SymbolModifiers() : type(), returnName(), protection(NONE_P), direction(NONE_D), + optional(FALSE), dimension(), allocatable(FALSE), + external(FALSE), intrinsic(FALSE), parameter(FALSE), + pointer(FALSE), target(FALSE), save(FALSE) {} + + 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)" +}; + +// }}} + +/* ----------------------------------------------------------------- + * + * 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 unsigned int inputPositionPrepass; +static int lineCountPrepass = 0; + +struct CommentInPrepass { + int column; + QCString str; + CommentInPrepass(int column, QCString str) : column(column), str(str) {} +}; +static QList comments; + +#define MAX_INCLUDE_DEPTH 10 +YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH]; +int include_stack_ptr = 0; + +static QFile inputFile; +static QCString yyFileName; +static int yyLineNr = 1 ; +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 moduleProcedures; // list of all interfaces which contain unresolved + // module procedures +static QCString docBlock; +static QCString docBlockName; +static bool docBlockInBody; +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 initializerScope; // number if nested array scopes in initializer +static QCString useModuleName; // name of module in the use statement +static Protection defaultProtection; + +static char stringStartSymbol; // single or double quote + +//! Accumulated modifiers of current statement, eg variable declaration. +static SymbolModifiers currentModifiers; +//! Holds program scope->symbol name->symbol modifiers. +static QMap > modifiers; + +//----------------------------------------------------------------------------- + +static int yyread(char *buf,int max_size); +static void startCommentBlock(bool); +static void handleCommentBlock(const QCString &doc,bool brief); +static void addCurrentEntry(); +static void addModule(const char *name, bool isModule=FALSE); +static void addSubprogram(const char *text); +static void addInterface(QCString name); +static Argument *addFortranParameter(const QCString &type,const QCString &name, const QCString docs); +static void scanner_abort(); + +static void startScope(Entry *scope); +static bool endScope(Entry *scope, bool isGlobalRoot=FALSE); +static QCString getFullName(Entry *e); +static bool isTypeName(QCString name); +static void resolveModuleProcedures(QList &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); + +//----------------------------------------------------------------------------- +#undef YY_INPUT +#define YY_INPUT(buf,result,max_size) result=yyread(buf,max_size); +//----------------------------------------------------------------------------- + +%} + + //----------------------------------------------------------------------------- + //----------------------------------------------------------------------------- +IDSYM [a-z_A-Z0-9] +NOTIDSYM [^a-z_A-Z0-9] +SEPARATE [:, \t] +ID [a-z_A-Z%]+{IDSYM}* +PP_ID {ID} +LABELID [a-z_A-Z]+[a-z_A-Z0-9\-]* +SUBPROG (subroutine|function|block) +B [ \t] +BS [ \t]* +BS_ [ \t]+ +COMMA {BS},{BS} +ARGS {BS}("("[^)]*")") +NOARGS {BS}"\n" + +NUM_TYPE (complex|integer|logical|real) +KIND {ARGS} +CHAR (CHARACTER{ARGS}?|CHARACTER{BS}"*"({BS}[0-9]+|{ARGS})) +TYPE_SPEC (({NUM_TYPE}({BS}"*"{BS}[0-9]+)?)|({NUM_TYPE}{KIND})|DOUBLE{BS_}PRECISION|{CHAR}|TYPE{ARGS}) + +INTENT_SPEC intent{BS}"("{BS}(in|out|in{BS}out){BS}")" +ATTR_SPEC (ALLOCATABLE|DIMENSION{ARGS}|EXTERNAL|{INTENT_SPEC}|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PRIVATE|PUBLIC|SAVE|TARGET) +ACCESS_SPEC (PRIVATE|PUBLIC) +/* Assume that attribute statements are almost the same as attributes. */ +ATTR_STMT {ATTR_SPEC}|DIMENSION|{ACCESS_SPEC} + +CONTAINS CONTAINS +PREFIX (RECURSIVE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,2}(RECURSIVE|PURE|ELEMENTAL)? + +%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 InterfaceBody +%x StrIgnore +%x String +%x Use +%x UseOnly +%x ModuleProcedure + +%x Prepass + + /** comment parsing states */ +%x DocBlock +%x DocBackLine +%x EndDoc + +%% + + /*-----------------------------------------------------------------------------------*/ + +<*>^.*\n { // prepass: look for line continuations + + //fprintf(stderr, "---%s", yytext); + + int indexStart = getAmpersandAtTheStart(yytext, yyleng); + int indexEnd = getAmpOrExclAtTheEnd(yytext, 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)); + + pushBuffer(inputStringPrepass); + yy_pop_state(); + } else { // simple line + 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 */ +<*>"\\\\" { /* ignore \\ */} +<*>"\\\""|\\\' { /* ignore \" and \' */} + +\"|\' { // string ends with next quote without previous backspace + if (yytext[0]!=stringStartSymbol) REJECT; // single vs double quote + // fprintf(stderr,"string end: %s\n",debugStr.data()); + yy_pop_state(); + } + +. { debugStr+=yytext; } // ignore String contents (especially '!') + +<*>\"|\' { /* string starts */ + if (YY_START == StrIgnore) REJECT; // ignore in simple comments + // fprintf(stderr,"string start: %c %d\n",yytext[0],yyLineNr); + yy_push_state(YY_START); + stringStartSymbol=yytext[0]; // single or double quote + BEGIN(String); debugStr="!^!"; + } + + /*------ ignore simple comment (not documentation comments) */ + +<*>"!"/[^<>\n] { if (YY_START == String) 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); + } + } +.?/\n { yy_pop_state(); // comment ends with endline character + //fprintf(stderr,"end comment %d %s\n",yyLineNr,debugStr.data()); + } // comment line ends +. { debugStr+=yytext; } + + + /*------ use handling ------------------------------------------------------------*/ + +"use"{BS_} { + if(YY_START == Start) + { + addModule(NULL); + yy_push_state(ModuleBody); //anon program + } + yy_push_state(Use); + } +{ID} { + //fprintf(stderr,"using dir %s\n",yytext); + current->name=yytext; + current->fileName = yyFileName; + current->section=Entry::USINGDIR_SEC; + current_root->addSubEntry(current); + current = new Entry; + yy_pop_state(); + } +{ID}/, { + useModuleName=yytext; + } +,{BS}"ONLY" { BEGIN(UseOnly); + } +{BS},{BS} {} +{ID} { + current->name= useModuleName+"::"+yytext; + current->fileName = yyFileName; + current->section=Entry::USINGDECL_SEC; + current_root->addSubEntry(current); + current = new Entry ; + } +"\n" { + unput(*yytext); + yy_pop_state(); + } + + /*------ ignore special fortran statements */ +^[ \t]*interface({BS_}{ID}({BS}\({BS}[^ \t()]+{BS}\))?)?/{BS}(!|\n) { // handle interface block + if(YY_START == Start) + { + addModule(NULL); + yy_push_state(ModuleBody); //anon program + } + + QCString name = yytext; + int index = name.find("interface", 0, FALSE); + index = name.find(QRegExp("[^ \\t]"), index+9); + //printf(stderr,"%s,%d\n",name.data(),index); + if (index!=-1) + name = name.right(name.length()-index); + else // interface without name, must be inside subprog + name = "interface"; + addInterface(name); + yy_push_state(InterfaceBody); + startScope(last_entry); + } +^{BS}"end"({BS}"interface"({BS_}{ID})?)?{BS}/(\n|!) { + if (!endScope(current_root)) + yyterminate(); + yy_pop_state(); + } +module{BS}procedure { yy_push_state(YY_START); + BEGIN(ModuleProcedure); + } +{ID} { + current->section = Entry::FUNCTION_SEC ; + current->name = yytext; + moduleProcedures.append(current); + addCurrentEntry(); + } +"\n" { unput(*yytext); + yy_pop_state(); + } +. {} + + /*-- Contains handling --*/ +^{BS}{CONTAINS}/({BS}|\n|!) { + if(YY_START == Start) + { + addModule(NULL); + yy_push_state(ModuleBodyContains); //anon program + } + } +^{BS}{CONTAINS}/({BS}|\n|!) { BEGIN(ModuleBodyContains); } +^{BS}{CONTAINS}/({BS}|\n|!) { BEGIN(SubprogBodyContains); } + + /*------ module handling ------------------------------------------------------------*/ +module|program{BS_} { // + if(yytext[0]=='m' || yytext[0]=='M') + yy_push_state(Module); + else + yy_push_state(Program); + defaultProtection = Public; + } +^{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(); + } +{ID} { + addModule(yytext, TRUE); + BEGIN(ModuleBody); + } + +{ID} { + addModule(yytext, FALSE); + BEGIN(ModuleBody); + } + + /*------- access specification --------------------------------------------------------------------------*/ + +private/{BS}(\n|"!") { defaultProtection = Private; } +public/{BS}(\n|"!") { defaultProtection = Public; } + + /*------- type definition -------------------------------------------------------------------------------*/ + +"type"({BS_}|({COMMA}{ACCESS_SPEC})) { /* type definition found : TYPE , access-spec::type-name |*/ + if(YY_START == Start) + { + addModule(NULL); + yy_push_state(ModuleBody); //anon program + } + + yy_push_state(Typedef); + current->protection = defaultProtection; + } +{ACCESS_SPEC} { + QCString type= yytext; + } +{ID} { /* type name found */ + //cout << "=========> got typedef " << yytext << ": " << yyLineNr << endl; + current->section = Entry::CLASS_SEC; // was Entry::STRUCT_SEC; + current->spec = Entry::Struct; + current->name = yytext; + + /* 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_root->section == Entry::INTERFACE_SEC)) + { + current->name= current_root->name+"::"+current->name; + } + current->fileName = yyFileName; + current->bodyLine = yyLineNr; + addCurrentEntry(); + startScope(last_entry); + BEGIN(TypedefBody); + } +^{BS}"end"{BS}"type"({BS_}{ID})?{BS}/(\n|!) { /* end type definition */ + //printf("=========> got typedef end \n"); + if (!endScope(current_root)) + yyterminate(); + yy_pop_state(); + } + + /*------- module/global/typedef variable ---------------------------------------------------*/ + +^{BS}"end"({BS}{SUBPROG}({BS_}{ID})?)?{BS}/(\n|!) { + //fprintf(stderr,"1e=========> got end subprog: %s\n", yytext); + + /* args is used for parameters in list of functions, argList for + parameters in detailed function descripttion */ + //current->args = argListToString(current->argList); + //current->endBodyLine = yyLineNr; // ??? what ist endBodyLine for + if (!endScope(current_root)) + yyterminate(); + yy_pop_state() ; + } +{ +^{BS}{TYPE_SPEC}/{SEPARATE} { + /* variable declaration starts */ + if(YY_START == Start) + { + addModule(NULL); + yy_push_state(ModuleBody); //anon program + } + //fprintf(stderr,"4=========> got variable type: %s\n",yytext); + QCString help=yytext; + help= help.simplifyWhiteSpace(); + argType= help; + yy_push_state(AttributeList); + } +^{BS}{PP_ID}{KIND}? { /* check for preprocessor symbol expand to type */ + QCString str = yytext; + str = str.stripWhiteSpace(); + DefineDict* defines = getFileDefineDict(); + QCString name; + int index = str.find("("); + if (index != -1) + name = str.left(index).stripWhiteSpace(); + else + name = str; + + Define *define = (*defines)[name]; + if (define != 0 && isTypeName(define->definition)) + { + argType = str; + yy_push_state(AttributeList); + } + else + { + REJECT; + } + } +{ATTR_STMT}/{BS_}{ID} | +{ATTR_STMT}/{BS}"::" { + /* attribute statement starts */ + //fprintf(stderr,"5=========> Attribute statement: %s\n", yytext); + QCString tmp = yytext; + currentModifiers |= tmp.stripWhiteSpace(); + argType=""; + yy_push_state(YY_START); + BEGIN( AttributeList ) ; + } +{ID} { + } +} +{ +{COMMA} {} +{BS} {} +{ATTR_SPEC} { /* update current modifiers */ + QCString tmp = yytext; + currentModifiers |= (tmp); + } +"::" { /* end attribute list */ + BEGIN( Variable ); + } +. { /* unknown attribute, consider variable name */ + //cout<<"start variables, unput "<<*yytext<{BS} {} +{ID} { /* parse variable declaration */ + //cout << "5=========> got variable: " << argType << "::" << yytext << endl; + /* work around for bug in QCString.replace (QCString works) */ + QCString name=yytext; + /* 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(); + } + else if (!argType.isEmpty()) + { // deklaration of parameter list: add type for corr. parameter + parameter= addFortranParameter(argType,argName,docBlock); + if (parameter) v_type= V_PARAMETER; + // save, it may be function return type + 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); + } + } +{ARGS} { /* dimension of the previous entry. */ + QCString name(argName); + QCString attr("dimension"); + attr += yytext; + modifiers[current_root][name] |= attr; + } +{COMMA} {} +{BS}"=" { yy_push_state(YY_START); + initializer=""; + initializerScope = 0; + BEGIN(Initialization); + } +"\n" { currentModifiers = SymbolModifiers(); + yy_pop_state(); // end variable deklaration list + yyLineNr++; yyLineNr+=lineCountPrepass; lineCountPrepass=0; + docBlock.resize(0); + } + +"(/" { initializer+=yytext; + initializerScope++; + BEGIN(ArrayInitializer); // initializer may contain comma + } +"/)" { initializer+=yytext; + initializerScope--; + if(initializerScope<=0) + { + initializerScope = 0; // just in case + BEGIN(Initialization); + } + } +. { initializer+=yytext; } +{COMMA} { yy_pop_state(); // end initialization + if (v_type == V_VARIABLE) last_entry->initializer= initializer; + } +"\n"|"!" { //| + yy_pop_state(); // end initialization + if (v_type == V_VARIABLE) last_entry->initializer= initializer; + unput(*yytext); + } +. { initializer+=yytext; } + + /*------ fortran subroutine/function handling ------------------------------------------------------------*/ + /* Start is initial condition */ + +^{BS}({PREFIX}{BS_})?{TYPE_SPEC}{BS}/{SUBPROG}{BS_} { + // TYPE_SPEC is for old function style function result + result= yytext; + result= result.stripWhiteSpace(); + extractPrefix(result); + //fprintf(stderr, "===%s\n", (const char*)result); + current->type = result; + yy_push_state(SubprogPrefix); + } + +{BS}{SUBPROG}{BS_} { + // Fortran subroutine or function found + addSubprogram(yytext); + BEGIN(Subprog); + } + +^{BS}({PREFIX}{BS_})?{SUBPROG}{BS_} { + // Fortran subroutine or function found + result= yytext; + result= result.stripWhiteSpace(); + extractPrefix(result); + addSubprogram(result); + yy_push_state(Subprog); + } + +{BS} { /* ignore white space */ } +{ID} { current->name = yytext; + //cout << "1a==========> got " << current->type << " " << yytext << " " << yyLineNr << endl; + modifiers[current_root][current->name.lower()].returnName = current->name; + BEGIN(Parameterlist); + } +{ARGS} { + //current->type not yet available + QCString arglist= yytext; + //cout << "3=========> got parameterlist " << yytext << endl; + //yyLineNr+= arglist.contains('\n'); + //static QRegExp re("&[^\n]*\n"); + //arglist = arglist.replace(re,""); + //cout << "3=========> got parameterlist " << arglist << endl; + current->args = arglist; + current->args = removeRedundantWhiteSpace(current->args); + stringToArgumentList(current->args, current->argList); + addCurrentEntry(); + startScope(last_entry); + BEGIN(SubprogBody); + } +{NOARGS} { + yyLineNr++; yyLineNr+=lineCountPrepass; lineCountPrepass=0; + //printf("3=========> without parameterlist \n"); + stringToArgumentList("", current->argList); + addCurrentEntry(); + startScope(last_entry); + BEGIN(SubprogBody); +} +result{BS}\({BS}{ID} { + 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 --------------------------------------------------------------------*/ + +"!<" { /* backward docu comment (only one line) */ + if (v_type != V_IGNORE) { + yy_push_state(YY_START); + current->docLine = yyLineNr; + docBlockJavaStyle = FALSE; + docBlock.resize(0); + docBlockJavaStyle = Config_getBool("JAVADOC_AUTOBRIEF"); + startCommentBlock(TRUE); + BEGIN(DocBackLine); + } + } +.* { // contents of current comment line + docBlock=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) + { + parameter->docs=docBlock; + } + yy_pop_state(); + } + +"!>" { + yy_push_state(YY_START); + current->docLine = yyLineNr; + docBlockJavaStyle = FALSE; + docBlock.resize(0); + docBlockJavaStyle = Config_getBool("JAVADOC_AUTOBRIEF"); + startCommentBlock(TRUE); + BEGIN(DocBlock); + //cout << "start DocBlock " << endl; + } + +.* { // contents of current comment line + docBlock+=yytext; + } +"\n"{BS}"!"(">"|"!"+) { // comment block (next line is also comment line) + docBlock+="\n"; // \n is necessary for lists + yyLineNr++; yyLineNr+=lineCountPrepass; lineCountPrepass=0; + } +"\n" { // comment block ends at the end of this line + //cout <<"3=========> comment block : "<< docBlock << endl; + unput(*yytext); + handleCommentBlock(docBlock,TRUE); + yy_pop_state(); + } + + /*------------------------------------------------------------------------------------------------*/ + +<*>"\n" { + yyLineNr++; yyLineNr+=lineCountPrepass; lineCountPrepass=0; + //if (debugStr.stripWhiteSpace().length() > 0) cout << "ignored text: " << debugStr << " state: " <<> { + if ( include_stack_ptr <= 0 ) { + if (YY_START!=INITIAL && YY_START!=Start) { + //fprintf(stderr,"==== Error: EOF reached in wrong state (end missing)"); + scanner_abort(); + } + yyterminate(); + } else { + popBuffer(); + } + } + <*>. { + //debugStr+=yytext; + //printf("I:%c\n", *yytext); + } // ignore remaining text + + /**********************************************************************************/ + /**********************************************************************************/ + /**********************************************************************************/ +%% +//---------------------------------------------------------------------------- + +static void extractPrefix(QCString &text) { + int prefixIndex = 0; + int curIndex = 0; + bool cont = TRUE; + const char* pre[] = {"RECURSIVE","PURE","ELEMENTAL"}; + while(cont) + { + cont = FALSE; + for(unsigned int i=0; i<3; i++) + { + if((prefixIndex=text.find(pre[i], curIndex, FALSE))==0) + { + text.remove(0,strlen(pre[i])); + text.stripWhiteSpace(); + cont = TRUE; + } + } + } +} + +static int getAmpersandAtTheStart(const char *buf, int length) +{ + for(int i=0; i=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; i1 && 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)+2; // \000 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'; + return newContents; + case 'C': + case 'c': + case '*': + emptyLabel=FALSE; + if(column==1) + newContents[j]='!'; + else + newContents[j]=c; + break; + default: + if(column==6 && emptyLabel) { // continuation + 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; + emptyLabel=FALSE; + } + break; + } + } + return newContents; +} + +static void pushBuffer(QCString& buffer) +{ + if ( include_stack_ptr >= MAX_INCLUDE_DEPTH ) + { + fprintf( stderr, "Stack buffers nested too deeply" ); + exit( 1 ); + } + include_stack[include_stack_ptr++] = YY_CURRENT_BUFFER; + yy_switch_to_buffer(yy_scan_string(buffer)); + + //fprintf(stderr, "--PUSH--%s", (const char *)buffer); + buffer = NULL; +} + +static void popBuffer() { + //fprintf(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); +} + +/** fill empty interface module procedures with info from + corresponding module subprogs + @TODO: handle procedures in used modules +*/ +void resolveModuleProcedures(QList &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(); +} + +static bool isTypeName(QCString name) +{ + name = name.lower(); + return name=="integer" || name == "real" || + name=="complex" || name == "logical"; +} + +/*! 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; + parameter |= mdfs.parameter; + pointer |= mdfs.pointer; + target |= mdfs.target; + save |= mdfs.save; + 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=="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; + } + + (*this) |= newMdf; + return *this; +} + +/*! For debugging purposes. */ +//ostream& operator<<(ostream& out, const SymbolModifiers& mdfs) +//{ +// out<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()) + { + typeName += ","; + typeName += mdfs.dimension; + } + if (mdfs.direction!=SymbolModifiers::NONE_D) + { + typeName += ","; + typeName += directionStrs[mdfs.direction]; + } + if (mdfs.optional) + { + typeName += ","; + typeName += "optional"; + } + if (mdfs.allocatable) + { + typeName += ","; + typeName += "allocatable"; + } + if (mdfs.external) + { + typeName += ","; + typeName += "external"; + } + if (mdfs.intrinsic) + { + typeName += ","; + typeName += "intrinsic"; + } + if (mdfs.parameter) + { + typeName += ","; + typeName += "parameter"; + } + if (mdfs.pointer) + { + typeName += ","; + typeName += "pointer"; + } + if (mdfs.target) + { + typeName += ","; + typeName += "target"; + } + if (mdfs.save) + { + typeName += ","; + typeName += "save"; + } + + 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: "<name< 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: "<name<parent() || isGlobalRoot) + { + current_root= current_root->parent(); /* end substructure */ + } + else + { + fprintf(stderr,"parse error in end "); + scanner_abort(); + return FALSE; + } + + // update variables or subprogram arguments with modifiers + QMap& mdfsMap = modifiers[scope]; + + if (scope->section == Entry::FUNCTION_SEC) + { + // iterate all symbol modifiers of the scope + for (QMap::Iterator it=mdfsMap.begin(); it!=mdfsMap.end(); it++) + { + //cout<name.lower()].returnName<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 "<name<children()); + Entry *ce; + for (;(ce=eli.current());++eli) + { + 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 (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<name<<", "<name.lower())<name.lower())) + applyModifiers(ce, mdfsMap[ce->name.lower()]); + } + } + + // clear all modifiers of the scope + modifiers.remove(scope); + + return TRUE; +} + +//! 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; +} + +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() +{ + current->protection = defaultProtection ; + current->mtype = mtype; + current->virt = virt; + current->stat = gstat; + initGroupInfo(current); +} + +/** + adds current entry to current_root and creates new current +*/ +static void addCurrentEntry() +{ + //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) +{ + //fprintf(stderr, "0=========> got module %s\n", name); + + if (isModule) + current->section = Entry::NAMESPACE_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(); + startScope(last_entry); +} + + +static void addSubprogram(const char *text) +{ + //fprintf(stderr,"1=========> got subprog, type: %s\n",text); + current->section = Entry::FUNCTION_SEC ; + QCString subtype = text; subtype=subtype.lower().stripWhiteSpace(); + if (!current->type) current->type = subtype; + 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) +{ + current->section = Entry::CLASS_SEC; // was Entry::INTERFACE_SEC; + current->spec = Entry::Interface; + current->name = name; + + /* 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; + } + if ((current_root) && + (current_root->section == Entry::FUNCTION_SEC)) + { + current->name = getFullName(current_root) + "__" + QCString(current->name); + } + + current->fileName = yyFileName; + current->bodyLine = yyLineNr; + addCurrentEntry(); +} + + +//----------------------------------------------------------------------------- + +/*! Update the argument \a name with additional \a type info. + */ +static Argument *addFortranParameter(const QCString &type,const QCString &name, const QCString docs) +{ + //cout<<"addFortranParameter(): "<argList==0) return 0; + ArgumentListIterator ali(*current_root->argList); + Argument *a; + for (ali.toFirst();(a=ali.current());++ali) + { + if (a->type.lower()==name.lower()) + { + ret=a; +//cout << "addParameter found: " << type << " , " << name << endl; + a->type=type.stripWhiteSpace(); + a->name=name.stripWhiteSpace(); + if (!docs.isNull()) + a->docs = docs; + 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) +{ + docBlockInBody = FALSE; + bool needsEntry = FALSE; + static bool hideInBodyDocs = Config_getBool("HIDE_IN_BODY_DOCS"); + int position=0; + if (docBlockInBody && hideInBodyDocs) return; + //fprintf(stderr,"call parseCommentBlock [%s]\n",doc.data()); + int lineNr = brief ? current->briefLine : current->docLine; + while (parseCommentBlock( + g_thisParser, + docBlockInBody ? last_entry : current, + doc, // text + yyFileName, // file + lineNr, + docBlockInBody ? FALSE : brief, + docBlockInBody ? FALSE : docBlockJavaStyle, + docBlockInBody, + defaultProtection, + position, + needsEntry + )) + { + //fprintf(stderr,"parseCommentBlock position=%d [%s] needsEntry=%d\n",position,doc.data()+position,needsEntry); + if (needsEntry) addCurrentEntry(); + } + //fprintf(stderr,"parseCommentBlock position=%d [%s] needsEntry=%d\n",position,doc.data()+position,needsEntry); + + if (needsEntry) addCurrentEntry(); +} + +//---------------------------------------------------------------------------- +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--; +} + + +static void parseMain(const char *fileName,const char *fileBuf,Entry *rt) +{ + 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); + + if (isFixedForm) { + printf("Prepassing fixed form of %s\n", yyFileName.data()); + //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); + } + + 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->name = yyFileName; + current->section = Entry::SOURCE_SEC; + current_root->addSubEntry(current); + file_root = current; + current = new Entry; + + fscanYYrestart( fscanYYin ); + { + BEGIN( Start ); + } + + fscanYYlex(); + groupLeaveFile(yyFileName,yyLineNr); + + endScope(current_root, TRUE); // TRUE - global root + + //debugCompounds(rt); //debug + + rt->program.resize(0); + delete current; current=0; + moduleProcedures.clear(); + if (isFixedForm) { + free((char*)inputString); + inputString=NULL; + } + + inputFile.close(); + } +} + +//---------------------------------------------------------------------------- + +void FortranLanguageScanner::parseInput(const char *fileName,const char *fileBuf,Entry *root) +{ + g_thisParser = this; + ::parseMain(fileName,fileBuf,root); +} + +void FortranLanguageScanner::parseCode(CodeOutputInterface & codeOutIntf, + const char * scopeName, + const QCString & input, + bool isExampleBlock, + const char * exampleName, + FileDef * fileDef, + int startLine, + int endLine, + bool inlineFragment, + MemberDef *memberDef + ) +{ + ::parseFortranCode(codeOutIntf,scopeName,input,isExampleBlock,exampleName, + fileDef,startLine,endLine,inlineFragment,memberDef); +} + +bool FortranLanguageScanner::needsPreprocessing(const QCString &extension) +{ + (void)extension; + return TRUE; +} +void FortranLanguageScanner::resetCodeParserState() +{ + ::resetFortranCodeParserState(); +} + +void FortranLanguageScanner::parsePrototype(const char *text) +{ + (void)text; +} + +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 fscannerYYdummy() { yy_flex_realloc(0,0); } +} +#endif +