re PR fortran/42354 (Invalidly accepts C_LOC in init expressions)

gcc/fortran/:
2009-12-14  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/42354
	* expr.c (check_init_expr): Do not check for specification functions.

gcc/testsuite/:
2009-12-14  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/42354
	* gfortran.dg/iso_c_binding_init_expr.f03: New.
	* gfortran.dg/intrinsic_std_1.f90: Fixed expected error message.
	* gfortran.dg/function_kinds_5.f90: Likewise.
	* gfortran.dg/selected_char_kind_3.f90: Likewise.

From-SVN: r155234

7 files changed, 57 insertions, 34 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4fd3ff0..9319b73 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2009-12-14  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/42354
+	* expr.c (check_init_expr): Do not check for specification functions.
+
 2009-12-11 Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/42257
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 35918a6..72420ff 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2286,40 +2286,39 @@ check_init_expr (gfc_expr *e)
     case EXPR_FUNCTION:
       t = FAILURE;
 
-      if ((m = check_specification_function (e)) != MATCH_YES)
-	{
-	  gfc_intrinsic_sym* isym;
-          gfc_symbol* sym;
+      {
+	gfc_intrinsic_sym* isym;
+	gfc_symbol* sym;
 
-          sym = e->symtree->n.sym;
-	  if (!gfc_is_intrinsic (sym, 0, e->where)
-              || (m = gfc_intrinsic_func_interface (e, 0)) != MATCH_YES)
-	    {
-	      gfc_error ("Function '%s' in initialization expression at %L "
-			 "must be an intrinsic or a specification function",
-			 e->symtree->n.sym->name, &e->where);
-	      break;
-	    }
+	sym = e->symtree->n.sym;
+	if (!gfc_is_intrinsic (sym, 0, e->where)
+	    || (m = gfc_intrinsic_func_interface (e, 0)) != MATCH_YES)
+	  {
+	    gfc_error ("Function '%s' in initialization expression at %L "
+		       "must be an intrinsic function",
+		       e->symtree->n.sym->name, &e->where);
+	    break;
+	  }
 
-	  if ((m = check_conversion (e)) == MATCH_NO
-	      && (m = check_inquiry (e, 1)) == MATCH_NO
-	      && (m = check_null (e)) == MATCH_NO
-	      && (m = check_transformational (e)) == MATCH_NO
-	      && (m = check_elemental (e)) == MATCH_NO)
-	    {
-	      gfc_error ("Intrinsic function '%s' at %L is not permitted "
-			 "in an initialization expression",
-			 e->symtree->n.sym->name, &e->where);
-	      m = MATCH_ERROR;
-	    }
+	if ((m = check_conversion (e)) == MATCH_NO
+	    && (m = check_inquiry (e, 1)) == MATCH_NO
+	    && (m = check_null (e)) == MATCH_NO
+	    && (m = check_transformational (e)) == MATCH_NO
+	    && (m = check_elemental (e)) == MATCH_NO)
+	  {
+	    gfc_error ("Intrinsic function '%s' at %L is not permitted "
+		       "in an initialization expression",
+		       e->symtree->n.sym->name, &e->where);
+	    m = MATCH_ERROR;
+	  }
 
-	  /* Try to scalarize an elemental intrinsic function that has an
-	     array argument.  */
-          isym = gfc_find_function (e->symtree->n.sym->name);
-	  if (isym && isym->elemental
-		&& (t = scalarize_intrinsic_call (e)) == SUCCESS)
-	    break;
-	}
+	/* Try to scalarize an elemental intrinsic function that has an
+	   array argument.  */
+	isym = gfc_find_function (e->symtree->n.sym->name);
+	if (isym && isym->elemental
+	    && (t = scalarize_intrinsic_call (e)) == SUCCESS)
+	  break;
+      }
 
       if (m == MATCH_YES)
 	t = gfc_simplify_expr (e, 0);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f3b96e0..ddef45b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2009-12-14  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/42354
+	* gfortran.dg/iso_c_binding_init_expr.f03: New.
+	* gfortran.dg/intrinsic_std_1.f90: Fixed expected error message.
+	* gfortran.dg/function_kinds_5.f90: Likewise.
+	* gfortran.dg/selected_char_kind_3.f90: Likewise.
+
 2009-12-14  Dominique d'Humieres  <dominiq@lps.ens.fr>
 
 	* gfortran.dg/boz_15.f90: Fix typos.
diff --git a/gcc/testsuite/gfortran.dg/function_kinds_5.f90 b/gcc/testsuite/gfortran.dg/function_kinds_5.f90
index fde5bef1..e48484e 100644
--- a/gcc/testsuite/gfortran.dg/function_kinds_5.f90
+++ b/gcc/testsuite/gfortran.dg/function_kinds_5.f90
@@ -5,6 +5,6 @@
 !
 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
 !
-real (bad_kind(0d0)) function foo () ! { dg-error "must be an intrinsic or" }
+real (bad_kind(0d0)) function foo () ! { dg-error "must be an intrinsic function" }
   foo = real (kind (foo))
 end function
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_std_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_std_1.f90
index 8f406fe..9c97b7e 100644
--- a/gcc/testsuite/gfortran.dg/intrinsic_std_1.f90
+++ b/gcc/testsuite/gfortran.dg/intrinsic_std_1.f90
@@ -32,7 +32,7 @@ END SUBROUTINE implicit_type
 
 SUBROUTINE specification_expression
   CHARACTER(KIND=selected_char_kind("ascii")) :: x
-! { dg-error "specification function" "" { target "*-*-*" } 34 }
+! { dg-error "must be an intrinsic function" "" { target "*-*-*" } 34 }
 ! { dg-warning "Fortran 2003" "" { target "*-*-*" } 34 }
 END SUBROUTINE specification_expression
 
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_init_expr.f03 b/gcc/testsuite/gfortran.dg/iso_c_binding_init_expr.f03
new file mode 100644
index 0000000..840b60e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_init_expr.f03
@@ -0,0 +1,11 @@
+! { dg-do "compile" }
+! PR fortran/42354
+
+use iso_c_binding
+implicit none
+integer, target :: a
+type t
+  type(c_ptr) :: ptr = c_loc(a)    ! { dg-error "must be an intrinsic function" }
+end type t
+type(c_ptr) :: ptr2 = c_loc(a)     ! { dg-error "must be an intrinsic function" }
+end
diff --git a/gcc/testsuite/gfortran.dg/selected_char_kind_3.f90 b/gcc/testsuite/gfortran.dg/selected_char_kind_3.f90
index a7b7ae7..59bc18f 100644
--- a/gcc/testsuite/gfortran.dg/selected_char_kind_3.f90
+++ b/gcc/testsuite/gfortran.dg/selected_char_kind_3.f90
@@ -4,7 +4,7 @@
 ! Check that SELECTED_CHAR_KIND is rejected with -std=f95
 !
   implicit none
-  character(kind=selected_char_kind("ascii")) :: s ! { dg-error "must be an intrinsic or a specification function" }
+  character(kind=selected_char_kind("ascii")) :: s ! { dg-error "must be an intrinsic function" }
   s = "" ! { dg-error "has no IMPLICIT type" }
   print *, s
 end