Commit 25d8f0a2 by Tobias Schlüter

arith.c (gfc_enum_initializer): New function.

fortran/
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.

From-SVN: r106246
parent e8299ec2
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.
......
......@@ -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;
}
......@@ -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 (&current_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 (&current_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;
}
(&current_ts)->type = BT_INTEGER;
(&current_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;
}
......@@ -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);
}
......
......@@ -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);
......
......@@ -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.
......@@ -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;
......
......@@ -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;
}
......
......@@ -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 */
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
! { 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
/* 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 ();
}
! { 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
! { 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
! { 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
! { 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 "" }
! { 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 "" }
! { 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
! { 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
! { 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
! { 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
! 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
! 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
! 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
! 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
! 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment