summaryrefslogtreecommitdiffstats
path: root/src/fortrancode.l
diff options
context:
space:
mode:
Diffstat (limited to 'src/fortrancode.l')
-rw-r--r--src/fortrancode.l100
1 files changed, 81 insertions, 19 deletions
diff --git a/src/fortrancode.l b/src/fortrancode.l
index 03baeed..51934cd 100644
--- a/src/fortrancode.l
+++ b/src/fortrancode.l
@@ -114,6 +114,7 @@ class Scope
static QCString docBlock; //!< contents of all lines of a documentation block
static QCString currentModule=0; //!< name of the current enclosing module
+static QCString currentClass=0; //!< name of the current enclosing class
static UseSDict *useMembers= new UseSDict; //!< info about used modules
static UseEntry *useEntry = 0; //!< current use statement info
static QList<Scope> scopeStack;
@@ -386,8 +387,23 @@ static void writeMultiLineCodeLink(CodeOutputInterface &ol,
}
}
}
+//-------------------------------------------------------------------------------
+/**
+ 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::namespaceSDict->find(mname))) return TRUE;
+ return FALSE;
+}
//-------------------------------------------------------------------------------
/**
searches for definition of a type
@@ -467,6 +483,7 @@ static bool getFortranDefs(const QCString &memberName, const QCString &moduleNam
{
FileDef *fd=md->getFileDef();
GroupDef *gd=md->getGroupDef();
+ 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;
@@ -477,7 +494,9 @@ static bool getFortranDefs(const QCString &memberName, const QCString &moduleNam
if (nspace == 0)
{ // found function in global scope
- return TRUE;
+ if(cd == 0) { // Skip if bound to type
+ return TRUE;
+ }
}
else if (moduleName == nspace->name())
{ // found in local scope
@@ -534,7 +553,7 @@ static bool getLink(UseSDict *usedict, // dictonary with used modules
CodeOutputInterface &ol,
const char *text)
{
- MemberDef *md;
+ MemberDef *md=0;
QCString memberName= removeRedundantWhiteSpace(memberText);
if (getFortranDefs(memberName, currentModule, md, usedict) && md->isLinkable())
@@ -563,6 +582,7 @@ static bool getLink(UseSDict *usedict, // dictonary with used modules
static void generateLink(CodeOutputInterface &ol, char *lname)
{
ClassDef *cd=0;
+ NamespaceDef *nsd=0;
QCString tmp = lname;
tmp = removeRedundantWhiteSpace(tmp.lower());
@@ -580,6 +600,12 @@ static void generateLink(CodeOutputInterface &ol, char *lname)
addToSearchIndex(tmp.data());
}
}
+ // check for module
+ else if ( (getFortranNamespaceDefs(tmp, nsd)) && nsd->isLinkable() )
+ { // write module link
+ writeMultiLineCodeLink(ol,nsd,tmp);
+ addToSearchIndex(tmp.data());
+ }
// check for function/variable
else if (getLink(useMembers, tmp, ol, tmp))
{
@@ -694,7 +720,7 @@ 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)
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|RECURSIVE|PURE|IMPURE|ELEMENTAL|VALUE|NOPASS|DEFERRED)
+ATTR_SPEC (IMPLICIT|ALLOCATABLE|DIMENSION{ARGS}|EXTERNAL|{INTENT_SPEC}|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PROTECTED|PRIVATE|PUBLIC|SAVE|TARGET|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
@@ -721,6 +747,7 @@ PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|I
%x UseOnly
%x Import
%x Declaration
+%x DeclarationBinding
%x DeclContLine
%x Parameterlist
%x String
@@ -731,8 +758,8 @@ PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|I
/*-------- ignore ------------------------------------------------------------*/
-<Start>{IGNORE}/{BS}"("? { // do not search keywords, intrinsics... TODO: complete list
- codifyLines(yytext);
+<Start>{IGNORE}/{BS}"(" { // do not search keywords, intrinsics... TODO: complete list
+ codifyLines(yytext);
}
/*-------- inner construct ---------------------------------------------------*/
@@ -757,12 +784,11 @@ PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|I
codifyLines(yytext);
endFontClass();
}
-<Start>"end"({BS}{FLOW})?/[ \t\n] { // list is a bit long as not all have possible end
+<Start>{BS}"end"({BS}{FLOW})/[ \t\n] { // list is a bit long as not all have possible end
startFontClass("keywordflow");
codifyLines(yytext);
endFontClass();
}
-
<Start>"implicit"{BS}"none" {
startFontClass("keywordtype");
codifyLines(yytext);
@@ -807,10 +833,12 @@ PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|I
<UseOnly,Import>{BS},{BS} { codifyLines(yytext); }
<UseOnly,Import>{BS}&{BS}"\n" { codifyLines(yytext); YY_FTN_RESET}
<UseOnly>{ID} {
+ QCString tmp = yytext;
+ tmp = tmp.lower();
+ useEntry->onlyNames.append(tmp);
g_insideBody=TRUE;
generateLink(*g_code, yytext);
g_insideBody=FALSE;
- useEntry->onlyNames.append(yytext);
}
<Use,UseOnly,Import>"\n" {
unput(*yytext);
@@ -845,6 +873,7 @@ PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|I
endFontClass();
yy_push_state(YY_START);
BEGIN(ClassName);
+ currentClass="class";
}
<ClassName>{ID} {
if (currentModule == "module")
@@ -864,7 +893,11 @@ PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|I
yy_pop_state();
YY_FTN_REJECT;
}
-<Start>"end"({BS_}"module").* { // just reset currentModule, rest is done in following rule
+<Start>^{BS}"end"({BS_}"type").* { // just reset currentClass, rest is done in following rule
+ currentClass=0;
+ YY_FTN_REJECT;
+ }
+<Start>^{BS}"end"({BS_}"module").* { // just reset currentModule, rest is done in following rule
currentModule=0;
YY_FTN_REJECT;
}
@@ -893,7 +926,7 @@ PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|I
yy_pop_state();
YY_FTN_RESET
}
-<Start>^{BS}"end"{BS}("block"{BS}"data"|{SUBPROG}|"module"|"program"|"type"|"interface"){BS} { // Fortran subroutine or function ends
+<Start>^{BS}"end"{BS}("block"{BS}"data"|{SUBPROG}|"module"|"program"|"type"|"interface")?{BS} { // Fortran subroutine or function ends
//cout << "===> end function " << yytext << endl;
endScope();
startFontClass("keyword");
@@ -942,6 +975,14 @@ PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|I
generateLink(*g_code, yytext);
}
}
+<Declaration>{BS}("=>"|"="){BS} { // Procedure binding
+ BEGIN(DeclarationBinding);
+ g_code->codify(yytext);
+ }
+<DeclarationBinding>{ID} { // Type bound procedure link
+ generateLink(*g_code, yytext);
+ yy_pop_state();
+ }
<Declaration>[(] { // start of array specification
bracketCount++;
g_code->codify(yytext);
@@ -952,7 +993,7 @@ PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|I
g_code->codify(yytext);
}
-<Declaration>"&" { // continuation line
+<Declaration,DeclarationBinding>"&" { // continuation line
g_code->codify(yytext);
yy_push_state(YY_START);
BEGIN(DeclContLine);
@@ -963,7 +1004,7 @@ PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|I
yy_pop_state();
YY_FTN_RESET
}
-<Declaration>"\n" { // end declaration line
+<Declaration,DeclarationBinding>"\n" { // end declaration line
if (g_endComment)
{
g_endComment=FALSE;
@@ -980,9 +1021,11 @@ PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|I
/*-------- subprog calls -----------------------------------------*/
<Start>"call"{BS_} {
- codifyLines(yytext);
+ startFontClass("keyword");
+ codifyLines(yytext);
+ endFontClass();
yy_push_state(YY_START);
- BEGIN(SubCall);
+ BEGIN(SubCall);
}
<SubCall>{ID} { // subroutine call
g_insideBody=TRUE;
@@ -991,13 +1034,21 @@ PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|I
yy_pop_state();
}
<Start>{ID}{BS}/"(" { // function call
- g_insideBody=TRUE;
- generateLink(*g_code, yytext);
- g_insideBody=FALSE;
+ if (g_isFixedForm && yy_my_start == 6)
+ {
+ // fixed form continuation line
+ YY_FTN_REJECT;
+ }
+ else
+ {
+ g_insideBody=TRUE;
+ generateLink(*g_code, yytext);
+ g_insideBody=FALSE;
+ }
}
/*-------- comments ---------------------------------------------------*/
-<Start>\n?{BS}"!>"|"!<" { // start comment line or comment block
+<Start,Declaration,DeclarationBinding>\n?{BS}"!>"|"!<" { // start comment line or comment block
if (yytext[0] == '\n')
{
yy_old_start = 0;
@@ -1010,7 +1061,7 @@ PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|I
BEGIN(DocBlock);
docBlock=yytext;
}
-<Declaration>{BS}"!<" { // start comment line or comment block
+<Declaration,DeclarationBinding>{BS}"!<" { // start comment line or comment block
yy_push_state(YY_START);
BEGIN(DocBlock);
docBlock=yytext;
@@ -1136,6 +1187,17 @@ PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|I
<*>{LOG_OPER} { // Fortran logical comparison keywords
g_code->codify(yytext);
}
+<*><<EOF>> {
+ if (YY_START == DocBlock) {
+ if (!Config_getBool("STRIP_CODE_COMMENTS"))
+ {
+ startFontClass("comment");
+ codifyLines(docBlock);
+ endFontClass();
+ }
+ }
+ yyterminate();
+ }
%%
/*@ ----------------------------------------------------------------------------
generated by cgit v0.12 at 2025-01-24 01:48:40 (GMT)