/****************************************************************************** * * Parser for syntax highlighting and references for Fortran90 F subset * * Copyright (C) by Anke Visser * based on the work of Dimitri van Heesch. * Copyright (C) 2020 by 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. * */ /** @todo - continuation lines not always recognized - merging of use-statements with same module name and different only-names - rename part of use-statement - links to interface functions - references to variables **/ %option never-interactive %option case-insensitive %option reentrant %option prefix="fortrancodeYY" %option extra-type="struct fortrancodeYY_state *" %option noyy_top_state %top{ #include } %{ /* * includes */ #include #include #include #include "doxygen.h" #include "message.h" #include "outputlist.h" #include "util.h" #include "membername.h" #include "defargs.h" #include "config.h" #include "groupdef.h" #include "classlist.h" #include "filedef.h" #include "namespacedef.h" #include "tooltip.h" #include "fortrancode.h" #include "fortranscanner.h" #include "containers.h" const int fixedCommentAfter = 72; // Toggle for some debugging info //#define DBG_CTX(x) fprintf x #define DBG_CTX(x) do { } while(0) #define YY_NO_TOP_STATE 1 #define YY_NO_INPUT 1 #define YY_NO_UNISTD_H 1 #define USE_STATE2STRING 0 /* * For fixed formatted code position 6 is of importance (continuation character). * The following variables and macros keep track of the column number * YY_USER_ACTION is always called for each scan action * YY_FTN_RESET is used to handle end of lines and reset the column counter * YY_FTN_REJECT resets the column counters when a pattern is rejected and thus rescanned. */ int yy_old_start = 0; int yy_my_start = 0; int yy_end = 1; #define YY_USER_ACTION {yy_old_start = yy_my_start; yy_my_start = yy_end; yy_end += static_cast(yyleng);} #define YY_FTN_RESET {yy_old_start = 0; yy_my_start = 0; yy_end = 1;} #define YY_FTN_REJECT {yy_end = yy_my_start; yy_my_start = yy_old_start; REJECT;} //-------------------------------------------------------------------------------- /** data of an use-statement */ class UseEntry { public: QCString module; // just for debug std::vector onlyNames; /* entries of the ONLY-part */ }; /** module name -> list of ONLY/remote entries (module name = name of the module, which can be accessed via use-directive) */ class UseMap : public std::map { }; /** Contains names of used modules and names of local variables. */ class Scope { public: std::vector useNames; //!< contains names of used modules StringUnorderedSet localVars; //!< contains names of local variables StringUnorderedSet externalVars; //!< contains names of external entities }; /*===================================================================*/ /* * statics */ struct fortrancodeYY_state { QCString docBlock; //!< contents of all lines of a documentation block QCString currentModule=QCString(); //!< name of the current enclosing module UseMap useMembers; //!< info about used modules UseEntry useEntry; //!< current use statement info std::vector scopeStack; bool isExternal = false; QCString str=QCString(); //!< contents of fortran string CodeOutputInterface * code = 0; const char * inputString = 0; //!< the code fragment as text yy_size_t inputPosition = 0; //!< read offset during parsing int inputLines = 0; //!< number of line in the code fragment int yyLineNr = 0; //!< current line number int contLineNr = 0; //!< current, local, line number for continuation determination int *hasContLine = 0; //!< signals whether or not a line has a continuation line (fixed source form) bool needsTermination = false; const Definition *searchCtx = 0; bool collectXRefs = false; bool isFixedForm = false; bool insideBody = false; //!< inside subprog/program body? => create links const char * currentFontClass = 0; bool exampleBlock = false; QCString exampleName; QCString exampleFile; FileDef * sourceFileDef = 0; const Definition * currentDefinition = 0; const MemberDef * currentMemberDef = 0; bool includeCodeFragment = false; char stringStartSymbol = '\0'; // single or double quote // count in variable declaration to filter out // declared from referenced names int bracketCount = 0; // signal when in type / class /procedure declaration int inTypeDecl = 0; bool endComment = false; }; #if USE_STATE2STRING static const char *stateToString(int state); #endif static bool getFortranNamespaceDefs(const QCString &mname, NamespaceDef *&cd); static bool getFortranTypeDefs(const QCString &tname, const QCString &moduleName, ClassDef *&cd, const UseMap &useMap); //---------------------------------------------------------------------------- static void endFontClass(yyscan_t yyscanner); static void startFontClass(yyscan_t yyscanner,const char *s); static void setCurrentDoc(yyscan_t yyscanner,const QCString &anchor); static void addToSearchIndex(yyscan_t yyscanner,const QCString &text); static void startCodeLine(yyscan_t yyscanner); static void endCodeLine(yyscan_t yyscanner); static void nextCodeLine(yyscan_t yyscanner); static void codifyLines(yyscan_t yyscanner,const QCString &text); static void writeMultiLineCodeLink(yyscan_t yyscanner,CodeOutputInterface &ol, Definition *d,const QCString &text); static bool getGenericProcedureLink(yyscan_t yyscanner,const ClassDef *cd, const QCString &memberText, CodeOutputInterface &ol); static bool getLink(yyscan_t yyscanner,const UseMap &useMap, // map with used modules const QCString &memberText, // exact member text CodeOutputInterface &ol, const QCString &text); static void generateLink(yyscan_t yyscanner,CodeOutputInterface &ol, const QCString &lname); static void generateLink(yyscan_t yyscanner,CodeOutputInterface &ol, const char *lname); static int countLines(yyscan_t yyscanner); static void startScope(yyscan_t yyscanner); static void endScope(yyscan_t yyscanner); static void addUse(yyscan_t yyscanner,const QCString &moduleName); static void addLocalVar(yyscan_t yyscanner,const QCString &varName); static MemberDef *getFortranDefs(yyscan_t yyscanner,const QCString &memberName, const QCString &moduleName, const UseMap &useMap); static yy_size_t yyread(yyscan_t yyscanner,char *buf,yy_size_t max_size); //------------------------------------------------------------------- static std::mutex g_docCrossReferenceMutex; static std::mutex g_countFlowKeywordsMutex; /* -----------------------------------------------------------------*/ #undef YY_INPUT #define YY_INPUT(buf,result,max_size) result=yyread(yyscanner,buf,max_size); %} IDSYM [a-z_A-Z0-9] ID [a-z_A-Z]+{IDSYM}* SUBPROG (subroutine|function) B [ \t] BS [ \t]* BS_ [ \t]+ COMMA {BS},{BS} ARGS_L0 ("("[^)]*")") ARGS_L1a [^()]*"("[^)]*")"[^)]* ARGS_L1 ("("{ARGS_L1a}*")") ARGS_L2 "("({ARGS_L0}|[^()]|{ARGS_L1a}|{ARGS_L1})*")" ARGS {BS}({ARGS_L0}|{ARGS_L1}|{ARGS_L2}) NUM_TYPE (complex|integer|logical|real) LOG_OPER (\.and\.|\.eq\.|\.eqv\.|\.ge\.|\.gt\.|\.le\.|\.lt\.|\.ne\.|\.neqv\.|\.or\.|\.not\.) KIND {ARGS} CHAR (CHARACTER{ARGS}?|CHARACTER{BS}"*"({BS}[0-9]+|{ARGS})) TYPE_SPEC (({NUM_TYPE}({BS}"*"{BS}[0-9]+)?)|({NUM_TYPE}{KIND})|DOUBLE{BS}COMPLEX|DOUBLE{BS}PRECISION|{CHAR}|TYPE|CLASS|PROCEDURE|ENUMERATOR) INTENT_SPEC intent{BS}"("{BS}(in|out|in{BS}out){BS}")" ATTR_SPEC (IMPLICIT|ALLOCATABLE|DIMENSION{ARGS}|EXTERNAL|{INTENT_SPEC}|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PROTECTED|PRIVATE|PUBLIC|SAVE|TARGET|(NON_)?RECURSIVE|PURE|IMPURE|ELEMENTAL|VALUE|NOPASS|DEFERRED|CONTIGUOUS|VOLATILE) ACCESS_SPEC (PROTECTED|PRIVATE|PUBLIC) /* Assume that attribute statements are almost the same as attributes. */ ATTR_STMT {ATTR_SPEC}|DIMENSION FLOW (DO|SELECT|CASE|SELECT{BS}(CASE|TYPE)|WHERE|IF|THEN|ELSE|WHILE|FORALL|ELSEWHERE|ELSEIF|RETURN|CONTINUE|EXIT|GO{BS}TO) COMMANDS (FORMAT|CONTAINS|MODULE{BS_}PROCEDURE|WRITE|READ|ALLOCATE|ALLOCATED|ASSOCIATED|PRESENT|DEALLOCATE|NULLIFY|SIZE|INQUIRE|OPEN|CLOSE|FLUSH|DATA|COMMON) IGNORE (CALL) PREFIX ((NON_)?RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,4}((NON_)?RECURSIVE|IMPURE|PURE|ELEMENTAL)?0 LANGUAGE_BIND_SPEC BIND{BS}"("{BS}C{BS}(,{BS}NAME{BS}"="{BS}"\""(.*)"\""{BS})?")" /* | */ %option noyywrap %option stack %option caseless /*%option debug*/ %x Start %x SubCall %x FuncDef %x ClassName %x ClassVar %x Subprog %x DocBlock %x Use %x UseOnly %x Import %x Declaration %x DeclarationBinding %x DeclContLine %x Parameterlist %x String %x Subprogend %% /*==================================================================*/ /*-------- ignore ------------------------------------------------------------*/ {IGNORE}/{BS}"(" { // do not search keywords, intrinsics... TODO: complete list codifyLines(yyscanner,yytext); } /*-------- inner construct ---------------------------------------------------*/ {COMMANDS}/{BS}[,( \t\n] { // highlight /* font class is defined e.g. in doxygen.css */ startFontClass(yyscanner,"keyword"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } {FLOW}/{BS}[,( \t\n] { if (yyextra->isFixedForm) { if ((yy_my_start == 1) && ((yytext[0] == 'c') || (yytext[0] == 'C'))) YY_FTN_REJECT; } if (yyextra->currentMemberDef && yyextra->currentMemberDef->isFunction()) { std::lock_guard lock(g_countFlowKeywordsMutex); MemberDefMutable *mdm = toMemberDefMutable(yyextra->currentMemberDef); if (mdm) { mdm->incrementFlowKeyWordCount(); } } /* font class is defined e.g. in doxygen.css */ startFontClass(yyscanner,"keywordflow"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } {BS}(CASE|CLASS|TYPE){BS_}(IS|DEFAULT) { startFontClass(yyscanner,"keywordflow"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } {BS}"end"({BS}{FLOW})/[ \t\n] { // list is a bit long as not all have possible end startFontClass(yyscanner,"keywordflow"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } "implicit"{BS}("none"|{TYPE_SPEC}) { startFontClass(yyscanner,"keywordtype"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } ^{BS}"namelist"/[/] { // Namelist specification startFontClass(yyscanner,"keywordtype"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } /*-------- use statement -------------------------------------------*/ "use"{BS_} { startFontClass(yyscanner,"keywordtype"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); yy_push_state(YY_START,yyscanner); BEGIN(Use); } "ONLY" { // TODO: rename startFontClass(yyscanner,"keywordtype"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); yy_push_state(YY_START,yyscanner); BEGIN(UseOnly); } {ID} { QCString tmp(yytext); tmp = tmp.lower(); yyextra->insideBody=TRUE; generateLink(yyscanner,*yyextra->code, yytext); yyextra->insideBody=FALSE; /* append module name to use dict */ yyextra->useEntry = UseEntry(); yyextra->useEntry.module = tmp; yyextra->useMembers.insert(std::make_pair(tmp.str(), yyextra->useEntry)); addUse(yyscanner,tmp); } {BS},{BS} { codifyLines(yyscanner,yytext); } {BS}&{BS}"\n" { codifyLines(yyscanner,yytext); yyextra->contLineNr++; YY_FTN_RESET} {ID} { QCString tmp(yytext); tmp = tmp.lower(); yyextra->useEntry.onlyNames.push_back(tmp); yyextra->insideBody=TRUE; generateLink(yyscanner,*yyextra->code, yytext); yyextra->insideBody=FALSE; } "\n" { unput(*yytext); yy_pop_state(yyscanner); YY_FTN_RESET } <*>"import"{BS}/"\n" | <*>"import"{BS_} { startFontClass(yyscanner,"keywordtype"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); yy_push_state(YY_START,yyscanner); BEGIN(Import); } {ID} { yyextra->insideBody=TRUE; generateLink(yyscanner,*yyextra->code, yytext); yyextra->insideBody=FALSE; } ("ONLY"|"NONE"|"ALL") { startFontClass(yyscanner,"keywordtype"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } /*-------- fortran module -----------------------------------------*/ ("block"{BS}"data"|"program"|"module"|"interface")/{BS_}|({COMMA}{ACCESS_SPEC})|\n { // startScope(yyscanner); startFontClass(yyscanner,"keyword"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); yy_push_state(YY_START,yyscanner); BEGIN(ClassName); if (!qstricmp(yytext,"module")) yyextra->currentModule="module"; } ("enum")/{BS_}|{BS}{COMMA}{BS}{LANGUAGE_BIND_SPEC}|\n { // startScope(yyscanner); startFontClass(yyscanner,"keyword"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); yy_push_state(YY_START,yyscanner); BEGIN(ClassName); } <*>{LANGUAGE_BIND_SPEC} { // startFontClass(yyscanner,"keyword"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } ("type")/{BS_}|({COMMA}({ACCESS_SPEC}|ABSTRACT|EXTENDS))|\n { // startScope(yyscanner); startFontClass(yyscanner,"keyword"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); yy_push_state(YY_START,yyscanner); BEGIN(ClassName); } {ID} { if (yyextra->currentModule == "module") { yyextra->currentModule=yytext; yyextra->currentModule = yyextra->currentModule.lower(); } generateLink(yyscanner,*yyextra->code,yytext); yy_pop_state(yyscanner); } ({ACCESS_SPEC}|ABSTRACT|EXTENDS)/[,:( ] { //| variable declaration startFontClass(yyscanner,"keyword"); yyextra->code->codify(QCString(yytext)); endFontClass(yyscanner); } \n { // interface may be without name yy_pop_state(yyscanner); YY_FTN_REJECT; } ^{BS}"end"({BS_}"enum").* { YY_FTN_REJECT; } ^{BS}"end"({BS_}"type").* { YY_FTN_REJECT; } ^{BS}"end"({BS_}"module").* { // just reset yyextra->currentModule, rest is done in following rule yyextra->currentModule=0; YY_FTN_REJECT; } /*-------- subprog definition -------------------------------------*/ ({PREFIX}{BS_})?{TYPE_SPEC}{BS_}({PREFIX}{BS_})?{BS}/{SUBPROG}{BS_} { // TYPE_SPEC is for old function style function result startFontClass(yyscanner,"keyword"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } ({PREFIX}{BS_})?{SUBPROG}{BS_} { // Fortran subroutine or function found startFontClass(yyscanner,"keyword"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); yy_push_state(YY_START,yyscanner); BEGIN(Subprog); } {ID} { // subroutine/function name DBG_CTX((stderr, "===> start subprogram %s\n", yytext)); startScope(yyscanner); generateLink(yyscanner,*yyextra->code,yytext); } "result"/{BS}"("[^)]*")" { startFontClass(yyscanner,"keyword"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } "("[^)]*")" { // ignore rest of line codifyLines(yyscanner,yytext); } "\n" { codifyLines(yyscanner,yytext); yyextra->contLineNr++; yy_pop_state(yyscanner); YY_FTN_RESET } "end"{BS}("block"{BS}"data"|{SUBPROG}|"module"|"program"|"enum"|"type"|"interface")?{BS} { // Fortran subroutine or function ends //cout << "===> end function " << yytext << endl; endScope(yyscanner); startFontClass(yyscanner,"keyword"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); yy_push_state(YY_START,yyscanner); BEGIN(Subprogend); } {ID}/{BS}(\n|!|;) { generateLink(yyscanner,*yyextra->code,yytext); yy_pop_state(yyscanner); } "end"{BS}("block"{BS}"data"|{SUBPROG}|"module"|"program"|"enum"|"type"|"interface"){BS}/(\n|!|;) { // Fortran subroutine or function ends //cout << "===> end function " << yytext << endl; endScope(yyscanner); startFontClass(yyscanner,"keyword"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } /*-------- variable declaration ----------------------------------*/ ^{BS}"real"/[,:( ] { // real is a bit tricky as it is a data type but also a function. yy_push_state(YY_START,yyscanner); BEGIN(Declaration); startFontClass(yyscanner,"keywordtype"); yyextra->code->codify(QCString(yytext)); endFontClass(yyscanner); } {TYPE_SPEC}/[,:( ] { QCString typ(yytext); typ = removeRedundantWhiteSpace(typ.lower()); if (typ.startsWith("real")) YY_FTN_REJECT; if (typ == "type" || typ == "class" || typ == "procedure") yyextra->inTypeDecl = 1; yy_push_state(YY_START,yyscanner); BEGIN(Declaration); startFontClass(yyscanner,"keywordtype"); yyextra->code->codify(QCString(yytext)); endFontClass(yyscanner); } {ATTR_SPEC} { if (QCString(yytext) == "external") { yy_push_state(YY_START,yyscanner); BEGIN(Declaration); yyextra->isExternal = true; } startFontClass(yyscanner,"keywordtype"); yyextra->code->codify(QCString(yytext)); endFontClass(yyscanner); } ({TYPE_SPEC}|{ATTR_SPEC})/[,:( ] { //| variable declaration if (QCString(yytext) == "external") yyextra->isExternal = true; startFontClass(yyscanner,"keywordtype"); yyextra->code->codify(QCString(yytext)); endFontClass(yyscanner); } {ID} { // local var if (yyextra->isFixedForm && yy_my_start == 1) { startFontClass(yyscanner,"comment"); yyextra->code->codify(QCString(yytext)); endFontClass(yyscanner); } else if (yyextra->currentMemberDef && ((yyextra->currentMemberDef->isFunction() && (yyextra->currentMemberDef->typeString()!=QCString("subroutine") || yyextra->inTypeDecl)) || yyextra->currentMemberDef->isVariable() || yyextra->currentMemberDef->isEnumValue() ) ) { generateLink(yyscanner,*yyextra->code, yytext); } else { yyextra->code->codify(QCString(yytext)); addLocalVar(yyscanner,QCString(yytext)); } } {BS}("=>"|"="){BS} { // Procedure binding BEGIN(DeclarationBinding); yyextra->code->codify(QCString(yytext)); } {ID} { // Type bound procedure link generateLink(yyscanner,*yyextra->code, yytext); yy_pop_state(yyscanner); } [(] { // start of array or type / class specification yyextra->bracketCount++; yyextra->code->codify(QCString(yytext)); } [)] { // end array specification yyextra->bracketCount--; if (!yyextra->bracketCount) yyextra->inTypeDecl = 0; yyextra->code->codify(QCString(yytext)); } "&" { // continuation line yyextra->code->codify(QCString(yytext)); if (!yyextra->isFixedForm) { yy_push_state(YY_START,yyscanner); BEGIN(DeclContLine); } } "\n" { // declaration not yet finished yyextra->contLineNr++; codifyLines(yyscanner,yytext); yyextra->bracketCount = 0; yy_pop_state(yyscanner); YY_FTN_RESET } "\n" { // end declaration line (?) if (yyextra->endComment) { yyextra->endComment=FALSE; } else { codifyLines(yyscanner,yytext); } yyextra->bracketCount = 0; yyextra->contLineNr++; if (!(yyextra->hasContLine && yyextra->hasContLine[yyextra->contLineNr - 1])) { yyextra->isExternal = false; yy_pop_state(yyscanner); } YY_FTN_RESET } /*-------- subprog calls -----------------------------------------*/ "call"{BS_} { startFontClass(yyscanner,"keyword"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); yy_push_state(YY_START,yyscanner); BEGIN(SubCall); } {ID} { // subroutine call yyextra->insideBody=TRUE; generateLink(yyscanner,*yyextra->code, yytext); yyextra->insideBody=FALSE; yy_pop_state(yyscanner); } {ID}{BS}/"(" { // function call if (yyextra->isFixedForm && yy_my_start == 6) { // fixed form continuation line YY_FTN_REJECT; } else if (QCString(yytext).stripWhiteSpace().lower() == "type") { yy_push_state(YY_START,yyscanner); BEGIN(Declaration); startFontClass(yyscanner,"keywordtype"); yyextra->code->codify(QCString(yytext).stripWhiteSpace()); endFontClass(yyscanner); yyextra->code->codify(QCString(yytext + 4)); } else { yyextra->insideBody=TRUE; generateLink(yyscanner,*yyextra->code,yytext); yyextra->insideBody=FALSE; } } /*-------- comments ---------------------------------------------------*/ \n?{BS}"!>"|"!<" { // start comment line or comment block if (yytext[0] == '\n') { yyextra->contLineNr++; yy_old_start = 0; yy_my_start = 1; yy_end = static_cast(yyleng); } // Actually we should see if ! on position 6, can be continuation // but the chance is very unlikely, so no effort to solve it here yy_push_state(YY_START,yyscanner); BEGIN(DocBlock); yyextra->docBlock=yytext; } {BS}"!<" { // start comment line or comment block yy_push_state(YY_START,yyscanner); BEGIN(DocBlock); yyextra->docBlock=yytext; } .* { // contents of current comment line yyextra->docBlock+=yytext; } "\n"{BS}("!>"|"!<"|"!!") { // comment block (next line is also comment line) yyextra->contLineNr++; yy_old_start = 0; yy_my_start = 1; yy_end = static_cast(yyleng); // Actually we should see if ! on position 6, can be continuation // but the chance is very unlikely, so no effort to solve it here yyextra->docBlock+=yytext; } "\n" { // comment block ends at the end of this line // remove special comment (default config) yyextra->contLineNr++; if (Config_getBool(STRIP_CODE_COMMENTS)) { yyextra->yyLineNr+=((QCString)yyextra->docBlock).contains('\n'); yyextra->yyLineNr+=1; nextCodeLine(yyscanner); yyextra->endComment=TRUE; } else // do not remove comment { startFontClass(yyscanner,"comment"); codifyLines(yyscanner,yyextra->docBlock); endFontClass(yyscanner); } unput(*yytext); yyextra->contLineNr--; yy_pop_state(yyscanner); YY_FTN_RESET } <*>"!"[^><\n].*|"!"$ { // normal comment if(YY_START == String) YY_FTN_REJECT; // ignore in strings if (yyextra->isFixedForm && yy_my_start == 6) YY_FTN_REJECT; startFontClass(yyscanner,"comment"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } <*>^[Cc*].* { // normal comment if(! yyextra->isFixedForm) YY_FTN_REJECT; startFontClass(yyscanner,"comment"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } <*>"assignment"/{BS}"("{BS}"="{BS}")" { startFontClass(yyscanner,"keyword"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } <*>"operator"/{BS}"("[^)]*")" { startFontClass(yyscanner,"keyword"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); } /*------ preprocessor --------------------------------------------*/ "#".*\n { if (yyextra->isFixedForm && yy_my_start == 6) YY_FTN_REJECT; yyextra->contLineNr++; startFontClass(yyscanner,"preprocessor"); codifyLines(yyscanner,yytext); endFontClass(yyscanner); YY_FTN_RESET } /*------ variable references? -------------------------------------*/ "%"{BS}{ID} { // ignore references to elements yyextra->code->codify(QCString(yytext)); } {ID} { yyextra->insideBody=TRUE; generateLink(yyscanner,*yyextra->code, yytext); yyextra->insideBody=FALSE; } /*------ strings --------------------------------------------------*/ \n { // string with \n inside yyextra->contLineNr++; yyextra->str+=yytext; startFontClass(yyscanner,"stringliteral"); codifyLines(yyscanner,yyextra->str); endFontClass(yyscanner); yyextra->str = ""; YY_FTN_RESET } \"|\' { // string ends with next quote without previous backspace if(yytext[0]!=yyextra->stringStartSymbol) YY_FTN_REJECT; // single vs double quote yyextra->str+=yytext; startFontClass(yyscanner,"stringliteral"); codifyLines(yyscanner,yyextra->str); endFontClass(yyscanner); yy_pop_state(yyscanner); } . {yyextra->str+=yytext;} <*>\"|\' { /* string starts */ /* if(YY_START == StrIgnore) YY_FTN_REJECT; // ignore in simple comments */ if (yyextra->isFixedForm && yy_my_start == 6) YY_FTN_REJECT; yy_push_state(YY_START,yyscanner); yyextra->stringStartSymbol=yytext[0]; // single or double quote BEGIN(String); yyextra->str=yytext; } /*-----------------------------------------------------------------------------*/ <*>\n { if (yyextra->endComment) { yyextra->endComment=FALSE; } else { codifyLines(yyscanner,yytext); // comment cannot extend over the end of a line so should always be terminated at the end of the line. if (yyextra->currentFontClass && !strcmp(yyextra->currentFontClass,"comment")) endFontClass(yyscanner); } yyextra->contLineNr++; YY_FTN_RESET } <*>^{BS}"type"{BS}"=" { yyextra->code->codify(QCString(yytext)); } <*>[\x80-\xFF]* { // keep utf8 characters together... if (yyextra->isFixedForm && yy_my_start > fixedCommentAfter) { startFontClass(yyscanner,"comment"); codifyLines(yyscanner,yytext); } else { yyextra->code->codify(QCString(yytext)); } } <*>. { if (yyextra->isFixedForm && yy_my_start > fixedCommentAfter) { //yy_push_state(YY_START,yyscanner); //BEGIN(DocBlock); //yyextra->docBlock=yytext; startFontClass(yyscanner,"comment"); codifyLines(yyscanner,yytext); } else { yyextra->code->codify(QCString(yytext)); } } <*>{LOG_OPER} { // Fortran logical comparison keywords yyextra->code->codify(QCString(yytext)); } <*><> { if (YY_START == DocBlock) { if (!Config_getBool(STRIP_CODE_COMMENTS)) { startFontClass(yyscanner,"comment"); codifyLines(yyscanner,yyextra->docBlock); endFontClass(yyscanner); } } yyterminate(); } %% /*@ ---------------------------------------------------------------------------- */ static yy_size_t yyread(yyscan_t yyscanner,char *buf,yy_size_t max_size) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; yy_size_t inputPosition = yyextra->inputPosition; const char *s = yyextra->inputString + inputPosition; yy_size_t c=0; while( c < max_size && *s) { *buf++ = *s++; c++; } yyextra->inputPosition += c; return c; } static void endFontClass(yyscan_t yyscanner) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; if (yyextra->currentFontClass) { yyextra->code->endFontClass(); yyextra->currentFontClass=0; } } static void startFontClass(yyscan_t yyscanner,const char *s) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; // if font class is already set don't stop and start it. // strcmp does not like null pointers as input. if (!yyextra->currentFontClass || !s || strcmp(yyextra->currentFontClass,s)) { endFontClass(yyscanner); yyextra->code->startFontClass(QCString(s)); yyextra->currentFontClass=s; } } static void setCurrentDoc(yyscan_t yyscanner,const QCString &anchor) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; if (Doxygen::searchIndex) { if (yyextra->searchCtx) { yyextra->code->setCurrentDoc(yyextra->searchCtx,yyextra->searchCtx->anchor(),FALSE); } else { yyextra->code->setCurrentDoc(yyextra->sourceFileDef,anchor,TRUE); } } } static void addToSearchIndex(yyscan_t yyscanner,const QCString &text) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; if (Doxygen::searchIndex) { yyextra->code->addWord(text,FALSE); } } /*! start a new line of code, inserting a line number if yyextra->sourceFileDef * is TRUE. If a definition starts at the current line, then the line * number is linked to the documentation of that definition. */ static void startCodeLine(yyscan_t yyscanner) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; if (yyextra->sourceFileDef) { //QCString lineNumber,lineAnchor; //lineNumber.sprintf("%05d",yyextra->yyLineNr); //lineAnchor.sprintf("l%05d",yyextra->yyLineNr); const Definition *d = yyextra->sourceFileDef->getSourceDefinition(yyextra->yyLineNr); //printf("startCodeLine %d d=%s\n", yyextra->yyLineNr,d ? qPrint(d->name()) : ""); if (!yyextra->includeCodeFragment && d) { yyextra->currentDefinition = d; yyextra->currentMemberDef = yyextra->sourceFileDef->getSourceMember(yyextra->yyLineNr); yyextra->insideBody = FALSE; yyextra->endComment = FALSE; QCString lineAnchor; lineAnchor.sprintf("l%05d",yyextra->yyLineNr); if (yyextra->currentMemberDef) { yyextra->code->writeLineNumber(yyextra->currentMemberDef->getReference(), yyextra->currentMemberDef->getOutputFileBase(), yyextra->currentMemberDef->anchor(),yyextra->yyLineNr); setCurrentDoc(yyscanner,lineAnchor); } else if (d->isLinkableInProject()) { yyextra->code->writeLineNumber(d->getReference(), d->getOutputFileBase(), QCString(),yyextra->yyLineNr); setCurrentDoc(yyscanner,lineAnchor); } } else { yyextra->code->writeLineNumber(QCString(),QCString(),QCString(),yyextra->yyLineNr); } } yyextra->code->startCodeLine(yyextra->sourceFileDef); if (yyextra->currentFontClass) { yyextra->code->startFontClass(QCString(yyextra->currentFontClass)); } } static void endCodeLine(yyscan_t yyscanner) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; endFontClass(yyscanner); yyextra->code->endCodeLine(); } static void nextCodeLine(yyscan_t yyscanner) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; const char * fc = yyextra->currentFontClass; endCodeLine(yyscanner); if (yyextra->yyLineNrinputLines) { yyextra->currentFontClass = fc; startCodeLine(yyscanner); } } /*! write a code fragment 'text' that may span multiple lines, inserting * line numbers for each line. */ static void codifyLines(yyscan_t yyscanner,const QCString &text) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; //printf("codifyLines(%d,\"%s\")\n",yyextra->yyLineNr,text); if (text.isEmpty()) return; const char *p=text.data(),*sp=p; char c; bool done=FALSE; while (!done) { sp=p; while ((c=*p++) && c!='\n') { } if (c=='\n') { yyextra->yyLineNr++; int l = (int)(p-sp-1); char *tmp = (char*)malloc(l+1); memcpy(tmp,sp,l); tmp[l]='\0'; yyextra->code->codify(QCString(tmp)); free(tmp); nextCodeLine(yyscanner); } else { yyextra->code->codify(QCString(sp)); done=TRUE; } } } /*! writes a link to a fragment \a text that may span multiple lines, inserting * line numbers for each line. If \a text contains newlines, the link will be * split into multiple links with the same destination, one for each line. */ static void writeMultiLineCodeLink(yyscan_t yyscanner,CodeOutputInterface &ol, Definition *d,const QCString &text) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; static bool sourceTooltips = Config_getBool(SOURCE_TOOLTIPS); TooltipManager::instance().addTooltip(ol,d); QCString ref = d->getReference(); QCString file = d->getOutputFileBase(); QCString anchor = d->anchor(); QCString tooltip; if (!sourceTooltips) // fall back to simple "title" tooltips { tooltip = d->briefDescriptionAsTooltip(); } bool done=FALSE; const char *p=text.data(); while (!done) { const char *sp=p; char c; while ((c=*p++) && c!='\n') { } if (c=='\n') { yyextra->yyLineNr++; //printf("writeCodeLink(%s,%s,%s,%s)\n",ref,file,anchor,sp); ol.writeCodeLink(ref,file,anchor,QCString(sp,p-sp-1),tooltip); nextCodeLine(yyscanner); } else { //printf("writeCodeLink(%s,%s,%s,%s)\n",ref,file,anchor,sp); ol.writeCodeLink(ref,file,anchor,sp,tooltip); done=TRUE; } } } //------------------------------------------------------------------------------- /** searches for definition of a module (Namespace) @param mname the name of the module @param cd the entry, if found or null @returns true, if module is found */ static bool getFortranNamespaceDefs(const QCString &mname, NamespaceDef *&cd) { if (mname.isEmpty()) return FALSE; /* empty name => nothing to link */ // search for module if ((cd=Doxygen::namespaceLinkedMap->find(mname))) return TRUE; return FALSE; } //------------------------------------------------------------------------------- /** searches for definition of a type @param tname the name of the type @param moduleName name of enclosing module or null, if global entry @param cd the entry, if found or null @param useMap map of data of USE-statement @returns true, if type is found */ static bool getFortranTypeDefs(const QCString &tname, const QCString &moduleName, ClassDef *&cd, const UseMap &useMap) { if (tname.isEmpty()) return FALSE; /* empty name => nothing to link */ //cout << "=== search for type: " << tname << endl; // search for type if ((cd=Doxygen::classLinkedMap->find(tname))) { //cout << "=== type found in global module" << endl; return TRUE; } else if (!moduleName.isEmpty() && (cd= Doxygen::classLinkedMap->find(moduleName+"::"+tname))) { //cout << "=== type found in local module" << endl; return TRUE; } else { for (const auto &kv : useMap) { if ((cd= Doxygen::classLinkedMap->find(kv.second.module+"::"+tname))) { //cout << "=== type found in used module" << endl; return TRUE; } } } return FALSE; } /** searches for definition of function memberName @param yyscanner the scanner data to be used @param memberName the name of the function/variable @param moduleName name of enclosing module or null, if global entry @param useMap map of data of USE-statement @returns MemberDef pointer, if found, or nullptr otherwise */ static MemberDef *getFortranDefs(yyscan_t yyscanner,const QCString &memberName, const QCString &moduleName, const UseMap &useMap) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; if (memberName.isEmpty()) return nullptr; /* empty name => nothing to link */ // look in local variables for (auto it = yyextra->scopeStack.rbegin(); it!=yyextra->scopeStack.rend(); ++it) { const Scope &scope = *it; std::string lowMemName = memberName.lower().str(); if (scope.localVars .find(lowMemName)!=std::end(scope.localVars) && // local var scope.externalVars.find(lowMemName)==std::end(scope.externalVars)) // and not external { return nullptr; } } // search for function MemberName *mn = Doxygen::functionNameLinkedMap->find(memberName); if (!mn) { mn = Doxygen::memberNameLinkedMap->find(memberName); } if (mn) // name is known { // all found functions with given name for (const auto &md : *mn) { const FileDef *fd=md->getFileDef(); const GroupDef *gd=md->getGroupDef(); const ClassDef *cd=md->getClassDef(); //cout << "found link with same name: " << fd->fileName() << " " << memberName; //if (md->getNamespaceDef() != 0) cout << " in namespace " << md->getNamespaceDef()->name();cout << endl; if ((gd && gd->isLinkable()) || (fd && fd->isLinkable())) { const NamespaceDef *nspace= md->getNamespaceDef(); if (nspace == 0) { // found function in global scope if(cd == 0) { // Skip if bound to type return md.get(); } } else if (moduleName == nspace->name()) { // found in local scope return md.get(); } else { // else search in used modules QCString usedModuleName= nspace->name(); auto use_it = useMap.find(usedModuleName.str()); if (use_it!=useMap.end()) { const UseEntry &ue = use_it->second; // check if only-list exists and if current entry exists is this list if (ue.onlyNames.empty()) { //cout << " found in module " << usedModuleName << " entry " << memberName << endl; return md.get(); // whole module used } else { for ( const auto &name : ue.onlyNames) { //cout << " search in only: " << usedModuleName << ":: " << memberName << "==" << (*it)<< endl; if (memberName == name) { return md.get(); // found in ONLY-part of use list } } } } } } // if linkable } // for } return nullptr; } /** gets the link to a generic procedure which depends not on the name, but on the parameter list @todo implementation */ static bool getGenericProcedureLink(yyscan_t yyscanner,const ClassDef *cd, const QCString &memberText, CodeOutputInterface &ol) { (void)cd; (void)memberText; (void)ol; return FALSE; } static bool getLink(yyscan_t yyscanner,const UseMap &useMap, // dictionary with used modules const QCString &memberText, // exact member text CodeOutputInterface &ol, const QCString &text) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; MemberDef *md=0; QCString memberName= removeRedundantWhiteSpace(memberText); if ((md=getFortranDefs(yyscanner,memberName, yyextra->currentModule, useMap)) && md->isLinkable()) { if (md->isVariable() && (md->getLanguage()!=SrcLangExt_Fortran)) return FALSE; // Non Fortran variables aren't handled yet, // see also linkifyText in util.cpp const Definition *d = md->getOuterScope()==Doxygen::globalScope ? md->getBodyDef() : md->getOuterScope(); if (md->getGroupDef()) d = md->getGroupDef(); if (d && d->isLinkable()) { if (yyextra->currentDefinition && yyextra->currentMemberDef && md!=yyextra->currentMemberDef && yyextra->insideBody && yyextra->collectXRefs) { std::lock_guard lock(g_docCrossReferenceMutex); addDocCrossReference(toMemberDefMutable(yyextra->currentMemberDef),toMemberDefMutable(md)); } writeMultiLineCodeLink(yyscanner,ol,md,!text.isEmpty() ? text : memberText); addToSearchIndex(yyscanner, !text.isEmpty() ? text : memberText); return TRUE; } } return FALSE; } static void generateLink(yyscan_t yyscanner,CodeOutputInterface &ol, const QCString &lname) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; ClassDef *cd=0; NamespaceDef *nsd=0; QCString name = lname; name = removeRedundantWhiteSpace(name.lower()); // check if lowercase lname is a linkable type or interface if ( (getFortranTypeDefs(name, yyextra->currentModule, cd, yyextra->useMembers)) && cd->isLinkable() ) { if ( (cd->compoundType() == ClassDef::Class) && // was Entry::INTERFACE_SEC) && (getGenericProcedureLink(yyscanner, cd, name, ol)) ) { //cout << "=== generic procedure resolved" << endl; } else { // write type or interface link writeMultiLineCodeLink(yyscanner, ol,cd,name); addToSearchIndex(yyscanner, name); } } // check for module else if ( (getFortranNamespaceDefs(name, nsd)) && nsd->isLinkable() ) { // write module link writeMultiLineCodeLink(yyscanner,ol,nsd,name); addToSearchIndex(yyscanner,name); } // check for function/variable else if (getLink(yyscanner,yyextra->useMembers, name, ol, name)) { //cout << "=== found link for lowercase " << lname << endl; } else { // nothing found, just write out the word //startFontClass("charliteral"); //test codifyLines(yyscanner,name); //endFontClass(yyscanner); //test addToSearchIndex(yyscanner,name); } } static void generateLink(yyscan_t yyscanner,CodeOutputInterface &ol, const char *lname) { generateLink(yyscanner,ol,QCString(lname)); } /*! counts the number of lines in the input */ static int countLines(yyscan_t yyscanner) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; const char *p=yyextra->inputString; char c; int count=1; while ((c=*p)) { p++ ; if (c=='\n') count++; } if (p>yyextra->inputString && *(p-1)!='\n') { // last line does not end with a \n, so we add an extra // line and explicitly terminate the line after parsing. count++, yyextra->needsTermination=TRUE; } return count; } //---------------------------------------------------------------------------- /** start scope */ static void startScope(yyscan_t yyscanner) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; DBG_CTX((stderr, "===> startScope %s",yytext)); yyextra->scopeStack.push_back(Scope()); } /** end scope */ static void endScope(yyscan_t yyscanner) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; DBG_CTX((stderr,"===> endScope %s",yytext)); if (yyextra->scopeStack.empty()) { DBG_CTX((stderr,"WARNING: fortrancode.l: stack empty!\n")); return; } Scope &scope = yyextra->scopeStack.back(); for ( const auto &name : scope.useNames) { yyextra->useMembers.erase(name.str()); } yyextra->scopeStack.pop_back(); } static void addUse(yyscan_t yyscanner,const QCString &moduleName) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; if (!yyextra->scopeStack.empty()) yyextra->scopeStack.back().useNames.push_back(moduleName); } static void addLocalVar(yyscan_t yyscanner,const QCString &varName) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; if (!yyextra->scopeStack.empty()) { std::string lowVarName = varName.lower().str(); yyextra->scopeStack.back().localVars.insert(lowVarName); if (yyextra->isExternal) yyextra->scopeStack.back().externalVars.insert(lowVarName); } } /*===================================================================*/ static void checkContLines(yyscan_t yyscanner,const char *s) { struct yyguts_t *yyg = (struct yyguts_t*)yyscanner; int numLines = 0; int i = 0; const char *p = s; numLines = 2; // one for element 0, one in case no \n at end while (*p) { if (*p == '\n') numLines++; p++; } yyextra->hasContLine = (int *) malloc((numLines) * sizeof(int)); for (i = 0; i < numLines; i++) yyextra->hasContLine[i] = 0; p = prepassFixedForm(s, yyextra->hasContLine); yyextra->hasContLine[0] = 0; } void parseFortranCode(CodeOutputInterface &od,const char *,const QCString &s, bool exBlock, const char *exName,FileDef *fd, int startLine,int endLine,bool inlineFragment, const MemberDef *,bool,const Definition *searchCtx, bool collectXRefs, FortranFormat format) { //printf("***parseCode() exBlock=%d exName=%s fd=%p\n",exBlock,exName,fd); return; } //--------------------------------------------------------- struct FortranCodeParser::Private { yyscan_t yyscanner; fortrancodeYY_state state; FortranFormat format; }; FortranCodeParser::FortranCodeParser(FortranFormat format) : p(std::make_unique()) { p->format = format; fortrancodeYYlex_init_extra(&p->state,&p->yyscanner); #ifdef FLEX_DEBUG fortrancodeYYset_debug(1,p->yyscanner); #endif resetCodeParserState(); } FortranCodeParser::~FortranCodeParser() { fortrancodeYYlex_destroy(p->yyscanner); } void FortranCodeParser::resetCodeParserState() { struct yyguts_t *yyg = (struct yyguts_t*)p->yyscanner; yyextra->currentDefinition = 0; yyextra->currentMemberDef = 0; yyextra->currentFontClass = 0; yyextra->needsTermination = FALSE; BEGIN( Start ); } void FortranCodeParser::parseCode(CodeOutputInterface & codeOutIntf, const QCString & scopeName, const QCString & input, SrcLangExt /*lang*/, bool isExampleBlock, const QCString & exampleName, FileDef * fileDef, int startLine, int endLine, bool inlineFragment, const MemberDef *memberDef, bool showLineNumbers, const Definition *searchCtx, bool collectXRefs ) { yyscan_t yyscanner = p->yyscanner; struct yyguts_t *yyg = (struct yyguts_t*)p->yyscanner; //::parseFortranCode(codeOutIntf,scopeName,input,isExampleBlock,exampleName, // fileDef,startLine,endLine,inlineFragment,memberDef, // showLineNumbers,searchCtx,collectXRefs,m_format); // parseFortranCode(CodeOutputInterface &od,const char *,const QCString &s, // bool exBlock, const char *exName,FileDef *fd, // int startLine,int endLine,bool inlineFragment, // const MemberDef *,bool,const Definition *searchCtx, // bool collectXRefs, FortranFormat format) if (input.isEmpty()) return; printlex(yy_flex_debug, TRUE, __FILE__, fileDef ? qPrint(fileDef->fileName()): NULL); yyextra->code = &codeOutIntf; yyextra->inputString = input.data(); yyextra->inputPosition = 0; yyextra->isFixedForm = recognizeFixedForm(input,p->format); yyextra->contLineNr = 1; yyextra->hasContLine = NULL; if (yyextra->isFixedForm) { checkContLines(yyscanner,yyextra->inputString); } yyextra->currentFontClass = 0; yyextra->needsTermination = FALSE; yyextra->searchCtx = searchCtx; yyextra->collectXRefs = collectXRefs; if (startLine!=-1) yyextra->yyLineNr = startLine; else yyextra->yyLineNr = 1; if (endLine!=-1) yyextra->inputLines = endLine+1; else yyextra->inputLines = yyextra->yyLineNr + countLines(yyscanner) - 1; yyextra->exampleBlock = isExampleBlock; yyextra->exampleName = exampleName; yyextra->sourceFileDef = fileDef; if (isExampleBlock && fileDef==0) { // create a dummy filedef for the example yyextra->sourceFileDef = createFileDef(QCString(),exampleName); } if (yyextra->sourceFileDef) { setCurrentDoc(yyscanner,QCString("l00001")); } yyextra->currentDefinition = 0; yyextra->currentMemberDef = 0; if (!yyextra->exampleName.isEmpty()) { yyextra->exampleFile = convertNameToFile(yyextra->exampleName+"-example"); } yyextra->includeCodeFragment = inlineFragment; startCodeLine(yyscanner); fortrancodeYYrestart(0, yyscanner); BEGIN( Start ); fortrancodeYYlex(yyscanner); if (yyextra->needsTermination) { endFontClass(yyscanner); yyextra->code->endCodeLine(); } if (isExampleBlock && yyextra->sourceFileDef) { // delete the temporary file definition used for this example delete yyextra->sourceFileDef; yyextra->sourceFileDef=0; } if (yyextra->hasContLine) free(yyextra->hasContLine); yyextra->hasContLine = NULL; // write the tooltips TooltipManager::instance().writeTooltips(codeOutIntf); printlex(yy_flex_debug, FALSE, __FILE__, fileDef ? qPrint(fileDef->fileName()): NULL); } //--------------------------------------------------------- #if USE_STATE2STRING #include "fortrancode.l.h" #endif