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.
testsuite/
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@106246
138bc75d-0d04-0410-961f-
82ee72b054a4
+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.
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;
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;
+}
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;
}
}
+
+/* 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. */
*initp = NULL;
}
+ /* Maintain enumerator history. */
+ if (gfc_current_state () == COMP_ENUM)
+ create_enum_history (sym, init);
+
return SUCCESS;
}
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
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;
}
}
+ /* 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. */
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;
}
}
+ /* 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)
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. */
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;
}
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;
+
+}
+
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);
}
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;
int warn_std;
int allow_std;
int warn_nonstd_intrinsics;
+ int fshort_enums;
}
gfc_option_t;
/* 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);
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.
#include "tree-inline.h"
#include "gfortran.h"
+#include "target.h"
gfc_option_t gfc_option;
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;
}
case OPT_Wnonstd_intrinsics:
gfc_option.warn_nonstd_intrinsics = 1;
break;
+
+ case OPT_fshort_enums:
+ gfc_option.fshort_enums = 1;
+ break;
}
return result;
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. */
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;
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");
}
+/* 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(). */
st = next_statement ();
goto loop;
+ case ST_ENUM:
+ accept_statement (st);
+ parse_enum();
+ st = next_statement ();
+ goto loop;
+
default:
break;
}
{
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;
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 */
+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
--- /dev/null
+! { 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
--- /dev/null
+/* 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 ();
+}
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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 "" }
--- /dev/null
+! { 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 "" }
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! 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
--- /dev/null
+! 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
--- /dev/null
+! 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
--- /dev/null
+! 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
--- /dev/null
+! 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
OSDN Git Service
