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

re PR fortran/89904 (ICE in gfortran starting with r270045)

Browse Source 
2019-04-04  Harald Anlauf  <anlauf@gmx.de>

	PR fortran/89004
	* check.c (gfc_check_transfer): Reject procedures as actual
	arguments for SOURCE and MOLD of TRANSFER intrinsic.

	PR fortran/89004
	* gfortran.dg/pr85797.f90: Adjust testcase.

From-SVN: r270150
This commit is contained in:
Harald Anlauf 2019-04-04 20:38:33 +00:00 committed by Harald Anlauf
parent 3a36c1806a
commit aace91e285
4 changed files with 40 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2019-04-04 Harald Anlauf <anlauf@gmx.de>
PR fortran/89004
* check.c (gfc_check_transfer): Reject procedures as actual
arguments for SOURCE and MOLD of TRANSFER intrinsic.
2019-04-03 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/68567

22
gcc/fortran/check.c
View File

@ -5544,6 +5544,26 @@ gfc_check_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
size_t source_size;
size_t result_size;
/* SOURCE shall be a scalar or array of any type. */
if (source->ts.type == BT_PROCEDURE
&& source->symtree->n.sym->attr.subroutine == 1)
{
gfc_error ("%<SOURCE%> argument of %<TRANSFER%> intrinsic at %L "
"must not be a %s", &source->where,
gfc_basic_typename (source->ts.type));
return false;
}
/* MOLD shall be a scalar or array of any type. */
if (mold->ts.type == BT_PROCEDURE
&& mold->symtree->n.sym->attr.subroutine == 1)
{
gfc_error ("%<MOLD%> argument of %<TRANSFER%> intrinsic at %L "
"must not be a %s", &mold->where,
gfc_basic_typename (mold->ts.type));
return false;
}
if (mold->ts.type == BT_HOLLERITH)
{
gfc_error ("%<MOLD%> argument of %<TRANSFER%> intrinsic at %L must not be"
@ -5551,6 +5571,8 @@ gfc_check_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
return false;
}
/* SIZE (optional) shall be an integer scalar. The corresponding actual
argument shall not be an optional dummy argument. */
if (size != NULL)
{
if (!type_check (size, 2, BT_INTEGER))

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2019-04-04 Harald Anlauf <anlauf@gmx.de>
PR fortran/89004
* gfortran.dg/pr85797.f90: Adjust testcase.
2019-04-04 Paolo Carlini <paolo.carlini@oracle.com>
PR c++/65619

16
gcc/testsuite/gfortran.dg/pr85797.f90
View File

@ -1,29 +1,27 @@
! { dg-do compile }
! { dg-options "-Wall" }
! PR fortran/83515 - ICE: Invalid expression in gfc_element_size
! PR fortran/85797 - ICE in gfc_element_size, at fortran/target-memory.c:126
! PR fortran/89904 - ICE in gfortran starting with r270045
subroutine a
c = transfer (a, b) ! { dg-warning "Non-RECURSIVE procedure" }
recursive subroutine a
c = transfer (a, b) ! { dg-error "'SOURCE' argument of 'TRANSFER'" }
end
recursive subroutine d
c = transfer (d, b)
end
recursive subroutine e
k = transfer (transfer (e, e), 1)
c = transfer (b, d) ! { dg-error "'MOLD' argument of 'TRANSFER'" }
end
subroutine f
use, intrinsic :: iso_c_binding
integer(c_intptr_t) :: b, c
procedure(), pointer :: a
c = transfer (a, b)
c = transfer (transfer (b, a), b)
end
module m
contains
function f () result (z) ! { dg-warning "Return value" }
function f () result (z)
class(*), pointer :: z
end function f
recursive subroutine s (q)