FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/41978 ([F03] ICE in gfc_conv_expr_descriptor for array PPC assignment)

Browse source 
2009-11-11  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41978
	* resolve.c (resolve_ref): Take care of procedure pointer component
	references.


2009-11-11  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41978
	* gfortran.dg/proc_ptr_comp_22.f90: New test.

From-SVN: r154107
This commit is contained in:
Janus Weil 2009-11-11 23:37:31 +01:00
parent 188a786d3b
commit ef2bbc8c9a
4 changed files with 45 additions and 1 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 @@
2009-11-11 Janus Weil <janus@gcc.gnu.org>
PR fortran/41978
* resolve.c (resolve_ref): Take care of procedure pointer component
references.
2009-11-06 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/41909

4
gcc/fortran/resolve.c
View file

@ -4275,7 +4275,9 @@ resolve_ref (gfc_expr *expr)
case REF_COMPONENT:
if (current_part_dimension || seen_part_dimension)
{
if (ref->u.c.component->attr.pointer)
/* F03:C614. */
if (ref->u.c.component->attr.pointer
|| ref->u.c.component->attr.proc_pointer)
{
gfc_error ("Component to the right of a part reference "
"with nonzero rank must not have the POINTER "

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2009-11-11 Janus Weil <janus@gcc.gnu.org>
PR fortran/41978
* gfortran.dg/proc_ptr_comp_22.f90: New test.
2009-11-11 H.J. Lu <hongjiu.lu@intel.com>
PR testsuite/42001

31
gcc/testsuite/gfortran.dg/proc_ptr_comp_22.f90 Normal file
View file

@ -0,0 +1,31 @@
! { dg-do compile }
!
! PR 41978: [F03] ICE in gfc_conv_expr_descriptor for array PPC assignment
!
! Contributed by Daniel Kraft <domob@gcc.gnu.org>
MODULE m
IMPLICIT NONE
TYPE t
PROCEDURE(myproc), POINTER, PASS :: myproc
END TYPE t
CONTAINS
INTEGER FUNCTION myproc (me)
CLASS(t), INTENT(IN) :: me
myproc = 42
END FUNCTION myproc
END MODULE m
PROGRAM main
USE m
IMPLICIT NONE
TYPE(t) :: arr(2)
arr%myproc => myproc ! { dg-error "must not have the POINTER attribute" }
END PROGRAM main
! { dg-final { cleanup-modules "m" } }