gcc/fortran/:
authordfranke <dfranke@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 14 Dec 2009 19:10:56 +0000 (19:10 +0000)
committerdfranke <dfranke@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 14 Dec 2009 19:10:56 +0000 (19:10 +0000)
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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@155234 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/expr.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/function_kinds_5.f90
gcc/testsuite/gfortran.dg/intrinsic_std_1.f90
gcc/testsuite/gfortran.dg/iso_c_binding_init_expr.f03 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/selected_char_kind_3.f90

index 4fd3ff0..9319b73 100644 (file)
@@ -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
index 35918a6..72420ff 100644 (file)
@@ -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);
index f3b96e0..ddef45b 100644 (file)
@@ -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.
index fde5bef..e48484e 100644 (file)
@@ -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
index 8f406fe..9c97b7e 100644 (file)
@@ -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 (file)
index 0000000..840b60e
--- /dev/null
@@ -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
index a7b7ae7..59bc18f 100644 (file)
@@ -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