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

gcc/fortran/ChangeLog

+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.

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;
+}

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 (&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;
+
+}
+

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);
 }

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);

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.

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;

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;
     }

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  */

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/enum_1.f90

+! { 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

gcc/testsuite/gfortran.dg/enum_10.c

+/* 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 ();
+}

gcc/testsuite/gfortran.dg/enum_10.f90

+! { 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

gcc/testsuite/gfortran.dg/enum_2.f90

+! { 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

gcc/testsuite/gfortran.dg/enum_3.f90

+! { 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

gcc/testsuite/gfortran.dg/enum_4.f90

+! { 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 "" }

gcc/testsuite/gfortran.dg/enum_5.f90

+! { 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 "" }

gcc/testsuite/gfortran.dg/enum_6.f90

+! { 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        

gcc/testsuite/gfortran.dg/enum_7.f90

+! { 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        

gcc/testsuite/gfortran.dg/enum_8.f90

+! { 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

gcc/testsuite/gfortran.dg/enum_9.f90

+! { 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

gcc/testsuite/gfortran.fortran-torture/compile/enum_1.f90

+! 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

gcc/testsuite/gfortran.fortran-torture/execute/enum_1.f90

+! 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

gcc/testsuite/gfortran.fortran-torture/execute/enum_2.f90

+! 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

gcc/testsuite/gfortran.fortran-torture/execute/enum_3.f90

+! 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

gcc/testsuite/gfortran.fortran-torture/execute/enum_4.f90

+! 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