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

re PR fortran/46330 ([OOP] ICE after revision 166368)

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

	PR fortran/46330
	* trans-expr.c (gfc_trans_class_assign): Find 'vtab' symbol in correct
	namespace.


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

	PR fortran/46330
	* gfortran.dg/class_27.f03: New.

From-SVN: r166405
This commit is contained in:
Janus Weil 2010-11-06 18:58:11 +01:00
parent 4ee3b0139f
commit fbc7f9df71
4 changed files with 79 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 @@
2010-11-06 Janus Weil <janus@gcc.gnu.org>
PR fortran/46330
* trans-expr.c (gfc_trans_class_assign): Find 'vtab' symbol in correct
namespace.
2010-11-05 Janus Weil <janus@gcc.gnu.org>
PR fortran/45451

2
gcc/fortran/trans-expr.c
View file

@ -5925,7 +5925,7 @@ gfc_trans_class_assign (gfc_expr *expr1, gfc_expr *expr2, gfc_exec_op op)
gcc_assert (vtab);
rhs = gfc_get_expr ();
rhs->expr_type = EXPR_VARIABLE;
gfc_find_sym_tree (vtab->name, NULL, 1, &st);
gfc_find_sym_tree (vtab->name, vtab->ns, 1, &st);
rhs->symtree = st;
rhs->ts = vtab->ts;
}

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2010-11-06 Janus Weil <janus@gcc.gnu.org>
PR fortran/46330
* gfortran.dg/class_27.f03: New.
2010-11-06 Nicola Pero <nicola.pero@meta-innovation.com>
Fixed using the Objective-C 2.0 dot-syntax with self and super.

67
gcc/testsuite/gfortran.dg/class_27.f03 Normal file
View file

@ -0,0 +1,67 @@
! { dg-do compile }
!
! PR 46330: [4.6 Regression] [OOP] ICE after revision 166368
!
! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
! Taken from http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/76f99e7fd4f3e772
module type2_type
implicit none
type, abstract :: Type2
end type Type2
end module type2_type
module extended2A_type
use type2_type
implicit none
type, extends(Type2) :: Extended2A
real(kind(1.0D0)) :: coeff1 = 1.
contains
procedure :: setCoeff1 => Extended2A_setCoeff1
end type Extended2A
contains
function Extended2A_new(c1, c2) result(typePtr_)
real(kind(1.0D0)), optional, intent(in) :: c1
real(kind(1.0D0)), optional, intent(in) :: c2
type(Extended2A), pointer :: typePtr_
type(Extended2A), save, allocatable, target :: type_
allocate(type_)
typePtr_ => null()
if (present(c1)) call type_%setCoeff1(c1)
typePtr_ => type_
if ( .not.(associated (typePtr_))) then
stop 'Error initializing Extended2A Pointer.'
endif
end function Extended2A_new
subroutine Extended2A_setCoeff1(this,c1)
class(Extended2A) :: this
real(kind(1.0D0)), intent(in) :: c1
this% coeff1 = c1
end subroutine Extended2A_setCoeff1
end module extended2A_type
module type1_type
use type2_type
implicit none
type Type1
class(type2), pointer :: type2Ptr => null()
contains
procedure :: initProc => Type1_initProc
end type Type1
contains
function Type1_initProc(this) result(iError)
use extended2A_type
implicit none
class(Type1) :: this
integer :: iError
this% type2Ptr => extended2A_new()
if ( .not.( associated(this% type2Ptr))) then
iError = 1
write(*,'(A)') "Something Wrong."
else
iError = 0
endif
end function Type1_initProc
end module type1_type
! { dg-final { cleanup-modules "type2_type extended2A_type type1_type" } }