Index: array.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/array.c,v
retrieving revision 1.9
diff -u -b -u -r1.9 array.c
--- array.c	8 Nov 2004 14:56:37 -0000	1.9
+++ array.c	4 Dec 2004 22:13:44 -0000
@@ -1490,7 +1490,7 @@
   for (; p; p = p->next)
     {
       if (p->iterator != NULL
-	  && gfc_resolve_iterator (p->iterator) == FAILURE)
+	  && gfc_resolve_iterator (p->iterator, INTEGER_ONLY) == FAILURE)
 	t = FAILURE;
 
       if (gfc_resolve_expr (p->expr) == FAILURE)
Index: gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.44
diff -u -b -u -r1.44 gfortran.h
--- gfortran.h	2 Dec 2004 04:10:24 -0000	1.44
+++ gfortran.h	4 Dec 2004 22:13:45 -0000
@@ -96,7 +96,7 @@
 mstring;
 
 
-/* Flags to specify which standardi/extension contains a feature.  */
+/* Flags to specify which standard/extension contains a feature.  */
 #define GFC_STD_GNU                (1<<5)    /* GNU Fortran extension.  */
 #define GFC_STD_F2003             (1<<4)    /* New in F2003.  */
 /* Note that no features were obsoleted nor deleted in F2003.  */
@@ -1737,13 +1737,17 @@
 void gfc_free_statement (gfc_code *);
 void gfc_free_statements (gfc_code *);
 
+/* The following defined constants are used in gfc_resolve_iterator to
+   permit or disallow REAL iterators.  */
+#define INTEGER_ONLY	0
+#define REAL_OK		1
 /* resolve.c */
 try gfc_resolve_expr (gfc_expr *);
 void gfc_resolve (gfc_namespace *);
 int gfc_impure_variable (gfc_symbol *);
 int gfc_pure (gfc_symbol *);
 int gfc_elemental (gfc_symbol *);
-try gfc_resolve_iterator (gfc_iterator *);
+try gfc_resolve_iterator (gfc_iterator *, const int);
 try gfc_resolve_index (gfc_expr *, int);
 
 /* array.c */
Index: resolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.21
diff -u -b -u -r1.21 resolve.c
--- resolve.c	8 Nov 2004 14:56:39 -0000	1.21
+++ resolve.c	4 Dec 2004 22:13:49 -0000
@@ -2177,52 +2177,75 @@
    be of integer type.  */
 
 try
-gfc_resolve_iterator (gfc_iterator * iter)
+gfc_resolve_iterator (gfc_iterator * iter, const int type)
 {
 
-  if (gfc_resolve_expr (iter->var) == FAILURE)
+  if (gfc_resolve_expr (iter->var) == FAILURE 
+      || gfc_resolve_expr (iter->start) == FAILURE
+      || gfc_resolve_expr (iter->end) == FAILURE
+      || gfc_resolve_expr (iter->step) == FAILURE)
     return FAILURE;
 
-  if (iter->var->ts.type != BT_INTEGER || iter->var->rank != 0)
+  if (gfc_pure (NULL) && gfc_impure_variable (iter->var->symtree->n.sym))
     {
-      gfc_error ("Loop variable at %L must be a scalar INTEGER",
+      gfc_error ("Cannot assign to loop variable in PURE procedure at %L",
 		 &iter->var->where);
       return FAILURE;
     }
 
-  if (gfc_pure (NULL) && gfc_impure_variable (iter->var->symtree->n.sym))
+  if (iter->var->rank != 0)
     {
-      gfc_error ("Cannot assign to loop variable in PURE procedure at %L",
-		 &iter->var->where);
+      gfc_error ("Loop variable at %L must be a scalar", &iter->var->where);
       return FAILURE;
     }
 
-  if (gfc_resolve_expr (iter->start) == FAILURE)
+  if (iter->start->rank != 0)
+    {
+      gfc_error ("Start expression in DO loop at %L must be a scalar",
+		 &iter->start->where);
     return FAILURE;
+    }
 
-  if (iter->start->ts.type != BT_INTEGER || iter->start->rank != 0)
+  if (iter->end->rank != 0)
     {
-      gfc_error ("Start expression in DO loop at %L must be a scalar INTEGER",
-		 &iter->start->where);
+      gfc_error ("End expression in DO loop at %L must be a scalar",
+		 &iter->end->where);
       return FAILURE;
     }
 
-  if (gfc_resolve_expr (iter->end) == FAILURE)
+  if (iter->step->rank != 0)
+    {
+      gfc_error ("Step expression in DO loop at %L must be a scalar",
+		 &iter->step->where);
     return FAILURE;
+    }
 
-  if (iter->end->ts.type != BT_INTEGER || iter->end->rank != 0)
+  if (type == INTEGER_ONLY)
     {
-      gfc_error ("End expression in DO loop at %L must be a scalar INTEGER",
-		 &iter->end->where);
+      if (iter->var->ts.type != BT_INTEGER)
+	{
+	  gfc_error ("Loop variable at %L must be an INTEGER",
+		     &iter->var->where);
+	  return FAILURE;
+	}
+
+      if (iter->start->ts.type != BT_INTEGER)
+	{
+	  gfc_error ("Start expression in DO loop at %L must be an INTEGER",
+		     &iter->start->where);
       return FAILURE;
     }
 
-  if (gfc_resolve_expr (iter->step) == FAILURE)
+      if (iter->end->ts.type != BT_INTEGER)
+	{
+	  gfc_error ("End expression in DO loop at %L must be an INTEGER",
+		     &iter->end->where);
     return FAILURE;
+	}
 
-  if (iter->step->ts.type != BT_INTEGER || iter->step->rank != 0)
+      if (iter->step->ts.type != BT_INTEGER)
     {
-      gfc_error ("Step expression in DO loop at %L must be a scalar INTEGER",
+	  gfc_error ("Step expression in DO loop at %L must be an INTEGER",
 		 &iter->step->where);
       return FAILURE;
     }
@@ -2234,6 +2257,83 @@
 		 &iter->step->where);
       return FAILURE;
     }
+    }
+
+  if (type == REAL_OK)
+    {
+
+      /* Fortran 77 did not prohibit a REAL DO loop iterator.
+         Fortran 90 states that this is obsolescent.
+         Fortran 95 explicitly deletes a REAL DO loop iterator.  */
+      if (iter->var->ts.type == BT_REAL)
+	gfc_notify_std (GFC_STD_F95_DEL,
+                        "REAL DO loop iterator at %L is deleted in Fortran 95",
+			  &iter->var->where);
+
+      if (iter->var->ts.type != BT_INTEGER
+	  && iter->var->ts.type != BT_REAL)
+	{
+	  gfc_error ("Loop variable at %L must be an INTEGER or REAL",
+		     &iter->var->where);
+	  return FAILURE;
+	}
+
+      if (iter->start->ts.type != BT_INTEGER
+	  && iter->start->ts.type != BT_REAL)
+	{
+	  gfc_error ("Start expression in DO loop at %L must be an INTEGER or REAL",
+		     &iter->start->where);
+	  return FAILURE;
+	}
+
+      if (iter->end->ts.type != BT_INTEGER
+	  && iter->end->ts.type != BT_REAL)
+	{
+	  gfc_error ("End expression in DO loop at %L must be an INTEGER or REAL",
+		     &iter->end->where);
+	  return FAILURE;
+	}
+
+      if (iter->step->ts.type != BT_INTEGER
+          && iter->step->ts.type != BT_REAL)
+	{
+	  gfc_error ("Step expression in DO loop at %L must be an INTEGER or REAL",
+		     &iter->step->where);
+	  return FAILURE;
+	}
+
+      if (iter->step->expr_type == EXPR_CONSTANT)
+	{
+	  if (iter->step->ts.type == BT_INTEGER
+	      && mpz_cmp_ui (iter->step->value.integer, 0) == 0)
+	    {
+	      gfc_error ("Step expression in DO loop at %L cannot be zero",
+		         &iter->step->where);
+	      return FAILURE;
+	    }
+
+	  if (iter->step->ts.type == BT_REAL
+	      && mpfr_sgn (iter->step->value.real) == 0)
+	    {
+	      gfc_error ("Step expression in DO loop at %L cannot be zero",
+		         &iter->step->where);
+	      return FAILURE;
+	    }
+	}
+    }
+
+  /* start, end, and step must have the same kind type as var.  */
+  if (iter->start->ts.kind != iter->var->ts.kind
+      || iter->start->ts.type != iter->var->ts.type)
+    gfc_convert_type (iter->start, &iter->var->ts, 2);
+
+  if (iter->end->ts.kind != iter->var->ts.kind
+      || iter->end->ts.type != iter->var->ts.type)
+    gfc_convert_type (iter->end, &iter->var->ts, 2);
+
+  if (iter->step->ts.kind != iter->var->ts.kind
+      || iter->step->ts.type != iter->var->ts.type)
+    gfc_convert_type (iter->step, &iter->var->ts, 2);
 
   return SUCCESS;
 }
@@ -3723,7 +3823,7 @@
 
 	case EXEC_DO:
 	  if (code->ext.iterator != NULL)
-	    gfc_resolve_iterator (code->ext.iterator);
+	    gfc_resolve_iterator (code->ext.iterator, REAL_OK);
 	  break;
 
 	case EXEC_DO_WHILE:
@@ -4355,7 +4455,7 @@
 	}
       else
 	{
-	  if (gfc_resolve_iterator (&d->iter) == FAILURE)
+	  if (gfc_resolve_iterator (&d->iter, INTEGER_ONLY) == FAILURE)
 	    return FAILURE;
 
 	  if (d->iter.start->expr_type != EXPR_CONSTANT
Index: trans-stmt.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-stmt.c,v
retrieving revision 1.18
diff -u -b -u -r1.18 trans-stmt.c
--- trans-stmt.c	8 Nov 2004 14:56:41 -0000	1.18
+++ trans-stmt.c	4 Dec 2004 22:13:53 -0000
@@ -617,8 +617,7 @@
    TODO: Large loop counts
    The code above assumes the loop count fits into a signed integer kind,
    i.e. Does not work for loop counts > 2^31 for integer(kind=4) variables
-   We must support the full range.
-   TODO: Real type do variables.  */
+   We must support the full range.  */
 
 tree
 gfc_trans_do (gfc_code * code)
@@ -670,11 +669,16 @@
   /* Initialize loop count. This code is executed before we enter the
      loop body. We generate: count = (to + step - from) / step.  */
 
+  count = gfc_create_var (gfc_array_index_type, "count");
   tmp = fold (build2 (MINUS_EXPR, type, step, from));
   tmp = fold (build2 (PLUS_EXPR, type, to, tmp));
+  if (TREE_CODE (type) == INTEGER_TYPE)
   tmp = fold (build2 (TRUNC_DIV_EXPR, type, tmp, step));
-
-  count = gfc_create_var (type, "count");
+  else
+    {
+      tmp = fold (build2 (RDIV_EXPR, type, tmp, step));
+      tmp = fold (build1 (FIX_TRUNC_EXPR, gfc_array_index_type, tmp));
+    }
   gfc_add_modify_expr (&block, count, tmp);
 
   /* Initialize the DO variable: dovar = from.  */
@@ -717,7 +721,7 @@
   gfc_add_modify_expr (&body, dovar, tmp);
 
   /* Decrement the loop count.  */
-  tmp = build2 (MINUS_EXPR, type, count, gfc_index_one_node);
+  tmp = build2 (MINUS_EXPR, gfc_array_index_type, count, gfc_index_one_node);
   gfc_add_modify_expr (&body, count, tmp);
 
   /* End of loop body.  */