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
This commit is contained in:
Daniel Franke 2009-12-14 14:10:56 -05:00 committed by Daniel Franke
parent 4e25ca6b30
commit 21779d2e10
7 changed files with 58 additions and 35 deletions

View 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

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

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

View 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

View 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

View File

@ -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

View 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