re PR fortran/25104 ([F2003] Non-initialization expr. as case-selector)

gcc/fortran:
2007-07-23  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/25104
	PR fortran/31639
	* expr.c (check_transformational): Reject valid transformational
	intrinsics to avoid ICE.
	(check_inquiry): Report error for assumed character lengths for
	all supported standards.
	(check_init_expr): Whitespace fix.

gcc/testsuite:
2007-07-23  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/31639
	* gfortran.dg/initialization_9.f90: New test.

From-SVN: r126858

4 files changed, 43 insertions, 6 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 04f2486..b896f98 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2007-07-23  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/25104
+	PR fortran/31639
+	* expr.c (check_transformational): Reject valid transformational
+	intrinsics to avoid ICE.
+	(check_inquiry): Report error for assumed character lengths for
+	all supported standards.
+	(check_init_expr): Whitespace fix.
+
 2007-07-23  Christopher D. Rickett  <crickett@lanl.gov>
 
 	PR fortran/32797
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 257349a..0028724 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1966,9 +1966,8 @@ check_inquiry (gfc_expr *e, int not_restricted)
 	    && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER
 	    && ap->expr->symtree->n.sym->ts.cl->length == NULL)
 	  {
-	    if (gfc_notify_std (GFC_STD_GNU, "assumed character length "
-				"variable '%s' in constant expression at %L",
-				e->symtree->n.sym->name, &e->where) == FAILURE)
+	    gfc_error ("assumed character length variable '%s' in constant "
+		       "expression at %L", e->symtree->n.sym->name, &e->where);
 	      return MATCH_ERROR;
 	  }
 	else if (not_restricted && check_init_expr (ap->expr) == FAILURE)
@@ -2007,11 +2006,23 @@ check_transformational (gfc_expr *e)
     if (strcmp (trans_func_f95[i], name) == 0)
       break;
 
+  /* FIXME, F2003: implement translation of initialization
+     expressions before enabling this check. For F95, error
+     out if the transformational function is not in the list.  */
+#if 0
   if (trans_func_f95[i] == NULL
       && gfc_notify_std (GFC_STD_F2003, 
 			 "transformational intrinsic '%s' at %L is not permitted "
 			 "in an initialization expression", name, &e->where) == FAILURE)
     return MATCH_ERROR;
+#else
+  if (trans_func_f95[i] == NULL)
+    {
+      gfc_error("transformational intrinsic '%s' at %L is not permitted "
+		"in an initialization expression", name, &e->where);
+      return MATCH_ERROR;
+    }
+#endif
 
   return check_init_expr_arguments (e);
 }
@@ -2150,19 +2161,19 @@ check_init_expr (gfc_expr *e)
 		gfc_error ("assumed size array '%s' at %L is not permitted "
 			   "in an initialization expression",
 			   e->symtree->n.sym->name, &e->where);
-	      break;
+		break;
 
 	      case AS_ASSUMED_SHAPE:
 		gfc_error ("assumed shape array '%s' at %L is not permitted "
 			   "in an initialization expression",
 			   e->symtree->n.sym->name, &e->where);
-	      break;
+		break;
 
 	      case AS_DEFERRED:
 		gfc_error ("deferred array '%s' at %L is not permitted "
 			   "in an initialization expression",
 			   e->symtree->n.sym->name, &e->where);
-	      break;
+		break;
 
 	      default:
 		gcc_unreachable();
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 923fe97..ce6a359 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-07-23  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31639
+	* gfortran.dg/initialization_9.f90: New test.
+
 2007-07-23  Christopher D. Rickett  <crickett@lanl.gov>
 
 	PR fortran/32797
diff --git a/gcc/testsuite/gfortran.dg/initialization_9.f90 b/gcc/testsuite/gfortran.dg/initialization_9.f90
new file mode 100644
index 0000000..5a82770
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_9.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR fortran/31639
+! Contributed by Martin Michlmayr <tbm AT cyrius DOT com>
+
+   integer function xstrcmp(s1)
+     character*(*), intent(in) :: s1
+     integer :: n1 = len(s1)            ! { dg-error "assumed character length variable" }
+     n1 = 1
+     return
+   end function xstrcmp