diff options
Diffstat (limited to 'gcc')
26 files changed, 849 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 */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a8178ab99c5..09b9ada1629 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,20 @@ +2005-10-30 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> + + * gfortran.dg/enum_10.f90, gfortran.dg/enum_10.c: New test. + +2005-10-30 Gaurav Gautam <gauravga@noida.hcltech.com> + + * gfortran.dg/enum_1.f90, gfortran.dg/enum_2.f90, + gfortran.dg/enum_3.f90, gfortran.dg/enum_4.f90, + gfortran.dg/enum_5.f90, gfortran.dg/enum_6.f90, + gfortran.dg/enum_7.f90, gfortran.dg/enum_8.f90, + gfortran.dg/enum_9.f90, + gfortran.fortran-torture/compile/enum_1.f90, + gfortran.fortran-torture/execute/enum_1.f90, + gfortran.fortran-torture/execute/enum_2.f90, + gfortran.fortran-torture/execute/enum_3.f90, + gfortran.fortran-torture/execute/enum_4.f90: New tests. + 2005-10-30 Hans-Peter Nilsson <hp@bitrange.com> PR target/18482 diff --git a/gcc/testsuite/gfortran.dg/enum_1.f90 b/gcc/testsuite/gfortran.dg/enum_1.f90 new file mode 100644 index 00000000000..1af5ab82f81 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/enum_1.f90 @@ -0,0 +1,11 @@ +! { dg-do run } +! Program to test ENUM parsing + +program main + implicit none + enum, bind (c) ! { dg-warning "New in Fortran 2003" } + enumerator :: red, black + enumerator blue + end enum + if (red /= 0) call abort +end program main diff --git a/gcc/testsuite/gfortran.dg/enum_10.c b/gcc/testsuite/gfortran.dg/enum_10.c new file mode 100644 index 00000000000..28beb12f821 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/enum_10.c @@ -0,0 +1,27 @@ +/* This testcase is meant to be compiled together with enum_10.f90 */ + +extern void abort (void); + +typedef enum + { MAX1 = 127 } onebyte; + +void f1_ (onebyte *i, int *j) +{ + if (*i != *j) abort (); +} + +typedef enum + { MAX2 = 32767 } twobyte; + +void f2_ (twobyte *i, int *j) +{ + if (*i != *j) abort (); +} + +typedef enum + { MAX4 = 2000000 } fourbyte; /* don't need the precise value. */ + +void f4_ (fourbyte *i, int *j) +{ + if (*i != *j) abort (); +} diff --git a/gcc/testsuite/gfortran.dg/enum_10.f90 b/gcc/testsuite/gfortran.dg/enum_10.f90 new file mode 100644 index 00000000000..c3fbe535c4f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/enum_10.f90 @@ -0,0 +1,61 @@ +! { dg-do run } +! { dg-additional-sources enum_10.c } +! { dg-options "-fshort-enums" } +! Make sure short enums are indeed interoperable with the +! corresponding C type. + +module enum_10 +enum, bind( c ) ! { dg-warning "New in Fortran 2003" } + enumerator :: one1 = 1, two1, max1 = huge(1_1) +end enum + +enum, bind( c ) ! { dg-warning "New in Fortran 2003" } + enumerator :: one2 = 1, two2, max2 = huge(1_2) +end enum + +enum, bind( c ) ! { dg-warning "New in Fortran 2003" } + enumerator :: one4 = 1, two4, max4 = huge(1_4) +end enum +end module enum_10 + +use enum_10 + +interface f1 + subroutine f1(i,j) + use enum_10 + integer (kind(max1)) :: i + integer :: j + end subroutine f1 +end interface + + +interface f2 + subroutine f2(i,j) + use enum_10 + integer (kind(max2)) :: i + integer :: j + end subroutine f2 +end interface + + +interface f4 + subroutine f4(i,j) + use enum_10 + integer (kind(max4)) :: i + integer :: j + end subroutine f4 +end interface + + +call f1 (one1, 1) +call f1 (two1, 2) +call f1 (max1, huge(1_1)+0) ! Adding 0 to get default integer + +call f2 (one2, 1) +call f2 (two2, 2) +call f2 (max2, huge(1_2)+0) + +call f4 (one4, 1) +call f4 (two4, 2) +call f4 (max4, huge(1_4)+0) +end diff --git a/gcc/testsuite/gfortran.dg/enum_2.f90 b/gcc/testsuite/gfortran.dg/enum_2.f90 new file mode 100644 index 00000000000..1fd72474dd3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/enum_2.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! Program to test ENUM parsing errors + +program main + implicit none + enum, bind (c) ! { dg-warning "New in Fortran 2003" } + enumerator :: red, black + integer :: x ! { dg-error "Unexpected data declaration" } + enumerator blue = 1 ! { dg-error "Syntax error in ENUMERATOR definition" } + end enum + + enumerator :: sun ! { dg-error "ENUM" } +end program main diff --git a/gcc/testsuite/gfortran.dg/enum_3.f90 b/gcc/testsuite/gfortran.dg/enum_3.f90 new file mode 100644 index 00000000000..3b01f93de31 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/enum_3.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! Program to test ENUM parsing errors + +program main + implicit none + enum, bind (c) ! { dg-warning "New in Fortran 2003" } + enumerator :: red, black = 2.2 ! { dg-error "initialized with integer expression" } + enumerator :: blue = "x" ! { dg-error "initialized with integer expression" } + end enum ! { dg-error "has no ENUMERATORS" } + +end program main diff --git a/gcc/testsuite/gfortran.dg/enum_4.f90 b/gcc/testsuite/gfortran.dg/enum_4.f90 new file mode 100644 index 00000000000..e3b13d7e73e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/enum_4.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! Program to test ENUM parsing errors + +program main + implicit none + enum, bind (c) ! { dg-warning "New in Fortran 2003" } + enumerator :: red, black = 2 + enumerator :: blue = 1, red ! { dg-error "already" } + end enum + + enum, bind (c) ! { dg-warning "New in Fortran 2003" } + enumerator :: r, b(10) = 2 ! { dg-error "cannot be array" } + enumerator , save :: g = 1 ! { dg-error "cannot have attributes" } + end ! { dg-error " END ENUM" } + +end program main ! { dg-excess-errors "" } diff --git a/gcc/testsuite/gfortran.dg/enum_5.f90 b/gcc/testsuite/gfortran.dg/enum_5.f90 new file mode 100644 index 00000000000..a095cfe1bf3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/enum_5.f90 @@ -0,0 +1,15 @@ +! { dg-do compile } +! Program to test ENUM parsing errors + +program main + implicit none + integer :: i = 1 + + enum, bind (c) ! { dg-warning "New in Fortran 2003" } + enumerator :: red, black = i ! { dg-error "cannot appear" } + enumerator :: blue = 1 + end enum junk ! { dg-error "Syntax error" } + + blue = 10 ! { dg-error "Expected VARIABLE" } + +end program main ! { dg-excess-errors "" } diff --git a/gcc/testsuite/gfortran.dg/enum_6.f90 b/gcc/testsuite/gfortran.dg/enum_6.f90 new file mode 100644 index 00000000000..0396862684f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/enum_6.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! Program to test ENUM parsing errors + +program main + implicit none + integer :: i = 1 + + enum, bind (c) ! { dg-warning "New in Fortran 2003" } + enumerator :: sun, mon = 2 + i = 2 ! { dg-error "Unexpected" } + enumerator :: wed = 1 + end enum + + i = 1 + + enum, bind (c) ! { dg-error "Unexpected" } + enumerator :: red, black = 2 ! { dg-error "ENUM definition statement expected" } + enumerator :: blue = 1 ! { dg-error "ENUM definition statement expected" } + end enum ! { dg-excess-errors "Expecting END PROGRAM" } + +end program main diff --git a/gcc/testsuite/gfortran.dg/enum_7.f90 b/gcc/testsuite/gfortran.dg/enum_7.f90 new file mode 100644 index 00000000000..d85e61d62f8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/enum_7.f90 @@ -0,0 +1,15 @@ +! { dg-do compile } +! Program to test ENUM parsing errors + +program main + implicit none + + enum, bind (c) ! { dg-warning "New in Fortran 2003" } + enumerator :: sun, mon = 2 + enum, bind (c) ! { dg-error "Unexpected" } + enumerator :: apple, mango + end enum + enumerator :: wed = 1 ! { dg-error "ENUM definition statement expected" } + end enum ! { dg-error "Expecting END PROGRAM" } + +end program main diff --git a/gcc/testsuite/gfortran.dg/enum_8.f90 b/gcc/testsuite/gfortran.dg/enum_8.f90 new file mode 100644 index 00000000000..686b12880c4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/enum_8.f90 @@ -0,0 +1,15 @@ +! { dg-do compile } +! Program to test the initialisation range of enumerators +! and kind values check + +program main + implicit none + enum, bind (c) ! { dg-warning "New in Fortran 2003" } + enumerator :: pp , qq = 4294967295, rr ! { dg-error "not initialized with integer" } + end enum ! { dg-error "has no ENUMERATORS" } + + enum, bind (c) ! { dg-warning "New in Fortran 2003" } + enumerator :: p , q = 4294967299_8, r ! { dg-error "Arithmetic overflow" } + end enum ! { dg-error "has no ENUMERATORS" } + +end program main diff --git a/gcc/testsuite/gfortran.dg/enum_9.f90 b/gcc/testsuite/gfortran.dg/enum_9.f90 new file mode 100644 index 00000000000..81c441aca2c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/enum_9.f90 @@ -0,0 +1,14 @@ +! { dg-do run } +! { dg-options "-fshort-enums" } +! Program to test enumerations when option -fshort-enums is given + +program main + implicit none + enum, bind (c) ! { dg-warning "New in Fortran 2003" } + enumerator :: red, black = 127 + enumerator blue + end enum + if (red /= 0) call abort + if (black /= 127) call abort + if (blue /= 128) call abort +end program main diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/enum_1.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/enum_1.f90 new file mode 100644 index 00000000000..7a6b424030c --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/enum_1.f90 @@ -0,0 +1,46 @@ +! Program to test parsing of ENUM in different program units + +program main + implicit none + interface + subroutine sub1 + end subroutine sub1 + end interface + integer :: i = 55 + + enum , bind (c) + enumerator :: a , b=5 + enumerator c, d + end enum + + call sub + call sub1 + i = fun() + +contains + + subroutine sub + enum, bind(c) + enumerator :: p = b, q = 10 + 50 + enumerator r, s + end enum + end subroutine sub + + function fun() + integer :: fun + enum, bind (c) + enumerator :: red, yellow = 23 + enumerator :: blue + enumerator :: green + end enum + fun = 1 + end function fun +end program main + +subroutine sub1 + implicit none + enum, bind(c) + enumerator x , y + enumerator :: z = 100 + end enum +end subroutine sub1 diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/enum_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/enum_1.f90 new file mode 100644 index 00000000000..838b70c38db --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/enum_1.f90 @@ -0,0 +1,28 @@ +! Program to test the default initialisation of enumerators + +program main + implicit none + + enum, bind (c) + enumerator :: red , yellow, blue + enumerator :: green + end enum + + enum, bind (c) + enumerator :: a , b , c = 10 + enumerator :: d + end enum + + + if (red /= 0 ) call abort + if (yellow /= 1) call abort + if (blue /= 2) call abort + if (green /= 3) call abort + + if (a /= 0 ) call abort + if (b /= 1) call abort + if (c /= 10) call abort + if (d /= 11) call abort + + +end program main diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/enum_2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/enum_2.f90 new file mode 100644 index 00000000000..d0acf6595c8 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/enum_2.f90 @@ -0,0 +1,29 @@ +! Program to test the incremental assignment of enumerators + +program main + implicit none + + enum, bind (c) + enumerator :: red = 4 , yellow, blue + enumerator green + end enum + + enum, bind (c) + enumerator :: sun = -10 , mon, tue + enumerator :: wed = 10, sat + end enum + + + if (red /= 4 ) call abort + if (yellow /= (red + 1)) call abort + if (blue /= (yellow + 1)) call abort + if (green /= (blue + 1)) call abort + + + if (sun /= -10 ) call abort + if (mon /= (sun + 1)) call abort + if (tue /= (mon + 1)) call abort + if (wed /= 10) call abort + if (sat /= (wed+1)) call abort + +end program main diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/enum_3.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/enum_3.f90 new file mode 100644 index 00000000000..71ab35d118b --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/enum_3.f90 @@ -0,0 +1,57 @@ +! Program to test the initialisation range of enumerators +! and kind values check + +program main + implicit none + + enum, bind (c) + enumerator :: red , yellow =255 , blue + end enum + + enum, bind (c) + enumerator :: r , y = 32767, b + end enum + + enum, bind (c) + enumerator :: aa , bb = 65535, cc + end enum + + enum, bind (c) + enumerator :: m , n = 2147483645, o + end enum + + + if (red /= 0 ) call abort + if (yellow /= 255) call abort + if (blue /= 256) call abort + + if (r /= 0 ) call abort + if (y /= 32767) call abort + if (b /= 32768) call abort + + if (kind (red) /= 4) call abort + if (kind (yellow) /= 4) call abort + if (kind (blue) /= 4) call abort + + if (kind(r) /= 4 ) call abort + if (kind(y) /= 4) call abort + if (kind(b) /= 4) call abort + + if (aa /= 0 ) call abort + if (bb /= 65535) call abort + if (cc /= 65536) call abort + + if (kind (aa) /= 4 ) call abort + if (kind (bb) /= 4) call abort + if (kind (cc) /= 4) call abort + + + if (m /= 0 ) call abort + if (n /= 2147483645) call abort + if (o /= 2147483646) call abort + + if (kind (m) /= 4 ) call abort + if (kind (n) /= 4) call abort + if (kind (o) /= 4) call abort + +end program main diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/enum_4.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/enum_4.f90 new file mode 100644 index 00000000000..ff329dc7d41 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/enum_4.f90 @@ -0,0 +1,19 @@ +! Program to test the default initialisation of enumerators inside different program unit + +module mod + implicit none + enum, bind (c) + enumerator :: red , yellow, blue + enumerator :: green + end enum +end module mod + +program main + use mod + implicit none + + if (red /= 0 ) call abort + if (yellow /= 1) call abort + if (blue /= 2) call abort + if (green /= 3) call abort +end program main |