Skip to content

Commit

Permalink
Merge pull request #406 from QingmingHe/fortran-enum
Browse files Browse the repository at this point in the history 
Parse Fortran 2003 enum
  • Loading branch information
@QingmingHe
QingmingHe committed Jul 31, 2015
2 parents 2ec7060 + 2635a2c commit d8f12a6
Show file tree
Hide file tree
Showing 3 changed files with 176 additions and 9 deletions.
45 changes: 45 additions & 0 deletions Units/parser-fortran.r/fortran-enum.d/expected.tags
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,45 @@
Constants input.f90 /^module Constants$/;" m
E_e input.f90 /^ real, parameter :: E_e /;" v module:Constants
Named1 input.f90 /^ enum :: Named1$/;" E module:Constants
Named2 input.f90 /^ enum Named2$/;" E module:Constants
Named3 input.f90 /^ enum(8) Named3$/;" E module:Constants
Named4 input.f90 /^ enum*8 Named4$/;" E module:Constants
Named5 input.f90 /^ enum(8) :: Named5$/;" E module:Constants
Named6 input.f90 /^ enum*8 :: Named6$/;" E module:Constants
Named7 input.f90 /^ enum, bind(c) :: Named7$/;" E module:Constants
a input.f90 /^ enumerat/;" N module:Constants
b input.f90 /^ enumerator :: a, b,/;" N module:Constants
black input.f90 /^ enumerator :: red =1, blue, black /;" N module:Constants
blue input.f90 /^ enumerator :: red =1, blue,/;" N module:Constants
bronze input.f90 /^ enumerator gold, silver, bronze$/;" N module:Constants
c input.f90 /^ enumerator :: a, b, c$/;" N module:Constants
gold input.f90 /^ enumerator gold,/;" N module:Constants
hc input.f90 /^ real, parameter :: hc /;" v module:Constants
lavender input.f90 /^ enumerator :: pink, lavender$/;" N module:Constants
pi input.f90 /^ real, parameter :: pi /;" v module:Constants
pink input.f90 /^ enumerator :: pink,/;" N module:Constants
purple input.f90 /^ enumerator :: purple$/;" N module:Constants
red input.f90 /^ enumerator :: red /;" N module:Constants
silver input.f90 /^ enumerator gold, silver,/;" N module:Constants
x1 input.f90 /^ enumerator :: x1,/;" N module:Constants
x2 input.f90 /^ enumerator :: x2,/;" N module:Constants
x3 input.f90 /^ enumerator :: x3,/;" N module:Constants
x4 input.f90 /^ enumerator :: x4,/;" N module:Constants
x5 input.f90 /^ enumerator :: x5,/;" N module:Constants
x6 input.f90 /^ enumerator :: x6,/;" N module:Constants
x7 input.f90 /^ enumerator :: x7,/;" N module:Constants
y1 input.f90 /^ enumerator :: x1, y1,/;" N module:Constants
y2 input.f90 /^ enumerator :: x2, y2,/;" N module:Constants
y3 input.f90 /^ enumerator :: x3, y3,/;" N module:Constants
y4 input.f90 /^ enumerator :: x4, y4,/;" N module:Constants
y5 input.f90 /^ enumerator :: x5, y5,/;" N module:Constants
y6 input.f90 /^ enumerator :: x6, y6,/;" N module:Constants
y7 input.f90 /^ enumerator :: x7, y7,/;" N module:Constants
yellow input.f90 /^ enumerator yellow$/;" N module:Constants
z1 input.f90 /^ enumerator :: x1, y1, z1$/;" N module:Constants
z2 input.f90 /^ enumerator :: x2, y2, z2$/;" N module:Constants
z3 input.f90 /^ enumerator :: x3, y3, z3$/;" N module:Constants
z4 input.f90 /^ enumerator :: x4, y4, z4$/;" N module:Constants
z5 input.f90 /^ enumerator :: x5, y5, z5$/;" N module:Constants
z6 input.f90 /^ enumerator :: x6, y6, z6$/;" N module:Constants
z7 input.f90 /^ enumerator :: x7, y7, z7$/;" N module:Constants
52 changes: 52 additions & 0 deletions Units/parser-fortran.r/fortran-enum.d/input.f90
View file
Original file line number Diff line number Diff line change
@@ -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
88 changes: 79 additions & 9 deletions parsers/fortran.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -81,6 +81,8 @@ typedef enum eKeywordId {
KEYWORD_elemental,
KEYWORD_end,
KEYWORD_entry,
KEYWORD_enum,
KEYWORD_enumerator,
KEYWORD_equivalence,
KEYWORD_extends,
KEYWORD_external,
Expand Down Expand Up @@ -172,6 +174,7 @@ typedef enum eTagType {
TAG_BLOCK_DATA,
TAG_COMMON_BLOCK,
TAG_ENTRY_POINT,
TAG_ENUM,
TAG_FUNCTION,
TAG_INTERFACE,
TAG_COMPONENT,
Expand All @@ -180,6 +183,7 @@ typedef enum eTagType {
TAG_MODULE,
TAG_METHOD,
TAG_NAMELIST,
TAG_ENUMERATOR,
TAG_PROGRAM,
TAG_PROTOTYPE,
TAG_SUBROUTINE,
Expand Down Expand Up @@ -226,6 +230,7 @@ static kindOption FortranKinds [] = {
{ TRUE, 'b', "block data", "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"},
Expand All @@ -234,6 +239,7 @@ static kindOption FortranKinds [] = {
{ 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"},
Expand Down Expand Up @@ -277,6 +283,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 },
Expand Down Expand Up @@ -400,7 +408,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;
Expand Down Expand Up @@ -1221,6 +1230,7 @@ static boolean isTypeSpec (tokenInfo *const token)
case KEYWORD_final:
case KEYWORD_generic:
case KEYWORD_class:
case KEYWORD_enumerator:
result = TRUE;
break;
default:
Expand Down Expand Up @@ -1248,6 +1258,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. )
Expand Down Expand Up @@ -1286,14 +1311,7 @@ static void parseTypeSpec (tokenInfo *const token)
case KEYWORD_procedure:
case KEYWORD_class:
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:
Expand Down Expand Up @@ -1326,6 +1344,7 @@ static void parseTypeSpec (tokenInfo *const token)

case KEYWORD_final:
case KEYWORD_generic:
case KEYWORD_enumerator:
readToken (token);
break;

Expand Down Expand Up @@ -1500,6 +1519,7 @@ static tagType variableTagType (tokenInfo *const st)
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;
}
}
Expand Down Expand Up @@ -2023,6 +2043,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 ) ]
*/
Expand Down Expand Up @@ -2104,6 +2172,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(); */

Expand Down Expand Up @@ -2324,6 +2393,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) ||
Expand Down

0 comments on commit d8f12a6

Please sign in to comment.