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

re PR fortran/46809 ([OOP] ICE with -fcheck=pointer for CLASS IS)

Browse source 
2010-12-12  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/46809
	* resolve.c (resolve_select_type): Set the location of the first
	argument when generating the EXTENDS_TYPE_OF call.

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

	PR fortran/46809
	* gfortran.dg/pointer_check_8.f90: New.

From-SVN: r167731
This commit is contained in:
Janus Weil 2010-12-12 22:14:13 +01:00
parent 4a10fb9416
commit 2c3d0cd388
4 changed files with 33 additions and 0 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 @@
2010-12-12 Janus Weil <janus@gcc.gnu.org>
PR fortran/46809
* resolve.c (resolve_select_type): Set the location of the first
argument when generating the EXTENDS_TYPE_OF call.
2010-12-11 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/46705

1
gcc/fortran/resolve.c
View file

@ -7893,6 +7893,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
/* Set up arguments. */
new_st->expr1->value.function.actual = gfc_get_actual_arglist ();
new_st->expr1->value.function.actual->expr = gfc_get_variable_expr (code->expr1->symtree);
new_st->expr1->value.function.actual->expr->where = code->loc;
gfc_add_vptr_component (new_st->expr1->value.function.actual->expr);
vtab = gfc_find_derived_vtab (body->ext.case_list->ts.u.derived);
st = gfc_find_symtree (vtab->ns->sym_root, vtab->name);

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2010-12-12 Janus Weil <janus@gcc.gnu.org>
PR fortran/46809
* gfortran.dg/pointer_check_8.f90: New.
2010-12-11 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/46705

21
gcc/testsuite/gfortran.dg/pointer_check_8.f90 Normal file
View file

@ -0,0 +1,21 @@
! { dg-do compile}
! { dg-options "-fcheck=pointer" }
!
! PR 46809: [OOP] ICE with -fcheck=pointer for CLASS IS
!
! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
type t
end type t
contains
subroutine sub(a)
class(t) :: a
select type (a)
class is (t)
print *, 'Hi there'
end select
end subroutine
end