diff options
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 34 | ||||
-rw-r--r-- | gcc/fortran/arith.c | 46 | ||||
-rw-r--r-- | gcc/fortran/decl.c | 265 | ||||
-rw-r--r-- | gcc/fortran/dump-parse-tree.c | 4 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 5 | ||||
-rw-r--r-- | gcc/fortran/lang.opt | 4 | ||||
-rw-r--r-- | gcc/fortran/options.c | 8 | ||||
-rw-r--r-- | gcc/fortran/parse.c | 67 | ||||
-rw-r--r-- | gcc/fortran/parse.h | 5 |
9 files changed, 434 insertions, 4 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2148c488720..46795ed60a6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,37 @@ +2005-10-30 Gaurav Gautam <gauravga@noida.hcltech.com> + Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> + + * arith.c (gfc_enum_initializer): New function. + (gfc_check_integer_range): Made extern. + * decl.c (enumerator_history): New typedef. + (last_initializer, enum_history, max_enum): New variables. + (create_enum_history, gfc_free_enum_history): New functions. + (add_init_expr_to_sym): Call create_enum_history if parsing ENUM. + (variable_decl): Modified to parse enumerator definition. + (match_attr_spec): Add PARAMETER attribute to ENUMERATORs. + (gfc_match_data_decl): Issues error, if match_type_spec do not + return desired return values. + (set_enum_kind, gfc_match_enum, gfc_match_enumerator_def): New + functions. + (gfc_match_end): Deal with END ENUM. + * gfortran.h (gfc_statement): ST_ENUM, ST_ENUMERATOR, ST_END_ENUM + added. + (symbol_attribute): Bit field for enumerator added. + (gfc_options): Add fshort_enums. + (gfc_enum_initializer, gfc_check_integer_range): Add prototypes. + * options.c: Include target.h + (gfc_init_options): Initialize fshort_enums. + (gfc_handle_option): Deal with fshort_enums. + * parse.c (decode_statement): Match ENUM and ENUMERATOR statement. + (gfc_ascii_statement): Deal with the enumerator statements. + (parse_enum): New function to parse enum construct. + (parse_spec): Added case ST_ENUM. + * parse.h (gfc_compile_state): COMP_ENUM added. + (gfc_match_enum, gfc_match_enumerator_def, gfc_free_enum_history): + Prototype added. + * symbol.c (gfc_copy_attr): Copy enumeration attribute. + * lang.opt (fshort-enums): Option added. + 2005-10-30 Francois-Xavier Coudert <coudert@clipper.ens.fr> * check.c (gfc_check_malloc, gfc_check_free): New functions. diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index e0c1f4b7e66..aac3cb4f390 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -339,7 +339,7 @@ gfc_arith_done_1 (void) the range of the kind. Returns ARITH_OK, ARITH_ASYMMETRIC or ARITH_OVERFLOW. */ -static arith +arith gfc_check_integer_range (mpz_t p, int kind) { arith result; @@ -2405,3 +2405,47 @@ gfc_hollerith2logical (gfc_expr * src, int kind) return result; } + +/* Returns an initializer whose value is one higher than the value of the + LAST_INITIALIZER argument. If that is argument is NULL, the + initializers value will be set to zero. The initializer's kind + will be set to gfc_c_int_kind. + + If -fshort-enums is given, the appropriate kind will be selected + later after all enumerators have been parsed. A warning is issued + here if an initializer exceeds gfc_c_int_kind. */ + +gfc_expr * +gfc_enum_initializer (gfc_expr *last_initializer, locus where) +{ + gfc_expr *result; + + result = gfc_get_expr (); + result->expr_type = EXPR_CONSTANT; + result->ts.type = BT_INTEGER; + result->ts.kind = gfc_c_int_kind; + result->where = where; + + mpz_init (result->value.integer); + + if (last_initializer != NULL) + { + mpz_add_ui (result->value.integer, last_initializer->value.integer, 1); + result->where = last_initializer->where; + + if (gfc_check_integer_range (result->value.integer, + gfc_c_int_kind) != ARITH_OK) + { + gfc_error ("Enumerator exceeds the C integer type at %C"); + return NULL; + } + } + else + { + /* Control comes here, if it's the very first enumerator and no + initializer has been given. It will be initialized to ZERO (0). */ + mpz_set_si (result->value.integer, 0); + } + + return result; +} diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 8c2895ed873..7516057bfee 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -43,6 +43,30 @@ static symbol_attribute current_attr; static gfc_array_spec *current_as; static int colon_seen; +/* Initializer of the previous enumerator. */ + +static gfc_expr *last_initializer; + +/* History of all the enumerators is maintained, so that + kind values of all the enumerators could be updated depending + upon the maximum initialized value. */ + +typedef struct enumerator_history +{ + gfc_symbol *sym; + gfc_expr *initializer; + struct enumerator_history *next; +} +enumerator_history; + +/* Header of enum history chain. */ + +static enumerator_history *enum_history = NULL; + +/* Pointer of enum history node containing largest initializer. */ + +static enumerator_history *max_enum = NULL; + /* gfc_new_block points to the symbol of a newly matched block. */ gfc_symbol *gfc_new_block; @@ -677,6 +701,63 @@ gfc_set_constant_character_len (int len, gfc_expr * expr) } } + +/* Function to create and update the enumumerator history + using the information passed as arguments. + Pointer "max_enum" is also updated, to point to + enum history node containing largest initializer. + + SYM points to the symbol node of enumerator. + INIT points to its enumerator value. */ + +static void +create_enum_history(gfc_symbol *sym, gfc_expr *init) +{ + enumerator_history *new_enum_history; + gcc_assert (sym != NULL && init != NULL); + + new_enum_history = gfc_getmem (sizeof (enumerator_history)); + + new_enum_history->sym = sym; + new_enum_history->initializer = init; + new_enum_history->next = NULL; + + if (enum_history == NULL) + { + enum_history = new_enum_history; + max_enum = enum_history; + } + else + { + new_enum_history->next = enum_history; + enum_history = new_enum_history; + + if (mpz_cmp (max_enum->initializer->value.integer, + new_enum_history->initializer->value.integer) < 0) + max_enum = new_enum_history; + } +} + + +/* Function to free enum kind history. */ + +void +gfc_free_enum_history(void) +{ + enumerator_history *current = enum_history; + enumerator_history *next; + + while (current != NULL) + { + next = current->next; + gfc_free (current); + current = next; + } + max_enum = NULL; + enum_history = NULL; +} + + /* Function called by variable_decl() that adds an initialization expression to a symbol. */ @@ -785,6 +866,10 @@ add_init_expr_to_sym (const char *name, gfc_expr ** initp, *initp = NULL; } + /* Maintain enumerator history. */ + if (gfc_current_state () == COMP_ENUM) + create_enum_history (sym, init); + return SUCCESS; } @@ -918,10 +1003,12 @@ variable_decl (int elem) match m; try t; gfc_symbol *sym; + locus old_locus; initializer = NULL; as = NULL; cp_as = NULL; + old_locus = gfc_current_locus; /* When we get here, we've just matched a list of attributes and maybe a type and a double colon. The next thing we expect to see @@ -938,8 +1025,17 @@ variable_decl (int elem) cp_as = gfc_copy_array_spec (as); else if (m == MATCH_ERROR) goto cleanup; + if (m == MATCH_NO) as = gfc_copy_array_spec (current_as); + else if (gfc_current_state () == COMP_ENUM) + { + gfc_error ("Enumerator cannot be array at %C"); + gfc_free_enum_history (); + m = MATCH_ERROR; + goto cleanup; + } + char_len = NULL; cl = NULL; @@ -1135,6 +1231,30 @@ variable_decl (int elem) } } + /* Check if we are parsing an enumeration and if the current enumerator + variable has an initializer or not. If it does not have an + initializer, the initialization value of the previous enumerator + (stored in last_initializer) is incremented by 1 and is used to + initialize the current enumerator. */ + if (gfc_current_state () == COMP_ENUM) + { + if (initializer == NULL) + initializer = gfc_enum_initializer (last_initializer, old_locus); + + if (initializer == NULL || initializer->ts.type != BT_INTEGER) + { + gfc_error("ENUMERATOR %L not initialized with integer expression", + &var_locus); + m = MATCH_ERROR; + gfc_free_enum_history (); + goto cleanup; + } + + /* Store this current initializer, for the next enumerator + variable to be parsed. */ + last_initializer = initializer; + } + /* Add the initializer. Note that it is fine if initializer is NULL here, because we sometimes also need to check if a declaration *must* have an initialization expression. */ @@ -1837,6 +1957,12 @@ match_attr_spec (void) d = (decl_types) gfc_match_strings (decls); if (d == DECL_NONE || d == DECL_COLON) break; + + if (gfc_current_state () == COMP_ENUM) + { + gfc_error ("Enumerator cannot have attributes %C"); + return MATCH_ERROR; + } seen[d]++; seen_at[d] = gfc_current_locus; @@ -1856,6 +1982,18 @@ match_attr_spec (void) } } + /* If we are parsing an enumeration and have enusured that no other + attributes are present we can now set the parameter attribute. */ + if (gfc_current_state () == COMP_ENUM) + { + t = gfc_add_flavor (¤t_attr, FL_PARAMETER, NULL, NULL); + if (t == FAILURE) + { + m = MATCH_ERROR; + goto cleanup; + } + } + /* No double colon, so assume that we've been looking at something else the whole time. */ if (d == DECL_NONE) @@ -2678,6 +2816,40 @@ contained_procedure (void) return 0; } +/* Set the kind of each enumerator. The kind is selected such that it is + interoperable with the corresponding C enumeration type, making + sure that -fshort-enums is honored. */ + +static void +set_enum_kind(void) +{ + enumerator_history *current_history = NULL; + int kind; + int i; + + if (max_enum == NULL || enum_history == NULL) + return; + + if (!gfc_option.fshort_enums) + return; + + i = 0; + do + { + kind = gfc_integer_kinds[i++].kind; + } + while (kind < gfc_c_int_kind + && gfc_check_integer_range (max_enum->initializer->value.integer, + kind) != ARITH_OK); + + current_history = enum_history; + while (current_history != NULL) + { + current_history->sym->ts.kind = kind; + current_history = current_history->next; + } +} + /* Match any of the various end-block statements. Returns the type of END to the caller. The END INTERFACE, END IF, END DO and END SELECT statements cannot be replaced by a single END statement. */ @@ -2783,6 +2955,15 @@ gfc_match_end (gfc_statement * st) eos_ok = 0; break; + case COMP_ENUM: + *st = ST_END_ENUM; + target = " enum"; + eos_ok = 0; + last_initializer = NULL; + set_enum_kind (); + gfc_free_enum_history (); + break; + default: gfc_error ("Unexpected END statement at %C"); goto cleanup; @@ -3742,3 +3923,87 @@ gfc_mod_pointee_as (gfc_array_spec *as) } return MATCH_YES; } + + +/* Match the enum definition statement, here we are trying to match + the first line of enum definition statement. + Returns MATCH_YES if match is found. */ + +match +gfc_match_enum (void) +{ + match m; + + m = gfc_match_eos (); + if (m != MATCH_YES) + return m; + + if (gfc_notify_std (GFC_STD_F2003, + "New in Fortran 2003: ENUM AND ENUMERATOR at %C") + == FAILURE) + return MATCH_ERROR; + + return MATCH_YES; +} + + +/* Match the enumerator definition statement. */ + +match +gfc_match_enumerator_def (void) +{ + match m; + int elem; + + gfc_clear_ts (¤t_ts); + + m = gfc_match (" enumerator"); + if (m != MATCH_YES) + return m; + + if (gfc_current_state () != COMP_ENUM) + { + gfc_error ("ENUM definition statement expected before %C"); + gfc_free_enum_history (); + return MATCH_ERROR; + } + + (¤t_ts)->type = BT_INTEGER; + (¤t_ts)->kind = gfc_c_int_kind; + + m = match_attr_spec (); + if (m == MATCH_ERROR) + { + m = MATCH_NO; + goto cleanup; + } + + elem = 1; + for (;;) + { + m = variable_decl (elem++); + if (m == MATCH_ERROR) + goto cleanup; + if (m == MATCH_NO) + break; + + if (gfc_match_eos () == MATCH_YES) + goto cleanup; + if (gfc_match_char (',') != MATCH_YES) + break; + } + + if (gfc_current_state () == COMP_ENUM) + { + gfc_free_enum_history (); + gfc_error ("Syntax error in ENUMERATOR definition at %C"); + m = MATCH_ERROR; + } + +cleanup: + gfc_free_array_spec (current_as); + current_as = NULL; + return m; + +} + diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 2d708f7efed..8068b10d35f 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -756,7 +756,9 @@ show_symtree (gfc_symtree * st) gfc_status ("symtree: %s Ambig %d", st->name, st->ambiguous); if (st->n.sym->ns != gfc_current_ns) - gfc_status (" from namespace %s", st->n.sym->ns->proc_name->name); + /* Do nothing + gfc_status (" from namespace %s", st->n.sym->ns->proc_name->name); */ + ; else gfc_show_symbol (st->n.sym); } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index feff5af3e81..083fc33f147 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -214,7 +214,7 @@ typedef enum ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE, ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT, - ST_NONE + ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_NONE } gfc_statement; @@ -1484,6 +1484,7 @@ typedef struct int warn_std; int allow_std; int warn_nonstd_intrinsics; + int fshort_enums; } gfc_option_t; @@ -1626,6 +1627,8 @@ void gfc_get_errors (int *, int *); /* arith.c */ void gfc_arith_init_1 (void); void gfc_arith_done_1 (void); +gfc_expr *gfc_enum_initializer (gfc_expr *, locus); +arith gfc_check_integer_range (mpz_t p, int kind); /* trans-types.c */ int gfc_validate_kind (bt, int, bool); diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index b44c38b34a1..66f79db3bee 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -189,4 +189,8 @@ std=legacy Fortran Accept extensions to support legacy code +fshort-enums +Fortran +Use the narrowest integer type possible for enumeration types + ; This comment is to ensure we retain the blank line above. diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 53e8ec7b419..ebce409ba94 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -32,6 +32,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA #include "tree-inline.h" #include "gfortran.h" +#include "target.h" gfc_option_t gfc_option; @@ -90,6 +91,9 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, gfc_option.warn_nonstd_intrinsics = 0; + /* -fshort-enums can be default on some targets. */ + gfc_option.fshort_enums = targetm.default_short_enums (); + return CL_Fortran; } @@ -517,6 +521,10 @@ gfc_handle_option (size_t scode, const char *arg, int value) case OPT_Wnonstd_intrinsics: gfc_option.warn_nonstd_intrinsics = 1; break; + + case OPT_fshort_enums: + gfc_option.fshort_enums = 1; + break; } return result; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 69459251f04..430d8f3761c 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -132,6 +132,7 @@ decode_statement (void) match (NULL, gfc_match_st_function, ST_STATEMENT_FUNCTION); match (NULL, gfc_match_data_decl, ST_DATA_DECL); + match (NULL, gfc_match_enumerator_def, ST_ENUMERATOR); /* Try to match a subroutine statement, which has the same optional prefixes that functions can have. */ @@ -205,6 +206,7 @@ decode_statement (void) match ("else", gfc_match_else, ST_ELSE); match ("else where", gfc_match_elsewhere, ST_ELSEWHERE); match ("else if", gfc_match_elseif, ST_ELSEIF); + match ("enum , bind ( c )", gfc_match_enum, ST_ENUM); if (gfc_match_end (&st) == MATCH_YES) return st; @@ -951,6 +953,15 @@ gfc_ascii_statement (gfc_statement st) case ST_LABEL_ASSIGNMENT: p = "LABEL ASSIGNMENT"; break; + case ST_ENUM: + p = "ENUM DEFINITION"; + break; + case ST_ENUMERATOR: + p = "ENUMERATOR DEFINITION"; + break; + case ST_END_ENUM: + p = "END ENUM"; + break; default: gfc_internal_error ("gfc_ascii_statement(): Bad statement code"); } @@ -1335,6 +1346,56 @@ parse_derived (void) +/* Parse an ENUM. */ + +static void +parse_enum (void) +{ + int error_flag; + gfc_statement st; + int compiling_enum; + gfc_state_data s; + int seen_enumerator = 0; + + error_flag = 0; + + push_state (&s, COMP_ENUM, gfc_new_block); + + compiling_enum = 1; + + while (compiling_enum) + { + st = next_statement (); + switch (st) + { + case ST_NONE: + unexpected_eof (); + break; + + case ST_ENUMERATOR: + seen_enumerator = 1; + accept_statement (st); + break; + + case ST_END_ENUM: + compiling_enum = 0; + if (!seen_enumerator) + { + gfc_error ("ENUM declaration at %C has no ENUMERATORS"); + error_flag = 1; + } + accept_statement (st); + break; + + default: + gfc_free_enum_history (); + unexpected_statement (st); + break; + } + } + pop_state (); +} + /* Parse an interface. We must be able to deal with the possibility of recursive interfaces. The parse_spec() subroutine is mutually recursive with parse_interface(). */ @@ -1540,6 +1601,12 @@ loop: st = next_statement (); goto loop; + case ST_ENUM: + accept_statement (st); + parse_enum(); + st = next_statement (); + goto loop; + default: break; } diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h index 1460ff301f6..193e1150674 100644 --- a/gcc/fortran/parse.h +++ b/gcc/fortran/parse.h @@ -30,7 +30,7 @@ typedef enum { COMP_NONE, COMP_PROGRAM, COMP_MODULE, COMP_SUBROUTINE, COMP_FUNCTION, COMP_BLOCK_DATA, COMP_INTERFACE, COMP_DERIVED, COMP_IF, COMP_DO, - COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS + COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM } gfc_compile_state; @@ -63,5 +63,8 @@ int gfc_check_do_variable (gfc_symtree *); try gfc_find_state (gfc_compile_state); gfc_state_data *gfc_enclosing_unit (gfc_compile_state *); const char *gfc_ascii_statement (gfc_statement); +match gfc_match_enum (void); +match gfc_match_enumerator_def (void); +void gfc_free_enum_history (void); #endif /* GFC_PARSE_H */ |