OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/63363 (No diagnostic for passing function as actual argument to KIND)

Browse Source 
2014-12-22  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/63363
	* check.c (gfc_check_kind): Reject polymorphic and non-data arguments.

2014-12-22  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/63363
	* gfortran.dg/kind_1.f90: New.

From-SVN: r219027
This commit is contained in:
Janus Weil 2014-12-22 19:15:08 +01:00
parent f37f5fb81c
commit 0a6f14996a
4 changed files with 44 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

@ -1,3 +1,8 @@
2014-12-22 Janus Weil <janus@gcc.gnu.org>
PR fortran/63363
* check.c (gfc_check_kind): Reject polymorphic and non-data arguments.
2014-12-19 Janus Weil <janus@gcc.gnu.org>
PR fortran/64209

13
gcc/fortran/check.c
View File

@ -2531,13 +2531,20 @@ gfc_check_kill_sub (gfc_expr *pid, gfc_expr *sig, gfc_expr *status)
bool
gfc_check_kind (gfc_expr *x)
{
if (x->ts.type == BT_DERIVED)
if (x->ts.type == BT_DERIVED || x->ts.type == BT_CLASS)
{
gfc_error ("%qs argument of %qs intrinsic at %L must be a "
"non-derived type", gfc_current_intrinsic_arg[0]->name,
gfc_error ("%qs argument of %qs intrinsic at %L must be of "
"intrinsic type", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &x->where);
return false;
}
if (x->ts.type == BT_PROCEDURE)
{
gfc_error ("%qs argument of %qs intrinsic at %L must be a data entity",
gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
&x->where);
return false;
}
return true;
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2014-12-22 Janus Weil <janus@gcc.gnu.org>
PR fortran/63363
* gfortran.dg/kind_1.f90: New.
2014-12-22 Oleg Endo <olegendo@gcc.gnu.org>
PR target/52933

24
gcc/testsuite/gfortran.dg/kind_1.f90 Normal file
View File

@ -0,0 +1,24 @@
! { dg-do compile }
!
! PR 63363: No diagnostic for passing function as actual argument to KIND
!
! Contributed by Ian Harvey <ian_harvey@bigpond.com>
type :: t
end type
type(t) :: d
class(*), allocatable :: c
print *, KIND(d) ! { dg-error "must be of intrinsic type" }
print *, KIND(c) ! { dg-error "must be of intrinsic type" }
print *, KIND(f) ! { dg-error "must be a data entity" }
print *, KIND(f())
print *, KIND(s) ! { dg-error "must be a data entity" }
contains
FUNCTION f()
INTEGER(SELECTED_INT_KIND(4)) :: f
END FUNCTION
subroutine s
end subroutine
END