Skip to content
Browse files

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.
  • Loading branch information...
1 parent 329b2cb commit 9520e7f7d7b7a9570db2feb165653ef1d68e547a @b4n b4n committed
View
105 tagmanager/ctags/fortran.c
@@ -65,6 +65,7 @@ typedef enum eKeywordId {
KEYWORD_assignment,
KEYWORD_associate,
KEYWORD_automatic,
+ KEYWORD_bind,
KEYWORD_block,
KEYWORD_byte,
KEYWORD_cexternal,
@@ -83,6 +84,8 @@ typedef enum eKeywordId {
KEYWORD_elemental,
KEYWORD_end,
KEYWORD_entry,
+ KEYWORD_enum,
+ KEYWORD_enumerator,
KEYWORD_equivalence,
KEYWORD_extends,
KEYWORD_external,
@@ -178,6 +181,8 @@ typedef enum eTagType {
TAG_SUBROUTINE,
TAG_DERIVED_TYPE,
TAG_VARIABLE,
+ TAG_ENUM,
+ TAG_ENUMERATOR,
TAG_COUNT /* must be last */
} tagType;
@@ -219,7 +224,9 @@ static kindOption FortranKinds [] = {
{ 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 @@ static const keywordDesc FortranKeywordTable [] = {
{ "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 @@ static const keywordDesc FortranKeywordTable [] = {
{ "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) ||
View
2 tests/ctags/Makefile.am
@@ -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 \
View
52 tests/ctags/enum.f90
@@ -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
View
46 tests/ctags/enum.f90.tags
@@ -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
View
55 tests/ctags/enumerators.f90
@@ -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
View
26 tests/ctags/enumerators.f90.tags
@@ -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

0 comments on commit 9520e7f

Please sign in to comment.
Something went wrong with that request. Please try again.