[geany/geany] a99677: Use the upstream Fortran parser

Jiří Techet git-noreply at geany.org
Fri May 13 00:15:57 UTC 2022


Branch:      refs/heads/master
Author:      Jiří Techet <techet at gmail.com>
Committer:   Jiří Techet <techet at gmail.com>
Date:        Fri, 13 May 2022 00:15:57 UTC
Commit:      a99677f220676d27e8f01278c31b9954b1d744a6
             https://github.com/geany/geany/commit/a99677f220676d27e8f01278c31b9954b1d744a6

Log Message:
-----------
Use the upstream Fortran parser


Modified Paths:
--------------
    ctags/Makefile.am
    ctags/parsers/fortran.c
    meson.build
    src/filetypes.c
    src/tagmanager/tm_ctags.c
    src/tagmanager/tm_parser.c
    src/tagmanager/tm_parser.h
    src/tagmanager/tm_parsers.h

Modified: ctags/Makefile.am
2 lines changed, 1 insertions(+), 1 deletions(-)
===================================================================
@@ -58,7 +58,7 @@ parsers = \
 	parsers/geany_docbook.c \
 	parsers/erlang.c \
 	parsers/flex.c \
-	parsers/geany_fortran.c \
+	parsers/fortran.c \
 	parsers/gdscript.c \
 	parsers/go.c \
 	parsers/haskell.c \


Modified: ctags/parsers/fortran.c
738 lines changed, 538 insertions(+), 200 deletions(-)
===================================================================
@@ -16,10 +16,8 @@
 #include <string.h>
 #include <limits.h>
 #include <ctype.h>  /* to define tolower () */
-#include <setjmp.h>
 
 #include "debug.h"
-#include "mio.h"
 #include "entry.h"
 #include "keyword.h"
 #include "options.h"
@@ -42,11 +40,6 @@
 /*
 *   DATA DECLARATIONS
 */
-
-typedef enum eException {
-	ExceptionNone, ExceptionEOF, ExceptionFixedFormat, ExceptionLoop
-} exception_t;
-
 /*  Used to designate type of line read in fixed source form.
  */
 typedef enum eFortranLineType {
@@ -62,6 +55,7 @@ typedef enum eFortranLineType {
 /*  Used to specify type of keyword.
  */
 enum eKeywordId {
+	KEYWORD_abstract,
 	KEYWORD_allocatable,
 	KEYWORD_assignment,
 	KEYWORD_associate,
@@ -71,12 +65,14 @@ enum eKeywordId {
 	KEYWORD_byte,
 	KEYWORD_cexternal,
 	KEYWORD_cglobal,
+	KEYWORD_class,
 	KEYWORD_character,
 	KEYWORD_codimension,
 	KEYWORD_common,
 	KEYWORD_complex,
 	KEYWORD_contains,
 	KEYWORD_data,
+	KEYWORD_deferred,
 	KEYWORD_dimension,
 	KEYWORD_dllexport,
 	KEYWORD_dllimport,
@@ -90,11 +86,14 @@ enum eKeywordId {
 	KEYWORD_equivalence,
 	KEYWORD_extends,
 	KEYWORD_external,
+	KEYWORD_final,
 	KEYWORD_forall,
 	KEYWORD_format,
 	KEYWORD_function,
+	KEYWORD_generic,
 	KEYWORD_if,
 	KEYWORD_implicit,
+	KEYWORD_import,
 	KEYWORD_include,
 	KEYWORD_inline,
 	KEYWORD_integer,
@@ -107,17 +106,21 @@ enum eKeywordId {
 	KEYWORD_map,
 	KEYWORD_module,
 	KEYWORD_namelist,
+	KEYWORD_non_overridable,
+	KEYWORD_nopass,
 	KEYWORD_operator,
 	KEYWORD_optional,
 	KEYWORD_parameter,
 	KEYWORD_pascal,
+	KEYWORD_pass,
 	KEYWORD_pexternal,
 	KEYWORD_pglobal,
 	KEYWORD_pointer,
 	KEYWORD_precision,
 	KEYWORD_private,
 	KEYWORD_procedure,
 	KEYWORD_program,
+	KEYWORD_protected,
 	KEYWORD_public,
 	KEYWORD_pure,
 	KEYWORD_real,
@@ -129,6 +132,7 @@ enum eKeywordId {
 	KEYWORD_static,
 	KEYWORD_stdcall,
 	KEYWORD_structure,
+	KEYWORD_submodule,
 	KEYWORD_subroutine,
 	KEYWORD_target,
 	KEYWORD_then,
@@ -145,6 +149,7 @@ typedef int keywordId; /* to allow KEYWORD_NONE */
 
 typedef enum eTokenType {
 	TOKEN_UNDEFINED,
+	TOKEN_EOF,
 	TOKEN_COMMA,
 	TOKEN_DOUBLE_COLON,
 	TOKEN_IDENTIFIER,
@@ -154,39 +159,55 @@ typedef enum eTokenType {
 	TOKEN_OPERATOR,
 	TOKEN_PAREN_CLOSE,
 	TOKEN_PAREN_OPEN,
-	TOKEN_SQUARE_CLOSE,
 	TOKEN_SQUARE_OPEN,
+	TOKEN_SQUARE_CLOSE,
 	TOKEN_PERCENT,
 	TOKEN_STATEMENT_END,
-	TOKEN_STRING
+	TOKEN_STRING,
+	TOKEN_COLON,
 } tokenType;
 
 typedef enum eTagType {
 	TAG_UNDEFINED = -1,
 	TAG_BLOCK_DATA,
 	TAG_COMMON_BLOCK,
 	TAG_ENTRY_POINT,
+	TAG_ENUM,
 	TAG_FUNCTION,
 	TAG_INTERFACE,
 	TAG_COMPONENT,
 	TAG_LABEL,
 	TAG_LOCAL,
 	TAG_MODULE,
+	TAG_METHOD,
 	TAG_NAMELIST,
+	TAG_ENUMERATOR,
 	TAG_PROGRAM,
+	TAG_PROTOTYPE,
 	TAG_SUBROUTINE,
 	TAG_DERIVED_TYPE,
 	TAG_VARIABLE,
-	TAG_ENUM,
-	TAG_ENUMERATOR,
+	TAG_SUBMODULE,
 	TAG_COUNT  /* must be last */
 } tagType;
 
+typedef enum eImplementation {
+	IMP_DEFAULT,
+	IMP_ABSTRACT,
+	IMP_DEFERRED,
+	IMP_NON_OVERRIDABLE,
+	IMP_COUNT
+} impType;
+
 typedef struct sTokenInfo {
 	tokenType type;
 	keywordId keyword;
 	tagType tag;
 	vString* string;
+	vString* parentType;
+	vString* signature;
+	impType implementation;
+	bool isMethod;
 	struct sTokenInfo *secondary;
 	unsigned long lineNumber;
 	MIOPos filePosition;
@@ -198,37 +219,36 @@ typedef struct sTokenInfo {
 */
 
 static langType Lang_fortran;
-static langType Lang_f77;
-static jmp_buf Exception;
-static int Ungetc = '\0';
-static unsigned int Column = 0;
-static bool FreeSourceForm = false;
+static int Ungetc;
+static unsigned int Column;
+static bool FreeSourceForm;
+static bool FreeSourceFormFound = false;
 static bool ParsingString;
-static tokenInfo *Parent = NULL;
-static bool NewLine = true;
-static unsigned int contextual_fake_count = 0;
 
 /* indexed by tagType */
-static kindDefinition FortranKinds [TAG_COUNT] = {
+static kindDefinition FortranKinds [] = {
 	{ true,  'b', "blockData",  "block data"},
 	{ true,  'c', "common",     "common blocks"},
 	{ true,  'e', "entry",      "entry points"},
+	{ true,  'E', "enum",       "enumerations"},
 	{ true,  'f', "function",   "functions"},
 	{ true,  'i', "interface",  "interface contents, generic names, and operators"},
 	{ true,  'k', "component",  "type and structure components"},
 	{ true,  'l', "label",      "labels"},
 	{ false, 'L', "local",      "local, common block, and namelist variables"},
 	{ true,  'm', "module",     "modules"},
+	{ true,  'M', "method",     "type bound procedures"},
 	{ true,  'n', "namelist",   "namelists"},
+	{ true,  'N', "enumerator", "enumeration values"},
 	{ true,  'p', "program",    "programs"},
+	{ false, 'P', "prototype",  "subprogram prototypes"},
 	{ true,  's', "subroutine", "subroutines"},
 	{ true,  't', "type",       "derived types and structures"},
 	{ true,  'v', "variable",   "program (global) and module variables"},
-	{ true,  'E', "enum",       "enumerations"},
-	{ true,  'N', "enumerator", "enumeration values"},
+	{ true,  'S', "submodule",  "submodules"},
 };
 
-/* For efinitions of Fortran 77 with extensions:
+/* For definitions of Fortran 77 with extensions:
  * http://www.fortran.com/fortran/F77_std/rjcnf0001.html
  * http://scienide.uwaterloo.ca/MIPSpro7/007-2362-004/sgi_html/index.html
  *
@@ -238,6 +258,7 @@ static kindDefinition FortranKinds [TAG_COUNT] = {
 
 static const keywordTable FortranKeywordTable [] = {
 	/* keyword          keyword ID */
+	{ "abstract",       KEYWORD_abstract     },
 	{ "allocatable",    KEYWORD_allocatable  },
 	{ "assignment",     KEYWORD_assignment   },
 	{ "associate",      KEYWORD_associate    },
@@ -247,12 +268,14 @@ static const keywordTable FortranKeywordTable [] = {
 	{ "byte",           KEYWORD_byte         },
 	{ "cexternal",      KEYWORD_cexternal    },
 	{ "cglobal",        KEYWORD_cglobal      },
+	{ "class",          KEYWORD_class        },
 	{ "character",      KEYWORD_character    },
 	{ "codimension",    KEYWORD_codimension  },
 	{ "common",         KEYWORD_common       },
 	{ "complex",        KEYWORD_complex      },
 	{ "contains",       KEYWORD_contains     },
 	{ "data",           KEYWORD_data         },
+	{ "deferred",       KEYWORD_deferred     },
 	{ "dimension",      KEYWORD_dimension    },
 	{ "dll_export",     KEYWORD_dllexport    },
 	{ "dll_import",     KEYWORD_dllimport    },
@@ -266,11 +289,14 @@ static const keywordTable FortranKeywordTable [] = {
 	{ "equivalence",    KEYWORD_equivalence  },
 	{ "extends",        KEYWORD_extends      },
 	{ "external",       KEYWORD_external     },
+	{ "final",          KEYWORD_final        },
 	{ "forall",         KEYWORD_forall       },
 	{ "format",         KEYWORD_format       },
 	{ "function",       KEYWORD_function     },
+	{ "generic",        KEYWORD_generic      },
 	{ "if",             KEYWORD_if           },
 	{ "implicit",       KEYWORD_implicit     },
+	{ "import",         KEYWORD_import       },
 	{ "include",        KEYWORD_include      },
 	{ "inline",         KEYWORD_inline       },
 	{ "integer",        KEYWORD_integer      },
@@ -283,17 +309,21 @@ static const keywordTable FortranKeywordTable [] = {
 	{ "map",            KEYWORD_map          },
 	{ "module",         KEYWORD_module       },
 	{ "namelist",       KEYWORD_namelist     },
+	{ "non_overridable", KEYWORD_non_overridable },
+	{ "nopass",         KEYWORD_nopass       },
 	{ "operator",       KEYWORD_operator     },
 	{ "optional",       KEYWORD_optional     },
 	{ "parameter",      KEYWORD_parameter    },
 	{ "pascal",         KEYWORD_pascal       },
+	{ "pass",           KEYWORD_pass         },
 	{ "pexternal",      KEYWORD_pexternal    },
 	{ "pglobal",        KEYWORD_pglobal      },
 	{ "pointer",        KEYWORD_pointer      },
 	{ "precision",      KEYWORD_precision    },
 	{ "private",        KEYWORD_private      },
 	{ "procedure",      KEYWORD_procedure    },
 	{ "program",        KEYWORD_program      },
+	{ "protected",      KEYWORD_protected    },
 	{ "public",         KEYWORD_public       },
 	{ "pure",           KEYWORD_pure         },
 	{ "real",           KEYWORD_real         },
@@ -305,6 +335,7 @@ static const keywordTable FortranKeywordTable [] = {
 	{ "static",         KEYWORD_static       },
 	{ "stdcall",        KEYWORD_stdcall      },
 	{ "structure",      KEYWORD_structure    },
+	{ "submodule",      KEYWORD_submodule   },
 	{ "subroutine",     KEYWORD_subroutine   },
 	{ "target",         KEYWORD_target       },
 	{ "then",           KEYWORD_then         },
@@ -330,8 +361,7 @@ static struct {
 static void parseStructureStmt (tokenInfo *const token);
 static void parseUnionStmt (tokenInfo *const token);
 static void parseDerivedTypeDef (tokenInfo *const token);
-static void parseFunctionSubprogram (tokenInfo *const token);
-static void parseSubroutineSubprogram (tokenInfo *const token);
+static void parseSubprogram (tokenInfo *const token);
 
 /*
 *   FUNCTION DEFINITIONS
@@ -354,6 +384,7 @@ static void ancestorPush (tokenInfo *const token)
 	}
 	Ancestors.list [Ancestors.count] = *token;
 	Ancestors.list [Ancestors.count].string = vStringNewCopy (token->string);
+	Ancestors.list [Ancestors.count].signature = token->signature? vStringNewCopy (token->signature): NULL;
 	Ancestors.count++;
 }
 
@@ -362,13 +393,16 @@ static void ancestorPop (void)
 	Assert (Ancestors.count > 0);
 	--Ancestors.count;
 	vStringDelete (Ancestors.list [Ancestors.count].string);
+	vStringDelete (Ancestors.list [Ancestors.count].signature);
 
 	Ancestors.list [Ancestors.count].type       = TOKEN_UNDEFINED;
 	Ancestors.list [Ancestors.count].keyword    = KEYWORD_NONE;
 	Ancestors.list [Ancestors.count].secondary  = NULL;
 	Ancestors.list [Ancestors.count].tag        = TAG_UNDEFINED;
 	Ancestors.list [Ancestors.count].string     = NULL;
 	Ancestors.list [Ancestors.count].lineNumber = 0L;
+	Ancestors.list [Ancestors.count].implementation = IMP_DEFAULT;
+	Ancestors.list [Ancestors.count].isMethod   = false;
 }
 
 static const tokenInfo* ancestorScope (void)
@@ -419,7 +453,6 @@ static bool insideInterface (void)
 /*
 *   Tag generation functions
 */
-
 static tokenInfo *newToken (void)
 {
 	tokenInfo *const token = xMalloc (1, tokenInfo);
@@ -429,30 +462,38 @@ static tokenInfo *newToken (void)
 	token->tag          = TAG_UNDEFINED;
 	token->string       = vStringNew ();
 	token->secondary    = NULL;
+	token->parentType   = NULL;
+	token->signature    = NULL;
+	token->implementation = IMP_DEFAULT;
+	token->isMethod     = false;
 	token->lineNumber   = getInputLineNumber ();
 	token->filePosition = getInputFilePosition ();
 	token->anonymous    = false;
 
 	return token;
 }
 
-static tokenInfo *newTokenFrom (tokenInfo *const token)
+static tokenInfo *newTokenFromFull (tokenInfo *const token, bool copyStr)
 {
-	tokenInfo *result = newToken ();
+	tokenInfo *result = xMalloc (1, tokenInfo);
 	*result = *token;
-	result->string = vStringNewCopy (token->string);
+	result->string = copyStr? vStringNewCopy (token->string): vStringNew();
 	token->secondary = NULL;
+	token->parentType = NULL;
+	token->signature = NULL;
 	return result;
 }
 
-static tokenInfo *newAnonTokenFrom (tokenInfo *const token, const char *type)
+static tokenInfo *newTokenFrom (tokenInfo *const token)
 {
-	char buffer[64];
-	tokenInfo *result = newTokenFrom (token);
+	return newTokenFromFull (token, true);
+}
+
+static tokenInfo *newAnonTokenFrom (tokenInfo *const token, unsigned int uTagKind)
+{
+	tokenInfo *result = newTokenFromFull (token, false);
 	result->anonymous = true;
-	sprintf (buffer, "%s#%u", type, contextual_fake_count++);
-	vStringClear (result->string);
-	vStringCatS (result->string, buffer);
+	anonGenerate (result->string, "__anon", uTagKind);
 	return result;
 }
 
@@ -461,6 +502,8 @@ static void deleteToken (tokenInfo *const token)
 	if (token != NULL)
 	{
 		vStringDelete (token->string);
+		vStringDelete (token->parentType);
+		vStringDelete (token->signature);
 		deleteToken (token->secondary);
 		token->secondary = NULL;
 		eFree (token);
@@ -475,13 +518,23 @@ static bool isFileScope (const tagType type)
 static bool includeTag (const tagType type)
 {
 	bool include;
-	Assert (type > TAG_UNDEFINED && type < TAG_COUNT);
+	Assert (type != TAG_UNDEFINED);
 	include = FortranKinds [(int) type].enabled;
 	if (include && isFileScope (type))
 		include = isXtagEnabled(XTAG_FILE_SCOPE);
 	return include;
 }
 
+static const char *implementationString (const impType imp)
+{
+	static const char *const names [] ={
+		"?", "abstract", "deferred", "non_overridable"
+	};
+	Assert (ARRAY_SIZE (names) == IMP_COUNT);
+	Assert ((int) imp < IMP_COUNT);
+	return names [(int) imp];
+}
+
 static void makeFortranTag (tokenInfo *const token, tagType tag)
 {
 	token->tag = tag;
@@ -501,7 +554,9 @@ static void makeFortranTag (tokenInfo *const token, tagType tag)
 		e.lineNumber	= token->lineNumber;
 		e.filePosition	= token->filePosition;
 		e.isFileScope	= isFileScope (token->tag);
-		e.truncateLineAfterTag	= (bool) (token->tag != TAG_LABEL);
+		if (e.isFileScope)
+			markTagExtraBit (&e, XTAG_FILE_SCOPE);
+		e.truncateLineAfterTag = (bool) (token->tag != TAG_LABEL);
 
 		if (ancestorCount () > 0)
 		{
@@ -512,8 +567,20 @@ static void makeFortranTag (tokenInfo *const token, tagType tag)
 				e.extensionFields.scopeName = vStringValue (scope->string);
 			}
 		}
-		if (! insideInterface () /*|| includeTag (TAG_INTERFACE)*/)
-			makeTagEntry (&e);
+		if (token->parentType != NULL &&
+		    vStringLength (token->parentType) > 0 &&
+		    (token->tag == TAG_DERIVED_TYPE || (token->tag == TAG_SUBMODULE)))
+			e.extensionFields.inheritance = vStringValue (token->parentType);
+		if (token->implementation != IMP_DEFAULT)
+			e.extensionFields.implementation =
+				implementationString (token->implementation);
+		if (token->signature &&
+			vStringLength (token->signature) > 0 &&
+			(token->tag == TAG_FUNCTION ||
+			 token->tag == TAG_SUBROUTINE ||
+			 token->tag == TAG_PROTOTYPE))
+			e.extensionFields.signature = vStringValue (token->signature);
+		makeTagEntry (&e);
 	}
 }
 
@@ -543,10 +610,11 @@ static void makeLabelTag (vString *const label)
 
 static lineType getLineType (void)
 {
-	vString *label = vStringNew ();
+	static vString *label = NULL;
 	int column = 0;
 	lineType type = LTYPE_UNDETERMINED;
 
+	label = vStringNewOrClear (label);
 	do  /* read in first 6 "margin" characters */
 	{
 		int c = getcFromInputFile ();
@@ -608,7 +676,6 @@ static lineType getLineType (void)
 
 	if (vStringLength (label) > 0)
 		makeLabelTag (label);
-	vStringDelete (label);
 	return type;
 }
 
@@ -646,7 +713,7 @@ static int getFixedFormChar (void)
 		{
 			const int c2 = getcFromInputFile ();
 			if (c2 == '\n')
-				longjmp (Exception, (int) ExceptionFixedFormat);
+				FreeSourceFormFound = true;
 			else
 				ungetcToInputFile (c2);
 		}
@@ -658,8 +725,9 @@ static int getFixedFormChar (void)
 		{
 			case LTYPE_UNDETERMINED:
 			case LTYPE_INVALID:
-				longjmp (Exception, (int) ExceptionFixedFormat);
-				break;
+				FreeSourceFormFound = true;
+				if (! FreeSourceForm)
+				    return EOF;
 
 			case LTYPE_SHORT: break;
 			case LTYPE_COMMENT: skipLine (); break;
@@ -679,7 +747,7 @@ static int getFixedFormChar (void)
 					Column = 6;
 					break;
 				}
-				/* fall through */
+				/* fall through to next case */
 			case LTYPE_CONTINUATION:
 				Column = 5;
 				do
@@ -711,23 +779,24 @@ static int skipToNextLine (void)
 	return c;
 }
 
-static int getFreeFormChar (bool inComment)
+static int getFreeFormChar (void)
 {
+	static bool newline = true;
 	bool advanceLine = false;
 	int c = getcFromInputFile ();
 
 	/* If the last nonblank, non-comment character of a FORTRAN 90
 	 * free-format text line is an ampersand then the next non-comment
 	 * line is a continuation line.
 	 */
-	if (! inComment && c == '&')
+	if (c == '&')
 	{
 		do
 			c = getcFromInputFile ();
 		while (isspace (c)  &&  c != '\n');
 		if (c == '\n')
 		{
-			NewLine = true;
+			newline = true;
 			advanceLine = true;
 		}
 		else if (c == '!')
@@ -738,24 +807,24 @@ static int getFreeFormChar (bool inComment)
 			c = '&';
 		}
 	}
-	else if (NewLine && (c == '!' || c == '#'))
+	else if (newline && (c == '!' || c == '#'))
 		advanceLine = true;
 	while (advanceLine)
 	{
 		while (isspace (c))
 			c = getcFromInputFile ();
-		if (c == '!' || (NewLine && c == '#'))
+		if (c == '!' || (newline && c == '#'))
 		{
 			c = skipToNextLine ();
-			NewLine = true;
+			newline = true;
 			continue;
 		}
 		if (c == '&')
 			c = getcFromInputFile ();
 		else
 			advanceLine = false;
 	}
-	NewLine = (bool) (c == '\n');
+	newline = (bool) (c == '\n');
 	return c;
 }
 
@@ -769,7 +838,7 @@ static int getChar (void)
 		Ungetc = '\0';
 	}
 	else if (FreeSourceForm)
-		c = getFreeFormChar (false);
+		c = getFreeFormChar ();
 	else
 		c = getFixedFormChar ();
 	return c;
@@ -813,23 +882,20 @@ static vString *parseInteger (int c)
 
 static vString *parseNumeric (int c)
 {
-	vString *string = vStringNew ();
-	vString *integer = parseInteger (c);
-	vStringCopy (string, integer);
-	vStringDelete (integer);
+	vString *string = parseInteger (c);
 
 	c = getChar ();
 	if (c == '.')
 	{
-		integer = parseInteger ('\0');
+		vString *integer = parseInteger ('\0');
 		vStringPut (string, c);
 		vStringCat (string, integer);
 		vStringDelete (integer);
 		c = getChar ();
 	}
 	if (tolower (c) == 'e')
 	{
-		integer = parseInteger ('\0');
+		vString *integer = parseInteger ('\0');
 		vStringPut (string, c);
 		vStringCat (string, integer);
 		vStringDelete (integer);
@@ -855,10 +921,8 @@ static void parseString (vString *const string, const int delimiter)
 	{
 		verbose ("%s: unterminated character string at line %lu\n",
 				getInputFileName (), inputLineNumber);
-		if (c == EOF)
-			longjmp (Exception, (int) ExceptionEOF);
-		else if (! FreeSourceForm)
-			longjmp (Exception, (int) ExceptionFixedFormat);
+		if (c != EOF && ! FreeSourceForm)
+			FreeSourceFormFound = true;
 	}
 	ParsingString = false;
 }
@@ -906,27 +970,10 @@ static void checkForLabel (void)
 	ungetChar (c);
 }
 
-/*  Analyzes the identifier contained in a statement described by the
- *  statement structure and adjusts the structure according the significance
- *  of the identifier.
- */
-static keywordId analyzeToken (vString *const name, langType language)
-{
-    static vString *keyword = NULL;
-    keywordId id;
-
-    if (keyword == NULL)
-	keyword = vStringNew ();
-    vStringCopyToLower (keyword, name);
-    id = (keywordId) lookupKeyword (vStringValue (keyword), language);
-
-    return id;
-}
-
 static void readIdentifier (tokenInfo *const token, const int c)
 {
 	parseIdentifier (token->string, c);
-	token->keyword = analyzeToken (token->string, Lang_fortran);
+	token->keyword = lookupCaseKeyword (vStringValue (token->string), Lang_fortran);
 	if (! isKeyword (token, KEYWORD_NONE))
 		token->type = TOKEN_KEYWORD;
 	else
@@ -935,7 +982,7 @@ static void readIdentifier (tokenInfo *const token, const int c)
 		if (strncmp (vStringValue (token->string), "end", 3) == 0)
 		{
 			vString *const sub = vStringNewInit (vStringValue (token->string) + 3);
-			const keywordId kw = analyzeToken (sub, Lang_fortran);
+			const keywordId kw = lookupCaseKeyword (vStringValue (sub), Lang_fortran);
 			vStringDelete (sub);
 			if (kw != KEYWORD_NONE)
 			{
@@ -957,7 +1004,13 @@ static void readToken (tokenInfo *const token)
 	token->tag         = TAG_UNDEFINED;
 	token->keyword     = KEYWORD_NONE;
 	token->secondary   = NULL;
+	token->implementation = IMP_DEFAULT;
 	vStringClear (token->string);
+	vStringDelete (token->parentType);
+	vStringDelete (token->signature);
+	token->parentType = NULL;
+	token->isMethod = false;
+	token->signature = NULL;
 
 getNextChar:
 	c = getChar ();
@@ -967,7 +1020,7 @@ static void readToken (tokenInfo *const token)
 
 	switch (c)
 	{
-		case EOF:  longjmp (Exception, (int) ExceptionEOF);  break;
+		case EOF:  token->type = TOKEN_EOF;         break;
 		case ' ':  goto getNextChar;
 		case '\t': goto getNextChar;
 		case ',':  token->type = TOKEN_COMMA;       break;
@@ -999,15 +1052,15 @@ static void readToken (tokenInfo *const token)
 			if (FreeSourceForm)
 			{
 				do
-					c = getFreeFormChar (true);
+				   c = getChar ();
 				while (c != '\n' && c != EOF);
 			}
 			else
 			{
 				skipLine ();
 				Column = 0;
 			}
-			/* fall through */
+			/* fall through to newline case */
 		case '\n':
 			token->type = TOKEN_STATEMENT_END;
 			if (FreeSourceForm)
@@ -1046,7 +1099,7 @@ static void readToken (tokenInfo *const token)
 			else
 			{
 				ungetChar (c);
-				token->type = TOKEN_UNDEFINED;
+				token->type = TOKEN_COLON;
 			}
 			break;
 
@@ -1082,7 +1135,8 @@ static void readSubToken (tokenInfo *const token)
 static void skipToToken (tokenInfo *const token, tokenType type)
 {
 	while (! isType (token, type) && ! isType (token, TOKEN_STATEMENT_END) &&
-			!(token->secondary != NULL && isType (token->secondary, TOKEN_STATEMENT_END)))
+			!(token->secondary != NULL && isType (token->secondary, TOKEN_STATEMENT_END)) &&
+			! isType (token, TOKEN_EOF))
 		readToken (token);
 }
 
@@ -1105,7 +1159,11 @@ static void skipToNextStatement (tokenInfo *const token)
 /* skip over paired tokens, managing nested pairs and stopping at statement end
  * or right after closing token, whatever comes first.
  */
-static void skipOverPair (tokenInfo *const token, tokenType topen, tokenType tclose)
+static void skipOverPairsFull (tokenInfo *const token,
+							   tokenType topen,
+							   tokenType tclose,
+							   void (* token_cb) (tokenInfo *const, void *),
+							   void *user_data)
 {
 	int level = 0;
 	do {
@@ -1115,18 +1173,38 @@ static void skipOverPair (tokenInfo *const token, tokenType topen, tokenType tcl
 			++level;
 		else if (isType (token, tclose))
 			--level;
+		else if (token_cb)
+			token_cb (token, user_data);
 		readToken (token);
-	} while (level > 0);
+	} while (level > 0 && !isType (token, TOKEN_EOF));
+}
+
+static void skipOverParensFull (tokenInfo *const token,
+								void (* token_cb) (tokenInfo *const, void *),
+								void *user_data)
+{
+	skipOverPairsFull (token, TOKEN_PAREN_OPEN,
+					   TOKEN_PAREN_CLOSE,
+					   token_cb, user_data);
+}
+
+static void skipOverSquaresFull (tokenInfo *const token,
+								 void (* token_cb) (tokenInfo *const, void *),
+								 void *user_data)
+{
+	skipOverPairsFull (token, TOKEN_SQUARE_OPEN,
+					   TOKEN_SQUARE_CLOSE,
+					   token_cb, user_data);
 }
 
 static void skipOverParens (tokenInfo *const token)
 {
-	skipOverPair (token, TOKEN_PAREN_OPEN, TOKEN_PAREN_CLOSE);
+	skipOverParensFull (token, NULL, NULL);
 }
 
 static void skipOverSquares (tokenInfo *const token)
 {
-	skipOverPair (token, TOKEN_SQUARE_OPEN, TOKEN_SQUARE_CLOSE);
+	skipOverSquaresFull (token, NULL, NULL);
 }
 
 static bool isTypeSpec (tokenInfo *const token)
@@ -1144,6 +1222,9 @@ static bool isTypeSpec (tokenInfo *const token)
 		case KEYWORD_record:
 		case KEYWORD_type:
 		case KEYWORD_procedure:
+		case KEYWORD_final:
+		case KEYWORD_generic:
+		case KEYWORD_class:
 		case KEYWORD_enumerator:
 			result = true;
 			break;
@@ -1223,6 +1304,7 @@ static void parseTypeSpec (tokenInfo *const token)
 		case KEYWORD_logical:
 		case KEYWORD_real:
 		case KEYWORD_procedure:
+		case KEYWORD_class:
 			readToken (token);
 			parseKindSelector (token);
 			break;
@@ -1255,6 +1337,8 @@ static void parseTypeSpec (tokenInfo *const token)
 				parseDerivedTypeDef (token);
 			break;
 
+		case KEYWORD_final:
+		case KEYWORD_generic:
 		case KEYWORD_enumerator:
 			readToken (token);
 			break;
@@ -1276,6 +1360,53 @@ static bool skipStatementIfKeyword (tokenInfo *const token, keywordId keyword)
 	return result;
 }
 
+/* parse extends qualifier, leaving token at first token following close
+ * parenthesis.
+ */
+
+static void attachParentType (tokenInfo *const token, vString* parentType)
+{
+	if (token->parentType)
+		vStringDelete (token->parentType);
+	token->parentType = parentType;
+}
+
+static void makeParentType (tokenInfo *const token, void *userData)
+{
+	attachParentType ((tokenInfo *const)userData,
+					  vStringNewCopy (token->string));
+}
+
+static void parseExtendsQualifier (tokenInfo *const token,
+								   tokenInfo *const qualifierToken)
+{
+	skipOverParensFull (token, makeParentType, qualifierToken);
+}
+
+static void parseAbstractQualifier (tokenInfo *const token,
+									tokenInfo *const qualifierToken)
+{
+	Assert (isKeyword (token, KEYWORD_abstract));
+	qualifierToken->implementation = IMP_ABSTRACT;
+	readToken (token);
+}
+
+static void parseDeferredQualifier (tokenInfo *const token,
+									tokenInfo *const qualifierToken)
+{
+	Assert (isKeyword (token, KEYWORD_deferred));
+	qualifierToken->implementation = IMP_DEFERRED;
+	readToken (token);
+}
+
+static void parseNonOverridableQualifier (tokenInfo *const token,
+										  tokenInfo *const qualifierToken)
+{
+	Assert (isKeyword (token, KEYWORD_non_overridable));
+	qualifierToken->implementation = IMP_NON_OVERRIDABLE;
+	readToken (token);
+}
+
 /* parse a list of qualifying specifiers, leaving `token' at first token
  * following list. Examples of such specifiers are:
  *      [[, attr-spec] ::]
@@ -1286,21 +1417,28 @@ static bool skipStatementIfKeyword (tokenInfo *const token, keywordId keyword)
  *      or access-spec (is PUBLIC or PRIVATE)
  *      or ALLOCATABLE
  *      or DIMENSION ( array-spec )
+ *      or EXTENDS ( extends-spec )
  *      or EXTERNAL
  *      or INTENT ( intent-spec )
  *      or INTRINSIC
  *      or OPTIONAL
  *      or POINTER
  *      or SAVE
  *      or TARGET
+ *      or PASS
+ *      or NOPASS
+ *      or DEFERRED
+ *      or NON_OVERRIDABLE
+ *      or ABSTRACT
  *
  *  component-attr-spec
  *      is POINTER
  *      or DIMENSION ( component-array-spec )
- *      or EXTENDS ( type name )
  */
-static void parseQualifierSpecList (tokenInfo *const token)
+static tokenInfo *parseQualifierSpecList (tokenInfo *const token)
 {
+	tokenInfo *qualifierToken = newToken ();
+
 	do
 	{
 		readToken (token);  /* should be an attr-spec */
@@ -1315,54 +1453,91 @@ static void parseQualifierSpecList (tokenInfo *const token)
 			case KEYWORD_optional:
 			case KEYWORD_private:
 			case KEYWORD_pointer:
+			case KEYWORD_protected:
 			case KEYWORD_public:
 			case KEYWORD_save:
 			case KEYWORD_target:
+			case KEYWORD_nopass:
 				readToken (token);
 				break;
 
-			case KEYWORD_codimension:
+			case KEYWORD_dimension:
+			case KEYWORD_intent:
+			case KEYWORD_bind:
 				readToken (token);
-				skipOverSquares (token);
+				skipOverParens (token);
 				break;
 
-			case KEYWORD_dimension:
 			case KEYWORD_extends:
-			case KEYWORD_intent:
 				readToken (token);
-				skipOverParens (token);
+				parseExtendsQualifier (token, qualifierToken);
+				break;
+
+			case KEYWORD_pass:
+				readToken (token);
+				if (isType (token, TOKEN_PAREN_OPEN))
+					skipOverParens (token);
+				break;
+
+			case KEYWORD_abstract:
+				parseAbstractQualifier (token, qualifierToken);
+				break;
+
+			case KEYWORD_deferred:
+				parseDeferredQualifier (token, qualifierToken);
+				break;
+
+			case KEYWORD_non_overridable:
+				parseNonOverridableQualifier (token, qualifierToken);
+				break;
+
+			case KEYWORD_codimension:
+				readToken (token);
+				skipOverSquares (token);
 				break;
 
 			default: skipToToken (token, TOKEN_STATEMENT_END); break;
 		}
 	} while (isType (token, TOKEN_COMMA));
 	if (! isType (token, TOKEN_DOUBLE_COLON))
 		skipToToken (token, TOKEN_STATEMENT_END);
+
+	return qualifierToken;
 }
 
-static tagType variableTagType (void)
+static tagType variableTagType (tokenInfo *const st)
 {
 	tagType result = TAG_VARIABLE;
 	if (ancestorCount () > 0)
 	{
 		const tokenInfo* const parent = ancestorTop ();
 		switch (parent->tag)
 		{
+			case TAG_SUBMODULE:	/* Fall through */
 			case TAG_MODULE:       result = TAG_VARIABLE;  break;
-			case TAG_DERIVED_TYPE: result = TAG_COMPONENT; break;
+			case TAG_DERIVED_TYPE:
+				if (st && st->isMethod)
+					result = TAG_METHOD;
+				else
+					result = TAG_COMPONENT;
+				break;
 			case TAG_FUNCTION:     result = TAG_LOCAL;     break;
 			case TAG_SUBROUTINE:   result = TAG_LOCAL;     break;
+			case TAG_PROTOTYPE:    result = TAG_LOCAL;     break;
 			case TAG_ENUM:         result = TAG_ENUMERATOR; break;
 			default:               result = TAG_VARIABLE;  break;
 		}
 	}
 	return result;
 }
 
-static void parseEntityDecl (tokenInfo *const token)
+static void parseEntityDecl (tokenInfo *const token,
+							 tokenInfo *const st)
 {
 	Assert (isType (token, TOKEN_IDENTIFIER));
-	makeFortranTag (token, variableTagType ());
+	if (st && st->implementation != IMP_DEFAULT)
+		token->implementation = st->implementation;
+	makeFortranTag (token, variableTagType (st));
 	readToken (token);
 	/* we check for both '()' and '[]'
 	 * coarray syntax permits variable(), variable[], or variable()[]
@@ -1391,7 +1566,8 @@ static void parseEntityDecl (tokenInfo *const token)
 				 strcmp (vStringValue (token->string), "=>") == 0)
 		{
 			while (! isType (token, TOKEN_COMMA) &&
-					! isType (token, TOKEN_STATEMENT_END))
+					! isType (token, TOKEN_STATEMENT_END) &&
+					! isType (token, TOKEN_EOF))
 			{
 				readToken (token);
 				/* another coarray check, for () and [] */
@@ -1405,7 +1581,8 @@ static void parseEntityDecl (tokenInfo *const token)
 	/* token left at either comma or statement end */
 }
 
-static void parseEntityDeclList (tokenInfo *const token)
+static void parseEntityDeclList (tokenInfo *const token,
+								 tokenInfo *const st)
 {
 	if (isType (token, TOKEN_PERCENT))
 		skipToNextStatement (token);
@@ -1417,7 +1594,7 @@ static void parseEntityDeclList (tokenInfo *const token)
 		/* compilers accept keywords as identifiers */
 		if (isType (token, TOKEN_KEYWORD))
 			token->type = TOKEN_IDENTIFIER;
-		parseEntityDecl (token);
+		parseEntityDecl (token, st);
 		if (isType (token, TOKEN_COMMA))
 			readToken (token);
 		else if (isType (token, TOKEN_STATEMENT_END))
@@ -1438,10 +1615,13 @@ static void parseTypeDeclarationStmt (tokenInfo *const token)
 	if (!isType (token, TOKEN_STATEMENT_END))  /* if not end of derived type... */
 	{
 		if (isType (token, TOKEN_COMMA))
-			parseQualifierSpecList (token);
+		{
+			tokenInfo* qualifierToken = parseQualifierSpecList (token);
+			deleteToken (qualifierToken);
+		}
 		if (isType (token, TOKEN_DOUBLE_COLON))
 			readToken (token);
-		parseEntityDeclList (token);
+		parseEntityDeclList (token, NULL);
 	}
 	if (isType (token, TOKEN_STATEMENT_END))
 		skipToNextStatement (token);
@@ -1486,7 +1666,8 @@ static void parseCommonNamelistStmt (tokenInfo *const token, tagType type)
 			skipOverParens (token);  /* skip explicit-shape-spec-list */
 		if (isType (token, TOKEN_COMMA))
 			readToken (token);
-	} while (! isType (token, TOKEN_STATEMENT_END));
+	} while (! isType (token, TOKEN_STATEMENT_END) &&
+			 ! isType (token, TOKEN_EOF));
 	skipToNextStatement (token);
 }
 
@@ -1506,7 +1687,8 @@ static void parseMap (tokenInfo *const token)
 {
 	Assert (isKeyword (token, KEYWORD_map));
 	skipToNextStatement (token);
-	while (! isKeyword (token, KEYWORD_end))
+	while (! isKeyword (token, KEYWORD_end) &&
+		   ! isType (token, TOKEN_EOF))
 		parseFieldDefinition (token);
 	readSubToken (token);
 	/* should be at KEYWORD_map token */
@@ -1515,16 +1697,16 @@ static void parseMap (tokenInfo *const token)
 
 /* UNION
  *      MAP
- *          [field-definition] [field-definition] ... 
+ *          [field-definition] [field-definition] ...
  *      END MAP
  *      MAP
- *          [field-definition] [field-definition] ... 
+ *          [field-definition] [field-definition] ...
  *      END MAP
  *      [MAP
  *          [field-definition]
- *          [field-definition] ... 
+ *          [field-definition] ...
  *      END MAP] ...
- *  END UNION 
+ *  END UNION
  *      *
  *
  *  Typed data declarations (variables or arrays) in structure declarations
@@ -1539,7 +1721,7 @@ static void parseMap (tokenInfo *const token)
  *  share a common location within the containing structure. When initializing
  *  the fields within a UNION, the final initialization value assigned
  *  overlays any value previously assigned to a field definition that shares
- *  that field. 
+ *  that field.
  */
 static void parseUnionStmt (tokenInfo *const token)
 {
@@ -1561,11 +1743,11 @@ static void parseUnionStmt (tokenInfo *const token)
  *  structure-name
  *		identifies the structure in a subsequent RECORD statement.
  *		Substructures can be established within a structure by means of either
- *		a nested STRUCTURE declaration or a RECORD statement. 
+ *		a nested STRUCTURE declaration or a RECORD statement.
  *
  *   field-names
  *		(for substructure declarations only) one or more names having the
- *		structure of the substructure being defined. 
+ *		structure of the substructure being defined.
  *
  *   field-definition
  *		can be one or more of the following:
@@ -1580,7 +1762,7 @@ static void parseUnionStmt (tokenInfo *const token)
  *			statements. The syntax of a UNION declaration is described below.
  *
  *			PARAMETER statements, which do not affect the form of the
- *			structure. 
+ *			structure.
  */
 static void parseStructureStmt (tokenInfo *const token)
 {
@@ -1600,7 +1782,7 @@ static void parseStructureStmt (tokenInfo *const token)
 	}
 	if (name == NULL)
 	{  /* fake out anonymous structure */
-		name = newAnonTokenFrom (token, "Structure");
+		name = newAnonTokenFrom (token, TAG_COMPONENT);
 		name->type = TOKEN_IDENTIFIER;
 		name->tag = TAG_DERIVED_TYPE;
 	}
@@ -1614,7 +1796,8 @@ static void parseStructureStmt (tokenInfo *const token)
 	}
 	skipToNextStatement (token);
 	ancestorPush (name);
-	while (! isKeyword (token, KEYWORD_end))
+	while (! isKeyword (token, KEYWORD_end) &&
+		   ! isType (token, TOKEN_EOF))
 		parseFieldDefinition (token);
 	readSubToken (token);
 	/* secondary token should be KEYWORD_structure token */
@@ -1662,13 +1845,13 @@ static bool parseSpecificationStmt (tokenInfo *const token)
 		case KEYWORD_data:
 		case KEYWORD_dimension:
 		case KEYWORD_equivalence:
-		case KEYWORD_extends:
 		case KEYWORD_external:
 		case KEYWORD_intent:
 		case KEYWORD_intrinsic:
 		case KEYWORD_optional:
 		case KEYWORD_pointer:
 		case KEYWORD_private:
+		case KEYWORD_protected:
 		case KEYWORD_public:
 		case KEYWORD_save:
 		case KEYWORD_target:
@@ -1682,6 +1865,32 @@ static bool parseSpecificationStmt (tokenInfo *const token)
 	return result;
 }
 
+/* Type bound generic procedure is:
+ *   GENERIC [, access-spec ] :: generic-spec => binding-name1 [, binding-name2]...
+ *     access-spec: PUBLIC or PRIVATE
+ *     generic-spec: 1. generic name; 2. OPERATOR(op); 3. ASSIGNMENT(=)
+ *     binding-name: type bound procedure
+ */
+static void parseGenericMethod (tokenInfo *const token)
+{
+	if (isKeyword (token, KEYWORD_assignment) ||
+		isKeyword (token, KEYWORD_operator))
+	{
+		readToken (token);
+		if (isType (token, TOKEN_PAREN_OPEN))
+			readToken (token);
+		if (isType (token, TOKEN_OPERATOR))
+			makeFortranTag (token, TAG_METHOD);
+	}
+	else
+	{
+		if (isType (token, TOKEN_KEYWORD))
+			token->type = TOKEN_IDENTIFIER;
+		makeFortranTag (token, TAG_METHOD);
+	}
+	skipToNextStatement (token);
+}
+
 /*  component-def-stmt is
  *      type-spec [[, component-attr-spec-list] ::] component-decl-list
  *
@@ -1690,13 +1899,32 @@ static bool parseSpecificationStmt (tokenInfo *const token)
  */
 static void parseComponentDefStmt (tokenInfo *const token)
 {
+	tokenInfo* st = newToken ();
+	tokenInfo* qt = NULL;
+	bool isGeneric = false;
+
 	Assert (isTypeSpec (token));
+	if (isKeyword (token, KEYWORD_procedure) ||
+		isKeyword (token, KEYWORD_final) ||
+		isKeyword (token, KEYWORD_generic))
+		st->isMethod = true;
+	if (isKeyword (token, KEYWORD_generic))
+		isGeneric = true;
 	parseTypeSpec (token);
 	if (isType (token, TOKEN_COMMA))
-		parseQualifierSpecList (token);
+	{
+		qt = parseQualifierSpecList (token);
+		if (qt->implementation != IMP_DEFAULT)
+			st->implementation = qt->implementation;
+		deleteToken (qt);
+	}
 	if (isType (token, TOKEN_DOUBLE_COLON))
 		readToken (token);
-	parseEntityDeclList (token);
+	if (isGeneric)
+		parseGenericMethod (token);
+	else
+		parseEntityDeclList (token, st);
+	deleteToken (st);
 }
 
 /*  derived-type-def is
@@ -1708,23 +1936,34 @@ static void parseComponentDefStmt (tokenInfo *const token)
  */
 static void parseDerivedTypeDef (tokenInfo *const token)
 {
+	tokenInfo *qualifierToken = NULL;
+
 	if (isType (token, TOKEN_COMMA))
-		parseQualifierSpecList (token);
+		qualifierToken = parseQualifierSpecList (token);
 	if (isType (token, TOKEN_DOUBLE_COLON))
 		readToken (token);
 	if (isType (token, TOKEN_IDENTIFIER) || isType (token, TOKEN_KEYWORD))
 	{
 		token->type = TOKEN_IDENTIFIER;
+		if (qualifierToken)
+		{
+			if (qualifierToken->parentType)
+				token->parentType = vStringNewCopy (qualifierToken->parentType);
+			if (qualifierToken->implementation != IMP_DEFAULT)
+				token->implementation = qualifierToken->implementation;
+		}
 		makeFortranTag (token, TAG_DERIVED_TYPE);
 	}
+	deleteToken (qualifierToken);
 	ancestorPush (token);
 	skipToNextStatement (token);
 	if (isKeyword (token, KEYWORD_private) ||
 		isKeyword (token, KEYWORD_sequence))
 	{
 		skipToNextStatement (token);
 	}
-	while (! isKeyword (token, KEYWORD_end))
+	while (! isKeyword (token, KEYWORD_end) &&
+		   ! isType (token, TOKEN_EOF))
 	{
 		if (isTypeSpec (token))
 			parseComponentDefStmt (token);
@@ -1765,7 +2004,7 @@ static void parseInterfaceBlock (tokenInfo *const token)
 	Assert (isKeyword (token, KEYWORD_interface));
 	readToken (token);
 	if (isKeyword (token, KEYWORD_assignment) ||
-		isKeyword (token, KEYWORD_operator))
+			 isKeyword (token, KEYWORD_operator))
 	{
 		readToken (token);
 		if (isType (token, TOKEN_PAREN_OPEN))
@@ -1780,18 +2019,19 @@ static void parseInterfaceBlock (tokenInfo *const token)
 	}
 	if (name == NULL)
 	{
-		name = newAnonTokenFrom (token, "Interface");
+		name = newAnonTokenFrom (token, TAG_INTERFACE);
 		name->type = TOKEN_IDENTIFIER;
 		name->tag = TAG_INTERFACE;
 	}
 	makeFortranTag (name, TAG_INTERFACE);
 	ancestorPush (name);
-	while (! isKeyword (token, KEYWORD_end))
+	while (! isKeyword (token, KEYWORD_end) &&
+		   ! isType (token, TOKEN_EOF))
 	{
 		switch (token->keyword)
 		{
-			case KEYWORD_function:   parseFunctionSubprogram (token);   break;
-			case KEYWORD_subroutine: parseSubroutineSubprogram (token); break;
+			case KEYWORD_function:
+			case KEYWORD_subroutine: parseSubprogram (token); break;
 
 			default:
 				if (isSubprogramPrefix (token))
@@ -1839,14 +2079,15 @@ static void parseEnumBlock (tokenInfo *const token)
 	}
 	if (name == NULL)
 	{
-		name = newAnonTokenFrom (token, "Enum");
+		name = newAnonTokenFrom (token, TAG_ENUM);
 		name->type = TOKEN_IDENTIFIER;
 		name->tag = TAG_ENUM;
 	}
 	makeFortranTag (name, TAG_ENUM);
 	skipToNextStatement (token);
 	ancestorPush (name);
-	while (! isKeyword (token, KEYWORD_end))
+	while (! isKeyword (token, KEYWORD_end) &&
+		   ! isType(token, TOKEN_EOF))
 	{
 		if (isTypeSpec (token))
 			parseTypeDeclarationStmt (token);
@@ -1939,12 +2180,21 @@ static bool parseDeclarationConstruct (tokenInfo *const token)
 	bool result = true;
 	switch (token->keyword)
 	{
-		case KEYWORD_entry:     parseEntryStmt (token);      break;
-		case KEYWORD_interface: parseInterfaceBlock (token); break;
+		case KEYWORD_entry:		parseEntryStmt (token);      break;
+		case KEYWORD_interface:	parseInterfaceBlock (token); break;
 		case KEYWORD_enum:      parseEnumBlock (token);      break;
 		case KEYWORD_stdcall:   readToken (token);           break;
 		/* derived type handled by parseTypeDeclarationStmt(); */
 
+		case KEYWORD_abstract:
+			readToken (token);
+			if (isKeyword (token, KEYWORD_interface))
+				parseInterfaceBlock (token);
+			else
+				skipToNextStatement (token);
+			result = true;
+			break;
+
 		case KEYWORD_automatic:
 			readToken (token);
 			if (isTypeSpec (token))
@@ -2006,6 +2256,8 @@ static bool parseSpecificationPart (tokenInfo *const token)
 	bool result = false;
 	while (skipStatementIfKeyword (token, KEYWORD_use))
 		result = true;
+	while (skipStatementIfKeyword (token, KEYWORD_import))
+		result = true;
 	while (parseImplicitPartStmt (token))
 		result = true;
 	while (parseDeclarationConstruct (token))
@@ -2031,7 +2283,8 @@ static void parseBlockData (tokenInfo *const token)
 	ancestorPush (token);
 	skipToNextStatement (token);
 	parseSpecificationPart (token);
-	while (! isKeyword (token, KEYWORD_end))
+	while (! isKeyword (token, KEYWORD_end) &&
+		   ! isType (token, TOKEN_EOF))
 		skipToNextStatement (token);
 	readSubToken (token);
 	/* secondary token should be KEYWORD_NONE or KEYWORD_block token */
@@ -2057,9 +2310,9 @@ static void parseInternalSubprogramPart (tokenInfo *const token)
 	{
 		switch (token->keyword)
 		{
-			case KEYWORD_function:   parseFunctionSubprogram (token);   break;
-			case KEYWORD_subroutine: parseSubroutineSubprogram (token); break;
-			case KEYWORD_end:        done = true;                       break;
+			case KEYWORD_function:
+			case KEYWORD_subroutine: parseSubprogram (token); break;
+			case KEYWORD_end:        done = true;             break;
 
 			default:
 				if (isSubprogramPrefix (token))
@@ -2070,7 +2323,57 @@ static void parseInternalSubprogramPart (tokenInfo *const token)
 					readToken (token);
 				break;
 		}
-	} while (! done);
+	} while (! done && ! isType (token, TOKEN_EOF));
+}
+
+/* submodule is
+ *     submodule-stmt (is SUBMODULE ( parent-identifier ) submodule-name)
+ *          [specification-part]
+ *          [module-subprogram-part]
+ *          end-submodule-stmt (is END [SUBMODULE [submodule-name]])
+ *
+ * parent-identifier is
+ *     ancestor_module_name [ : parent_submodule_name ]*
+ *
+ * ------------------------------------------------------------------
+ * XL Fortran for AIX, V15.1.3
+ * Language Reference
+ * Program units and procedures
+ *   https://www.ibm.com/support/knowledgecenter/en/SSGH4D_15.1.3/com.ibm.xlf1513.aix.doc/language_ref/submodules.html
+ * -------------------------------------------------------------------
+ */
+static vString *parserParentIdentifierOfSubmoduleStatement (tokenInfo *const token)
+{
+	vString *parentId;
+
+	if (!isType (token, TOKEN_PAREN_OPEN))
+		return NULL;
+
+	parentId = vStringNew();
+
+	while (1)
+	{
+		readToken (token);
+		if (isType (token, TOKEN_IDENTIFIER))
+			vStringCat (parentId, token->string);
+		else if (isType (token, TOKEN_COLON))
+			vStringPut (parentId, ':');
+		else if (isType (token, TOKEN_PAREN_CLOSE))
+			break;
+		else
+		{
+			/* Unexpected token (including EOF) */
+			vStringClear (parentId);
+			break;
+		}
+	}
+
+	if (vStringLength (parentId) == 0)
+	{
+		vStringDelete (parentId);
+		parentId = NULL;
+	}
+	return parentId;
 }
 
 /*  module is
@@ -2088,26 +2391,52 @@ static void parseInternalSubprogramPart (tokenInfo *const token)
  *      is function-subprogram
  *      or subroutine-subprogram
  */
-static void parseModule (tokenInfo *const token)
+static void parseModule (tokenInfo *const token, bool isSubmodule)
 {
-	Assert (isKeyword (token, KEYWORD_module));
+	vString *parentIdentifier = NULL;
+
+	Assert (((!isSubmodule) && isKeyword (token, KEYWORD_module))
+			|| (isSubmodule && isKeyword (token, KEYWORD_submodule)));
+
+
+	if (isSubmodule)
+	{
+		readToken (token);
+		parentIdentifier = parserParentIdentifierOfSubmoduleStatement (token);
+		if (parentIdentifier == NULL)
+		{
+			/* Unexpected syntax */
+			skipToNextStatement (token);
+			return;
+		}
+	}
+
 	readToken (token);
 	if (isType (token, TOKEN_IDENTIFIER) || isType (token, TOKEN_KEYWORD))
 	{
 		token->type = TOKEN_IDENTIFIER;
-		makeFortranTag (token, TAG_MODULE);
+		if (isSubmodule)
+		{
+			attachParentType (token, parentIdentifier);
+			parentIdentifier = NULL;
+		}
+		makeFortranTag (token, isSubmodule? TAG_SUBMODULE: TAG_MODULE);
 	}
 	ancestorPush (token);
 	skipToNextStatement (token);
 	parseSpecificationPart (token);
 	if (isKeyword (token, KEYWORD_contains))
 		parseInternalSubprogramPart (token);
-	while (! isKeyword (token, KEYWORD_end))
+	while (! isKeyword (token, KEYWORD_end) &&
+		   ! isType (token, TOKEN_EOF))
 		skipToNextStatement (token);
 	readSubToken (token);
 	/* secondary token should be KEYWORD_NONE or KEYWORD_module token */
 	skipToNextStatement (token);
 	ancestorPop ();
+
+	if (parentIdentifier)
+		vStringDelete (parentIdentifier);
 }
 
 /*  execution-part
@@ -2126,7 +2455,7 @@ static bool parseExecutionPart (tokenInfo *const token)
 {
 	bool result = false;
 	bool done = false;
-	while (! done)
+	while (! done && ! isType (token, TOKEN_EOF))
 	{
 		switch (token->keyword)
 		{
@@ -2157,7 +2486,8 @@ static bool parseExecutionPart (tokenInfo *const token)
 					isSecondaryKeyword (token, KEYWORD_select) ||
 					isSecondaryKeyword (token, KEYWORD_where) ||
 					isSecondaryKeyword (token, KEYWORD_forall) ||
-					isSecondaryKeyword (token, KEYWORD_associate))
+					isSecondaryKeyword (token, KEYWORD_associate) ||
+					isSecondaryKeyword (token, KEYWORD_block))
 				{
 					skipToNextStatement (token);
 					result = true;
@@ -2170,18 +2500,47 @@ static bool parseExecutionPart (tokenInfo *const token)
 	return result;
 }
 
-static void parseSubprogram (tokenInfo *const token, const tagType tag)
+static void makeSignature (tokenInfo *const token, void* signature)
+{
+	if (isType (token, TOKEN_IDENTIFIER) || isType (token, TOKEN_KEYWORD))
+		vStringCat ((vString *)signature, token->string);
+	else if (isType (token, TOKEN_COMMA))
+		vStringCatS ((vString *)signature, ", ");
+}
+
+static vString* parseSignature (tokenInfo *const token)
+{
+	vString* signature = vStringNew ();
+
+	readToken (token);
+	if (isType (token, TOKEN_PAREN_OPEN))
+	{
+		vStringPut (signature, '(');
+		skipOverParensFull (token, makeSignature, signature);
+		vStringPut (signature, ')');
+	}
+	return signature;
+}
+
+static void parseSubprogramFull (tokenInfo *const token, const tagType tag)
 {
 	Assert (isKeyword (token, KEYWORD_program) ||
 			isKeyword (token, KEYWORD_function) ||
 			isKeyword (token, KEYWORD_subroutine));
 	readToken (token);
 	if (isType (token, TOKEN_IDENTIFIER) || isType (token, TOKEN_KEYWORD))
 	{
+		tokenInfo* name = newTokenFrom (token);
 		token->type = TOKEN_IDENTIFIER;
-		makeFortranTag (token, tag);
+		if (tag == TAG_SUBROUTINE ||
+			tag == TAG_PROTOTYPE)
+			name->signature = parseSignature (token);
+		makeFortranTag (name, tag);
+		ancestorPush (name);
+		deleteToken (name);
 	}
-	ancestorPush (token);
+	else
+		ancestorPush (token);
 	skipToNextStatement (token);
 	parseSpecificationPart (token);
 	parseExecutionPart (token);
@@ -2196,6 +2555,21 @@ static void parseSubprogram (tokenInfo *const token, const tagType tag)
 	ancestorPop ();
 }
 
+static tagType subprogramTagType (tokenInfo *const token)
+{
+	tagType result = TAG_UNDEFINED;
+
+	if (insideInterface ())
+		result = TAG_PROTOTYPE;
+	else if (isKeyword (token, KEYWORD_subroutine))
+		result = TAG_SUBROUTINE;
+	else if (isKeyword (token, KEYWORD_function))
+		result = TAG_FUNCTION;
+
+	Assert (result != TAG_UNDEFINED);
+
+	return result;
+}
 
 /*  function-subprogram is
  *      function-stmt (is [prefix] FUNCTION function-name etc.)
@@ -2208,21 +2582,16 @@ static void parseSubprogram (tokenInfo *const token, const tagType tag)
  *      is type-spec [RECURSIVE]
  *      or [RECURSIVE] type-spec
  */
-static void parseFunctionSubprogram (tokenInfo *const token)
-{
-	parseSubprogram (token, TAG_FUNCTION);
-}
-
 /*  subroutine-subprogram is
  *      subroutine-stmt (is [RECURSIVE] SUBROUTINE subroutine-name etc.)
  *          [specification-part]
  *          [execution-part]
  *          [internal-subprogram-part]
  *          end-subroutine-stmt (is END [SUBROUTINE [function-name]])
  */
-static void parseSubroutineSubprogram (tokenInfo *const token)
+static void parseSubprogram (tokenInfo *const token)
 {
-	parseSubprogram (token, TAG_SUBROUTINE);
+	parseSubprogramFull (token, subprogramTagType (token));
 }
 
 /*  main-program is
@@ -2234,7 +2603,7 @@ static void parseSubroutineSubprogram (tokenInfo *const token)
  */
 static void parseMainProgram (tokenInfo *const token)
 {
-	parseSubprogram (token, TAG_PROGRAM);
+	parseSubprogramFull (token, TAG_PROGRAM);
 }
 
 /*  program-unit
@@ -2254,10 +2623,11 @@ static void parseProgramUnit (tokenInfo *const token)
 		{
 			case KEYWORD_block:      parseBlockData (token);            break;
 			case KEYWORD_end:        skipToNextStatement (token);       break;
-			case KEYWORD_function:   parseFunctionSubprogram (token);   break;
-			case KEYWORD_module:     parseModule (token);               break;
+			case KEYWORD_function:
+			case KEYWORD_subroutine: parseSubprogram (token);           break;
+			case KEYWORD_submodule:  parseModule (token, true);         break;
+			case KEYWORD_module:     parseModule (token, false);        break;
 			case KEYWORD_program:    parseMainProgram (token);          break;
-			case KEYWORD_subroutine: parseSubroutineSubprogram (token); break;
 
 			default:
 				if (isSubprogramPrefix (token))
@@ -2271,88 +2641,56 @@ static void parseProgramUnit (tokenInfo *const token)
 				}
 				break;
 		}
-	} while (true);
+	} while (! isType (token, TOKEN_EOF));
 }
 
 static rescanReason findFortranTags (const unsigned int passCount)
 {
 	tokenInfo *token;
-	exception_t exception;
 	rescanReason rescan;
 
 	Assert (passCount < 3);
-	Parent = newToken ();
 	token = newToken ();
+
 	FreeSourceForm = (bool) (passCount > 1);
-	contextual_fake_count = 0;
 	Column = 0;
-	NewLine = true;
-	exception = (exception_t) setjmp (Exception);
-	if (exception == ExceptionEOF)
-		rescan = RESCAN_NONE;
-	else if (exception == ExceptionFixedFormat  &&  ! FreeSourceForm)
+	parseProgramUnit (token);
+	if (FreeSourceFormFound  &&  ! FreeSourceForm)
 	{
 		verbose ("%s: not fixed source form; retry as free source form\n",
 				getInputFileName ());
 		rescan = RESCAN_FAILED;
 	}
 	else
 	{
-		parseProgramUnit (token);
 		rescan = RESCAN_NONE;
 	}
 	ancestorClear ();
 	deleteToken (token);
-	deleteToken (Parent);
 
 	return rescan;
 }
 
-static void initializeFortran (const langType language)
+static void initialize (const langType language)
 {
 	Lang_fortran = language;
 }
 
-static void initializeF77 (const langType language)
-{
-	Lang_f77 = language;
-}
-
 extern parserDefinition* FortranParser (void)
 {
 	static const char *const extensions [] = {
-	"f90", "f95", "f03",
+		"f", "for", "ftn", "f77", "f90", "f95", "f03", "f08", "f15",
 #ifndef CASE_INSENSITIVE_FILENAMES
-	"F90", "F95", "F03",
+		"F", "FOR", "FTN", "F77", "F90", "F95", "F03", "F08", "F15",
 #endif
-	NULL
+		NULL
 	};
 	parserDefinition* def = parserNew ("Fortran");
-	def->kindTable  = FortranKinds;
-	def->kindCount  = ARRAY_SIZE (FortranKinds);
-	def->extensions = extensions;
-	def->parser2    = findFortranTags;
-	def->initialize = initializeFortran;
-	def->keywordTable = FortranKeywordTable;
-	def->keywordCount = ARRAY_SIZE (FortranKeywordTable);
-	return def;
-}
-
-extern parserDefinition* F77Parser (void)
-{
-	static const char *const extensions [] = {
-	"f", "for", "ftn", "f77",
-#ifndef CASE_INSENSITIVE_FILENAMES
-	"F", "FOR", "FTN", "F77",
-#endif
-	NULL
-	};
-	parserDefinition* def = parserNew ("F77");
-	def->kindTable  = FortranKinds;
+	def->kindTable      = FortranKinds;
 	def->kindCount  = ARRAY_SIZE (FortranKinds);
 	def->extensions = extensions;
 	def->parser2    = findFortranTags;
-	def->initialize = initializeF77;
+	def->initialize = initialize;
 	def->keywordTable = FortranKeywordTable;
 	def->keywordCount = ARRAY_SIZE (FortranKeywordTable);
 	return def;


Modified: meson.build
2 lines changed, 1 insertions(+), 1 deletions(-)
===================================================================
@@ -630,10 +630,10 @@ ctags = static_library('ctags',
 	'ctags/parsers/diff.c',
 	'ctags/parsers/erlang.c',
 	'ctags/parsers/flex.c',
+	'ctags/parsers/fortran.c',
 	'ctags/parsers/gdscript.c',
 	'ctags/parsers/geany_c.c',
 	'ctags/parsers/geany_docbook.c',
-	'ctags/parsers/geany_fortran.c',
 	'ctags/parsers/geany_lcpp.c',
 	'ctags/parsers/geany_lcpp.h',
 	'ctags/parsers/geany_markdown.c',


Modified: src/filetypes.c
2 lines changed, 1 insertions(+), 1 deletions(-)
===================================================================
@@ -136,7 +136,7 @@ static void init_builtin_filetypes(void)
 	FT_INIT( ASM,        ASM,          "ASM",              "Assembler",               SOURCE_FILE, COMPILED );
 	FT_INIT( BASIC,      FREEBASIC,    "FreeBasic",        NULL,                      SOURCE_FILE, COMPILED );
 	FT_INIT( FORTRAN,    FORTRAN,      "Fortran",          "Fortran (F90)",           SOURCE_FILE, COMPILED );
-	FT_INIT( F77,        F77,          "F77",              "Fortran (F77)",           SOURCE_FILE, COMPILED );
+	FT_INIT( F77,        FORTRAN,      "F77",              "Fortran (F77)",           SOURCE_FILE, COMPILED );
 	FT_INIT( GLSL,       C,            "GLSL",             NULL,                      SOURCE_FILE, COMPILED );
 	FT_INIT( CAML,       NONE,         "CAML",             "(O)Caml",                 SOURCE_FILE, COMPILED );
 	FT_INIT( PERL,       PERL,         "Perl",             NULL,                      SOURCE_FILE, SCRIPT   );


Modified: src/tagmanager/tm_ctags.c
2 lines changed, 1 insertions(+), 1 deletions(-)
===================================================================
@@ -342,7 +342,7 @@ static void rename_anon_tags(TMSourceFile *source_file)
 				 * we need to skip past the tags on the same scope and only
 				 * afterwards we get the nested tags.
 				 * */
-				if ((source_file->lang == TM_PARSER_F77 || source_file->lang == TM_PARSER_FORTRAN) &&
+				if (source_file->lang == TM_PARSER_FORTRAN &&
 					!inside_nesting && nested_scope_len == scope_len)
 					continue;
 


Modified: src/tagmanager/tm_parser.c
22 lines changed, 12 insertions(+), 10 deletions(-)
===================================================================
@@ -500,6 +500,9 @@ static TMParserMapGroup group_HASKELL[] = {
 	{_("Functions"), TM_ICON_METHOD, tm_tag_function_t},
 };
 
+#define map_UNUSED1 map_HASKELL
+#define group_UNUSED1 group_HASKELL
+
 static TMParserMapEntry map_CSHARP[] = {
 	{'c', tm_tag_class_t},       // class
 	{'d', tm_tag_macro_t},       // macro
@@ -590,25 +593,28 @@ static TMSubparserMapEntry subparser_HTML_javascript_map[] = {
 	{tm_tag_function_t, tm_tag_function_t},
 };
 
-static TMParserMapEntry map_F77[] = {
+static TMParserMapEntry map_FORTRAN[] = {
 	{'b', tm_tag_undef_t},       // blockData
 	{'c', tm_tag_macro_t},       // common
 	{'e', tm_tag_undef_t},       // entry
+	{'E', tm_tag_enum_t},        // enum
 	{'f', tm_tag_function_t},    // function
 	{'i', tm_tag_interface_t},   // interface
 	{'k', tm_tag_member_t},      // component
 	{'l', tm_tag_undef_t},       // label
 	{'L', tm_tag_undef_t},       // local
 	{'m', tm_tag_namespace_t},   // module
+	{'M', tm_tag_member_t},      // method
 	{'n', tm_tag_undef_t},       // namelist
+	{'N', tm_tag_enumerator_t},  // enumerator
 	{'p', tm_tag_struct_t},      // program
+	{'P', tm_tag_undef_t},       // prototype
 	{'s', tm_tag_method_t},      // subroutine
 	{'t', tm_tag_class_t},       // type
 	{'v', tm_tag_variable_t},    // variable
-	{'E', tm_tag_enum_t},        // enum
-	{'N', tm_tag_enumerator_t},  // enumerator
+	{'S', tm_tag_undef_t},       // submodule
 };
-static TMParserMapGroup group_F77[] = {
+static TMParserMapGroup group_FORTRAN[] = {
 	{_("Module"), TM_ICON_CLASS, tm_tag_namespace_t},
 	{_("Programs"), TM_ICON_CLASS, tm_tag_struct_t},
 	{_("Interfaces"), TM_ICON_STRUCT, tm_tag_interface_t},
@@ -620,9 +626,6 @@ static TMParserMapGroup group_F77[] = {
 	{_("Enums"), TM_ICON_STRUCT, tm_tag_enum_t},
 };
 
-#define map_FORTRAN map_F77
-#define group_FORTRAN group_F77
-
 static TMParserMapEntry map_MATLAB[] = {
 	{'f', tm_tag_function_t},  // function
 	{'s', tm_tag_struct_t},    // struct
@@ -986,7 +989,7 @@ static TMParserMap parser_map[] = {
 	MAP_ENTRY(HAXE),
 	MAP_ENTRY(REST),
 	MAP_ENTRY(HTML),
-	MAP_ENTRY(F77),
+	MAP_ENTRY(UNUSED1),
 	MAP_ENTRY(CUDA),
 	MAP_ENTRY(MATLAB),
 	MAP_ENTRY(VALA),
@@ -1269,7 +1272,7 @@ gboolean tm_parser_is_anon_name(TMParserType lang, gchar *name)
 		return TRUE;
 	else if (lang == TM_PARSER_C || lang == TM_PARSER_CPP)  /* legacy Geany tags files */
 		return sscanf(name, "anon_%*[a-z]_%u%c", &i, &dummy) == 1;
-	else if (lang == TM_PARSER_FORTRAN || lang == TM_PARSER_F77)  /* legacy Geany tags files */
+	else if (lang == TM_PARSER_FORTRAN)  /* legacy Geany tags files */
 	{
 		return sscanf(name, "Structure#%u%c", &i, &dummy) == 1 ||
 			sscanf(name, "Interface#%u%c", &i, &dummy) == 1 ||
@@ -1503,7 +1506,6 @@ gboolean tm_parser_has_full_scope(TMParserType lang)
 		case TM_PARSER_ASCIIDOC:
 		case TM_PARSER_CONF:
 		case TM_PARSER_ERLANG:
-		case TM_PARSER_F77:
 		case TM_PARSER_FORTRAN:
 		case TM_PARSER_OBJC:
 		case TM_PARSER_REST:


Modified: src/tagmanager/tm_parser.h
2 lines changed, 1 insertions(+), 1 deletions(-)
===================================================================
@@ -89,7 +89,7 @@ enum
 	TM_PARSER_HAXE,
 	TM_PARSER_REST,
 	TM_PARSER_HTML,
-	TM_PARSER_F77,
+	TM_PARSER_UNUSED1,  /* dummy entry, replace with some new parser */
 	TM_PARSER_CUDA,
 	TM_PARSER_MATLAB,
 	TM_PARSER_VALA,


Modified: src/tagmanager/tm_parsers.h
2 lines changed, 1 insertions(+), 1 deletions(-)
===================================================================
@@ -45,7 +45,7 @@
 	HaxeParser,\
 	RstParser, \
 	HtmlParser, \
-	F77Parser, \
+	LiterateHaskellParser,  /* dummy entry, replace with some new parser */  \
 	CUDAParser, \
 	MatLabParser, \
 	ValaParser, \



--------------
This E-Mail was brought to you by github_commit_mail.py (Source: https://github.com/geany/infrastructure).


More information about the Commits mailing list