[geany/geany] 9520e7: Fortran: parse Fortran 2003 enums

Colomban Wendling git-noreply at xxxxx
Sun Feb 23 19:01:30 UTC 2014


Branch:      refs/heads/master
Author:      Colomban Wendling <ban at herbesfolles.org>
Committer:   Colomban Wendling <ban at herbesfolles.org>
Date:        Sun, 23 Feb 2014 19:01:30 UTC
Commit:      9520e7f7d7b7a9570db2feb165653ef1d68e547a
             https://github.com/geany/geany/commit/9520e7f7d7b7a9570db2feb165653ef1d68e547a

Log Message:
-----------
Fortran: parse Fortran 2003 enums

Allow for not-yet-standard enum naming using `:: name` syntax, see
http://docs.cray.com/books/S-3692-51/html-S-3692-51/z970507905n9123.html

Test cases contributed by Adam Hirst, thanks.


Modified Paths:
--------------
    tagmanager/ctags/fortran.c
    tests/ctags/Makefile.am
    tests/ctags/enum.f90
    tests/ctags/enum.f90.tags
    tests/ctags/enumerators.f90
    tests/ctags/enumerators.f90.tags

Modified: tagmanager/ctags/fortran.c
105 files changed, 90 insertions(+), 15 deletions(-)
===================================================================
@@ -65,6 +65,7 @@
 	KEYWORD_assignment,
 	KEYWORD_associate,
 	KEYWORD_automatic,
+	KEYWORD_bind,
 	KEYWORD_block,
 	KEYWORD_byte,
 	KEYWORD_cexternal,
@@ -83,6 +84,8 @@
 	KEYWORD_elemental,
 	KEYWORD_end,
 	KEYWORD_entry,
+	KEYWORD_enum,
+	KEYWORD_enumerator,
 	KEYWORD_equivalence,
 	KEYWORD_extends,
 	KEYWORD_external,
@@ -178,6 +181,8 @@
 	TAG_SUBROUTINE,
 	TAG_DERIVED_TYPE,
 	TAG_VARIABLE,
+	TAG_ENUM,
+	TAG_ENUMERATOR,
 	TAG_COUNT  /* must be last */
 } tagType;
 
@@ -219,7 +224,9 @@
 	{ TRUE,  'p', "struct",	"programs"},
 	{ TRUE,  's', "method",	"subroutines"},
 	{ TRUE,  't', "class",	"derived types and structures"},
-	{ TRUE,  'v', "variable",	"program (global) and module variables"}
+	{ TRUE,  'v', "variable",	"program (global) and module variables"},
+	{ TRUE,  'E', "enum",	"enumerations"},
+	{ TRUE,  'F', "enumerator",	"enumeration values"},
 };
 
 /* For efinitions of Fortran 77 with extensions:
@@ -236,6 +243,7 @@
 	{ "assignment",     KEYWORD_assignment   },
 	{ "associate",      KEYWORD_associate    },
 	{ "automatic",      KEYWORD_automatic    },
+	{ "bind",           KEYWORD_bind         },
 	{ "block",          KEYWORD_block        },
 	{ "byte",           KEYWORD_byte         },
 	{ "cexternal",      KEYWORD_cexternal    },
@@ -254,6 +262,8 @@
 	{ "elemental",      KEYWORD_elemental    },
 	{ "end",            KEYWORD_end          },
 	{ "entry",          KEYWORD_entry        },
+	{ "enum",           KEYWORD_enum         },
+	{ "enumerator",     KEYWORD_enumerator   },
 	{ "equivalence",    KEYWORD_equivalence  },
 	{ "extends",        KEYWORD_extends      },
 	{ "external",       KEYWORD_external     },
@@ -368,7 +378,8 @@ static const tokenInfo* ancestorScope (void)
 	{
 		tokenInfo *const token = Ancestors.list + i - 1;
 		if (token->type == TOKEN_IDENTIFIER &&
-			token->tag != TAG_UNDEFINED  && token->tag != TAG_INTERFACE)
+			token->tag != TAG_UNDEFINED  && token->tag != TAG_INTERFACE &&
+			token->tag != TAG_ENUM)
 			result = token;
 	}
 	return result;
@@ -1144,6 +1155,7 @@ static boolean isTypeSpec (tokenInfo *const token)
 		case KEYWORD_record:
 		case KEYWORD_type:
 		case KEYWORD_procedure:
+		case KEYWORD_enumerator:
 			result = TRUE;
 			break;
 		default:
@@ -1171,6 +1183,21 @@ static boolean isSubprogramPrefix (tokenInfo *const token)
 	return result;
 }
 
+static void parseKindSelector (tokenInfo *const token)
+{
+	if (isType (token, TOKEN_PAREN_OPEN))
+		skipOverParens (token);  /* skip kind-selector */
+	if (isType (token, TOKEN_OPERATOR) &&
+		strcmp (vStringValue (token->string), "*") == 0)
+	{
+		readToken (token);
+		if (isType (token, TOKEN_PAREN_OPEN))
+			skipOverParens (token);
+		else
+			readToken (token);
+	}
+}
+
 /*  type-spec
  *      is INTEGER [kind-selector]
  *      or REAL [kind-selector] is ( etc. )
@@ -1208,14 +1235,7 @@ static void parseTypeSpec (tokenInfo *const token)
 		case KEYWORD_real:
 		case KEYWORD_procedure:
 			readToken (token);
-			if (isType (token, TOKEN_PAREN_OPEN))
-				skipOverParens (token);  /* skip kind-selector */
-			if (isType (token, TOKEN_OPERATOR) &&
-				strcmp (vStringValue (token->string), "*") == 0)
-			{
-				readToken (token);
-				readToken (token);
-			}
+			parseKindSelector (token);
 			break;
 
 		case KEYWORD_double:
@@ -1246,6 +1266,10 @@ static void parseTypeSpec (tokenInfo *const token)
 				parseDerivedTypeDef (token);
 			break;
 
+		case KEYWORD_enumerator:
+			readToken (token);
+			break;
+
 		default:
 			skipToToken (token, TOKEN_STATEMENT_END);
 			break;
@@ -1333,11 +1357,12 @@ static tagType variableTagType (void)
 		const tokenInfo* const parent = ancestorTop ();
 		switch (parent->tag)
 		{
-			case TAG_MODULE:       result = TAG_VARIABLE;  break;
-			case TAG_DERIVED_TYPE: result = TAG_COMPONENT; break;
-			case TAG_FUNCTION:     result = TAG_LOCAL;     break;
-			case TAG_SUBROUTINE:   result = TAG_LOCAL;     break;
-			default:               result = TAG_VARIABLE;  break;
+			case TAG_MODULE:       result = TAG_VARIABLE;   break;
+			case TAG_DERIVED_TYPE: result = TAG_COMPONENT;  break;
+			case TAG_FUNCTION:     result = TAG_LOCAL;      break;
+			case TAG_SUBROUTINE:   result = TAG_LOCAL;      break;
+			case TAG_ENUM:         result = TAG_ENUMERATOR; break;
+			default:               result = TAG_VARIABLE;   break;
 		}
 	}
 	return result;
@@ -1791,6 +1816,54 @@ static void parseInterfaceBlock (tokenInfo *const token)
 	deleteToken (name);
 }
 
+/* enum-block
+ *      enum-stmt (is ENUM, BIND(C) [ :: type-alias-name ]
+ *                 or ENUM [ kind-selector ] [ :: ] [ type-alias-name ])
+ *          [ enum-body (is ENUMERATOR [ :: ] enumerator-list) ]
+ *      end-enum-stmt (is END ENUM)
+ */
+static void parseEnumBlock (tokenInfo *const token)
+{
+	tokenInfo *name = NULL;
+	Assert (isKeyword (token, KEYWORD_enum));
+	readToken (token);
+	if (isType (token, TOKEN_COMMA))
+	{
+		readToken (token);
+		if (isType (token, TOKEN_KEYWORD))
+			readToken (token);
+		if (isType (token, TOKEN_PAREN_OPEN))
+			skipOverParens (token);
+	}
+	parseKindSelector (token);
+	if (isType (token, TOKEN_DOUBLE_COLON))
+		readToken (token);
+	if (isType (token, TOKEN_IDENTIFIER))
+		name = newTokenFrom (token);
+	if (name == NULL)
+	{
+		name = newToken ();
+		name->type = TOKEN_IDENTIFIER;
+		name->tag = TAG_ENUM;
+	}
+	else
+		makeFortranTag (name, TAG_ENUM);
+	skipToNextStatement (token);
+	ancestorPush (name);
+	while (! isKeyword (token, KEYWORD_end))
+	{
+		if (isTypeSpec (token))
+			parseTypeDeclarationStmt (token);
+		else
+			skipToNextStatement (token);
+	}
+	readSubToken (token);
+	/* secondary token should be KEYWORD_enum token */
+	skipToNextStatement (token);
+	ancestorPop ();
+	deleteToken (name);
+}
+
 /*  entry-stmt is
  *      ENTRY entry-name [ ( dummy-arg-list ) ]
  */
@@ -1872,6 +1945,7 @@ static boolean parseDeclarationConstruct (tokenInfo *const token)
 	{
 		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(); */
 
@@ -2079,6 +2153,7 @@ static boolean parseExecutionPart (tokenInfo *const token)
 			case KEYWORD_end:
 				readSubToken (token);
 				if (isSecondaryKeyword (token, KEYWORD_do) ||
+					isSecondaryKeyword (token, KEYWORD_enum) ||
 					isSecondaryKeyword (token, KEYWORD_if) ||
 					isSecondaryKeyword (token, KEYWORD_select) ||
 					isSecondaryKeyword (token, KEYWORD_where) ||


Modified: tests/ctags/Makefile.am
2 files changed, 2 insertions(+), 0 deletions(-)
===================================================================
@@ -121,7 +121,9 @@ test_sources = \
 	directives.c					\
 	dopbl2.f						\
 	enum.c							\
+	enum.f90						\
 	enum.java						\
+	enumerators.f90					\
 	events.cs						\
 	extern_variable.h				\
 	forall_module.f90				\


Modified: tests/ctags/enum.f90
52 files changed, 52 insertions(+), 0 deletions(-)
===================================================================
@@ -0,0 +1,52 @@
+module Constants
+  implicit none
+
+  real, parameter :: pi = 4 * atan(1.0)
+  real, parameter :: E_e = 510998.91013
+
+  ! we now have enumerators in F2003/8, for the sake of interop with C
+  enum, bind(c) ! unnamed 1
+    enumerator :: red =1, blue, black =5
+    enumerator yellow
+    enumerator gold, silver, bronze
+    enumerator :: purple
+    enumerator :: pink, lavender
+  end enum
+
+  enum ! unnamed 2
+    enumerator :: a, b, c
+  end enum
+  
+  enum :: Named1
+    enumerator :: x1, y1, z1
+  end enum
+  
+  enum Named2
+    enumerator :: x2, y2, z2
+  end enum
+
+  enum(8) Named3
+    enumerator :: x3, y3, z3
+  end enum
+
+  enum*8 Named4
+    enumerator :: x4, y4, z4
+  end enum
+
+  enum(8) :: Named5
+    enumerator :: x5, y5, z5
+  end enum
+
+  enum*8 :: Named6
+    enumerator :: x6, y6, z6
+  end enum
+
+  enum, bind(c) :: Named7
+    enumerator :: x7, y7, z7
+  end enum
+
+  real, parameter :: hc = 12398.4193
+
+  public
+
+end module Constants


Modified: tests/ctags/enum.f90.tags
46 files changed, 46 insertions(+), 0 deletions(-)
===================================================================
@@ -0,0 +1,46 @@
+# format=tagmanager
+ConstantsÌ256Ö0
+E_eÌ16384ÎConstantsÖ0
+Named1Ì2ÎConstantsÖ0
+Named2Ì2ÎConstantsÖ0
+Named3Ì2ÎConstantsÖ0
+Named4Ì2ÎConstantsÖ0
+Named5Ì2ÎConstantsÖ0
+Named6Ì2ÎConstantsÖ0
+Named7Ì2ÎConstantsÖ0
+aÌ4ÎConstantsÖ0
+bÌ4ÎConstantsÖ0
+blackÌ4ÎConstantsÖ0
+blueÌ4ÎConstantsÖ0
+bronzeÌ4ÎConstantsÖ0
+cÌ4ÎConstantsÖ0
+goldÌ4ÎConstantsÖ0
+hcÌ16384ÎConstantsÖ0
+lavenderÌ4ÎConstantsÖ0
+piÌ16384ÎConstantsÖ0
+pinkÌ4ÎConstantsÖ0
+purpleÌ4ÎConstantsÖ0
+redÌ4ÎConstantsÖ0
+silverÌ4ÎConstantsÖ0
+x1Ì4ÎConstantsÖ0
+x2Ì4ÎConstantsÖ0
+x3Ì4ÎConstantsÖ0
+x4Ì4ÎConstantsÖ0
+x5Ì4ÎConstantsÖ0
+x6Ì4ÎConstantsÖ0
+x7Ì4ÎConstantsÖ0
+y1Ì4ÎConstantsÖ0
+y2Ì4ÎConstantsÖ0
+y3Ì4ÎConstantsÖ0
+y4Ì4ÎConstantsÖ0
+y5Ì4ÎConstantsÖ0
+y6Ì4ÎConstantsÖ0
+y7Ì4ÎConstantsÖ0
+yellowÌ4ÎConstantsÖ0
+z1Ì4ÎConstantsÖ0
+z2Ì4ÎConstantsÖ0
+z3Ì4ÎConstantsÖ0
+z4Ì4ÎConstantsÖ0
+z5Ì4ÎConstantsÖ0
+z6Ì4ÎConstantsÖ0
+z7Ì4ÎConstantsÖ0


Modified: tests/ctags/enumerators.f90
55 files changed, 55 insertions(+), 0 deletions(-)
===================================================================
@@ -0,0 +1,55 @@
+module Enums
+  real :: somevar
+
+  ! we now have enumerators in F2003/8, for the sake of interop with C
+  enum, bind(c) ! unnamed 1
+    enumerator :: red =1, blue
+    enumerator gold, silver, bronze
+    enumerator :: purple
+  end enum
+
+
+  ! here follow nonstandard enum declarations, which may become valid in a later standard
+  ! no real harm implementing these as long as valid stuff isn't broken
+  enum
+    enumerator :: no_c_binding
+  end enum
+
+  enum :: Colons
+    enumerator :: r
+  end enum
+
+  enum BodyPart
+    enumerator :: arm, leg
+  end enum
+
+  enum(8) Paren_kind
+    enumerator :: b
+  end enum
+
+  enum*8 Aster_kind
+    enumerator :: c
+  end enum
+
+  enum(8) :: Paren_colon
+    enumerator :: d
+  end enum
+
+  enum*8 :: Aster_colon
+    enumerator :: e
+  end enum
+
+  enum, bind(c) :: Name_colon
+    enumerator :: d
+  end enum
+
+  ! another entry to verify the parsing hasn't broken
+  real, parameter :: othervar
+
+contains
+
+  function Func(arg)
+  ! ...
+  end function Func
+
+end module Enums


Modified: tests/ctags/enumerators.f90.tags
26 files changed, 26 insertions(+), 0 deletions(-)
===================================================================
@@ -0,0 +1,26 @@
+# format=tagmanager
+Aster_colonÌ2ÎEnumsÖ0
+Aster_kindÌ2ÎEnumsÖ0
+BodyPartÌ2ÎEnumsÖ0
+ColonsÌ2ÎEnumsÖ0
+EnumsÌ256Ö0
+FuncÌ16ÎEnumsÖ0
+Name_colonÌ2ÎEnumsÖ0
+Paren_colonÌ2ÎEnumsÖ0
+Paren_kindÌ2ÎEnumsÖ0
+armÌ4ÎEnumsÖ0
+bÌ4ÎEnumsÖ0
+blueÌ4ÎEnumsÖ0
+bronzeÌ4ÎEnumsÖ0
+cÌ4ÎEnumsÖ0
+dÌ4ÎEnumsÖ0
+eÌ4ÎEnumsÖ0
+goldÌ4ÎEnumsÖ0
+legÌ4ÎEnumsÖ0
+no_c_bindingÌ4ÎEnumsÖ0
+othervarÌ16384ÎEnumsÖ0
+purpleÌ4ÎEnumsÖ0
+rÌ4ÎEnumsÖ0
+redÌ4ÎEnumsÖ0
+silverÌ4ÎEnumsÖ0
+somevarÌ16384ÎEnumsÖ0



--------------
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