From 5f11678370f55e491fa9a04b7fd03cd473f8982f Mon Sep 17 00:00:00 2001 From: albert-github Date: Mon, 12 Feb 2018 19:07:18 +0100 Subject: Fortran improvements - adding NON_RECURSIVE - better handling of missing PROGRAM in case of following module / subroutine in same file - ignore (numeric)-labels in fixed source form - adding support for - TYPE IS - CLASS IS - CLASS DEFAULT --- src/fortrancode.l | 4 ++-- src/fortranscanner.l | 44 ++++++++++++++++++++++++++++++++++++-------- 2 files changed, 38 insertions(+), 10 deletions(-) diff --git a/src/fortrancode.l b/src/fortrancode.l index 501b492..7040bbf 100644 --- a/src/fortrancode.l +++ b/src/fortrancode.l @@ -687,14 +687,14 @@ 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|CONTIGUOUS|VOLATILE) +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 (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|IMPURE|PURE|ELEMENTAL)? +PREFIX ((NON_)?RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,4}((NON_)?RECURSIVE|IMPURE|PURE|ELEMENTAL)? /* | */ diff --git a/src/fortranscanner.l b/src/fortranscanner.l index 85b6de9..0548cc3 100644 --- a/src/fortranscanner.l +++ b/src/fortranscanner.l @@ -198,6 +198,8 @@ static SymbolModifiers currentModifiers; //! Holds program scope->symbol name->symbol modifiers. static QMap > modifiers; +static Entry *global_scope = NULL; + //----------------------------------------------------------------------------- static int yyread(char *buf,int max_size); @@ -248,6 +250,7 @@ SUBPROG (subroutine|function) B [ \t] BS [ \t]* BS_ [ \t]+ +BT_ ([ \t]+|[ \t]*"(") COMMA {BS},{BS} ARGS_L0 ("("[^)]*")") ARGS_L1a [^()]*"("[^)]*")"[^)]* @@ -271,7 +274,7 @@ ATTR_STMT {ATTR_SPEC}|DIMENSION|{ACCESS_SPEC} EXTERNAL_STMT (EXTERNAL) CONTAINS CONTAINS -PREFIX (RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,3}(RECURSIVE|IMPURE|PURE|ELEMENTAL)? +PREFIX ((NON_)?RECURSIVE{BS_}|IMPURE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,4}((NON_)?RECURSIVE|IMPURE|PURE|ELEMENTAL)? SCOPENAME ({ID}{BS}"::"{BS})* %option noyywrap @@ -558,7 +561,18 @@ SCOPENAME ({ID}{BS}"::"{BS})* if (!endScope(current_root)) yyterminate(); defaultProtection = Public; - yy_pop_state(); + if (global_scope) + { + if (global_scope != (Entry *) -1) + yy_push_state(Start); + else + yy_pop_state(); // cannot pop artrificial entry + } + else + { + yy_push_state(Start); + global_scope = (Entry *)-1; // signal that the global_scope has already been used. + } } {ID} { addModule(yytext, TRUE); @@ -773,8 +787,10 @@ private { } {ID} { } -^{BS}"type"{BS_}"is"/{BS_} { } +^{BS}"type"{BS_}"is"/{BT_} { } ^{BS}"type"{BS}"=" { } +^{BS}"class"{BS_}"is"/{BT_} { } +^{BS}"class"{BS_}"default" { } } { {COMMA} {} @@ -1098,7 +1114,6 @@ private { yy_push_state(YY_START); BEGIN(StrIgnore); debugStr="*!"; - //fprintf(stderr,"start comment %d\n",yyLineNr); } } } @@ -1552,7 +1567,10 @@ const char* prepassFixedForm(const char* contents, int *hasContLine) } // fallthrough default: - if(column==6 && emptyLabel) { // continuation + if ((column < 6) && ((c - '0') >= 0) && ((c - '0') <= 9)) { // remove numbers, i.e. labels from first 5 positions. + newContents[j]=' '; + } + else if(column==6 && emptyLabel) { // continuation if (!commented) fullCommentLine=FALSE; if (c != '0') { // 0 not allowed as continuation character, see f95 standard paragraph 3.3.2.3 newContents[j]=' '; @@ -2017,14 +2035,23 @@ static void startScope(Entry *scope) */ static bool endScope(Entry *scope, bool isGlobalRoot) { + if (global_scope == scope) + { + global_scope = NULL; + return TRUE; + } + if (global_scope == (Entry *) -1) + { + return TRUE; + } //cout<<"end scope: "<name<parent() || isGlobalRoot) { current_root= current_root->parent(); /* end substructure */ } - else + else // if (current_root != scope) { - fprintf(stderr,"parse error in end "); + fprintf(stderr,"parse error in end \n"); scanner_abort(); return FALSE; } @@ -2558,6 +2585,7 @@ static void parseMain(const char *fileName,const char *fileBuf,Entry *rt, Fortra yyFileName = fileName; msg("Parsing file %s...\n",yyFileName.data()); + global_scope = rt; startScope(rt); // implies current_root = rt initParser(); groupEnterFile(yyFileName,yyLineNr); @@ -2579,7 +2607,7 @@ static void parseMain(const char *fileName,const char *fileBuf,Entry *rt, Fortra fortranscannerYYlex(); groupLeaveFile(yyFileName,yyLineNr); - endScope(current_root, TRUE); // TRUE - global root + if (global_scope && global_scope != (Entry *) -1) endScope(current_root, TRUE); // TRUE - global root //debugCompounds(rt); //debug -- cgit v0.12