------- Comment #2 from ian at rhymneyconsulting dot co dot uk 2010-06-08 13:21 ------- Subject: RE: [OOP] ICE with polymorphic object oriented example
I should have included them with the bug report! Things are really progressing with the compiler. Well done! Out of the compilers Jane and I have access to The only one that compiles them is the nag compiler. Cheers Ian Chivers Files are Shape_p.f90 module shape_module type shape_type integer :: x_=0 integer :: y_=0 contains procedure , pass(this) :: getx procedure , pass(this) :: gety procedure , pass(this) :: setx procedure , pass(this) :: sety procedure , pass(this) :: moveto procedure , pass(this) :: draw end type shape_type interface assignment(=) module procedure generic_shape_assign end interface contains integer function getx(this) implicit none class (shape_type) , intent(in) :: this getx=this%x_ end function getx integer function gety(this) implicit none class (shape_type) , intent(in) :: this gety=this%y_ end function gety subroutine setx(this,x) implicit none class (shape_type), intent(inout) :: this integer , intent(in) :: x this%x_=x end subroutine setx subroutine sety(this,y) implicit none class (shape_type), intent(inout) :: this integer , intent(in) :: y this%y_=y end subroutine sety subroutine moveto(this,newx,newy) implicit none class (shape_type), intent(inout) :: this integer , intent(in) :: newx integer , intent(in) :: newy this%x_=newx this%y_=newy end subroutine moveto subroutine draw(this) implicit none class (shape_type), intent(in) :: this print *,' x = ' , this%x_ print *,' y = ' , this%y_ end subroutine draw subroutine generic_shape_assign(lhs,rhs) implicit none class (shape_type) , intent(out) , allocatable :: lhs class (shape_type) , intent(in) :: rhs print *,' In generic_shape_assign' if ( allocated(lhs) ) then deallocate(lhs) end if allocate(lhs,source=rhs) end subroutine generic_shape_assign end module shape_module Circle_p.f90 module circle_module use shape_module type , extends(shape_type) :: circle_type integer :: radius_ contains procedure , pass(this) :: getradius procedure , pass(this) :: setradius procedure , pass(this) :: draw => draw_circle end type circle_type contains integer function getradius(this) implicit none class (circle_type) , intent(in) :: this getradius=this%radius_ end function getradius subroutine setradius(this,radius) implicit none class (circle_type) , intent(inout) :: this integer , intent(in) :: radius this%radius_=radius end subroutine setradius subroutine draw_circle(this) implicit none class (circle_type), intent(in) :: this print *,' x = ' , this%x_ print *,' y = ' , this%y_ print *,' radius = ' , this%radius_ end subroutine draw_circle end module circle_module Rectangle_p.f90 module rectangle_module use shape_module type , extends(shape_type) :: rectangle_type integer :: width_ integer :: height_ contains procedure , pass(this) :: getwidth procedure , pass(this) :: setwidth procedure , pass(this) :: getheight procedure , pass(this) :: setheight procedure , pass(this) :: draw => draw_rectangle end type rectangle_type contains integer function getwidth(this) implicit none class (rectangle_type) , intent(in) :: this getwidth=this%width_ end function getwidth subroutine setwidth(this,width) implicit none class (rectangle_type) , intent(inout) :: this integer , intent(in) :: width this%width_=width end subroutine setwidth integer function getheight(this) implicit none class (rectangle_type) , intent(in) :: this getheight=this%height_ end function getheight subroutine setheight(this,height) implicit none class (rectangle_type) , intent(inout) :: this integer , intent(in) :: height this%height_=height end subroutine setheight subroutine draw_rectangle(this) implicit none class (rectangle_type), intent(in) :: this print *,' x = ' , this%x_ print *,' y = ' , this%y_ print *,' width = ' , this%width_ print *,' height = ' , this%height_ end subroutine draw_rectangle end module rectangle_module > -----Original Message----- > From: burnus at gcc dot gnu dot org [mailto:gcc-bugzi...@gcc.gnu.org] > Sent: 08 June 2010 14:01 > To: i...@rhymneyconsulting.co.uk > Subject: [Bug fortran/44465] [OOP] ICE with polymorphic object oriented > example > > > > ------- Comment #1 from burnus at gcc dot gnu dot org 2010-06-08 13:00 > ------- > (In reply to comment #0) > > c:\document\fortran\newbook\examples\ch32>gfortran shape_p.f90 > circle_p.f90 > > rectangle_p.f90 polymorph_array.f90 > > polymorph_array.f90: In function 'polymorphic': > > polymorph_array.f90:18:0: internal compiler error: Segmentation fault > > > > Do you want the shape_p.f90, circle_p.f90 and rectangle_p.f90 > > source files? > > Yes, please. Without it is difficult to reproduce the segfault. Please > attach > the modules (unless they are short, then you can also paste them) - > probably > best by putting all modules into a single file (rather than attaching > them one > by one, which is also fine). > > Thanks for the bug report! > > > -- > > burnus at gcc dot gnu dot org changed: > > What |Removed |Added > ----------------------------------------------------------------------- > ----- > CC| |janus at gcc dot gnu > dot org > Summary|polymorphic object oriented |[OOP] ICE with > polymorphic > |example |object oriented > example > > > http://gcc.gnu.org/bugzilla/show_bug.cgi?id=44465 > > ------- You are receiving this mail because: ------- > You reported the bug, or are watching the reporter. -- http://gcc.gnu.org/bugzilla/show_bug.cgi?id=44465