public inbox for gcc-bugs@sourceware.org
help / color / mirror / Atom feed
* [Bug fortran/55763] New: Issues with some simpler CLASS(*) programs
@ 2012-12-20 16:18 burnus at gcc dot gnu.org
  2012-12-20 16:30 ` [Bug fortran/55763] " burnus at gcc dot gnu.org
                   ` (23 more replies)
  0 siblings, 24 replies; 25+ messages in thread
From: burnus at gcc dot gnu.org @ 2012-12-20 16:18 UTC (permalink / raw)
  To: gcc-bugs


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=55763

             Bug #: 55763
           Summary: Issues with some simpler CLASS(*) programs
    Classification: Unclassified
           Product: gcc
           Version: 4.8.0
            Status: UNCONFIRMED
          Keywords: ice-on-valid-code, rejects-valid
          Severity: normal
          Priority: P3
         Component: fortran
        AssignedTo: unassigned@gcc.gnu.org
        ReportedBy: burnus@gcc.gnu.org
                CC: pault@gcc.gnu.org


There are some known bigger issues of CLASS(*) which are tracked elsewhere.

This is about simpler issues.



The following program by Reinhold Bader fails with a bogus:

  type is (integer)
           1
alloc_scalar_01_pos.f90:27.15:

  class default
               2
Error: The DEFAULT CASE at (1) cannot be followed by a second DEFAULT CASE at
(2)

!----------------------------
module mod_alloc_scalar_01
contains
  subroutine construct(this)
    class(*), allocatable, intent(out) :: this
    integer :: this_i
    this_i = 4
    allocate(this, source=this_i)
  end subroutine
end module

program alloc_scalar_01
  use mod_alloc_scalar_01
  implicit none
  class(*), allocatable :: mystuff

  call construct(mystuff)
  call construct(mystuff)

  select type(mystuff)
  type is (integer)
    if (mystuff == 4) then
      write(*,*) 'OK'
    else 
      write(*,*) 'FAIL 1'
    end if
  class default
    write(*,*) 'FAIL 2'
  end select
end program
!----------------------------


While the following program by the same author causes an ICE (segmentation
fault) at 

0x5573ac get_unique_type_string
        ../../gcc/fortran/class.c:447
0x557ef8 get_unique_hashed_string
        ../../gcc/fortran/class.c:470
0x558087 gfc_find_derived_vtab(gfc_symbol*)
        ../../gcc/fortran/class.c:1833
0x625d18 gfc_conv_procedure_call(gfc_se*, gfc_symbol*, gfc_actual_arglist*,
gfc_expr*, vec<tree_node*, va_gc, vl_embed>*)
        ../../gcc/fortran/trans-expr.c:4308


!----------------------------
module mod_alloc_scalar_02
contains
  subroutine construct(this)
    class(*), allocatable, intent(out) :: this
    integer :: this_i
    this_i = 4
    allocate(this, source=this_i)
  end subroutine
  subroutine out(this)
    class(*) :: this
    select type(this)
    type is (integer)
      if (this == 4) then
        write(*,*) 'OK'
      else 
        write(*,*) 'FAIL 1'
      end if
    class default
      write(*,*) 'FAIL 2'
    end select
  end subroutine
end module

program alloc_scalar_02
  use mod_alloc_scalar_02
  implicit none
  class(*), allocatable :: mystuff

  call construct(mystuff)
  call out(mystuff)
end program
!----------------------------



And the following MOVE_ALLOC code, which moves TYPE(integer) to CLASS(*) fails
with:

  call move_alloc(i2, i1)
                      1
Error: The FROM and TO arguments of the MOVE_ALLOC intrinsic at (1) must be of
the same kind 4/0

!----------------------------
program mvall_03
  implicit none
  integer, parameter :: n1 = 100, n2 = 200
  class(*), allocatable :: i1(:)
  integer, allocatable :: i2(:)

  allocate(real :: i1(n1))
  allocate(i2(n2))
  i2 = 2
  call move_alloc(i2, i1)
  if (size(i1) /= n2 .or. allocated(i2)) then
     write(*,*) 'FAIL'
  else
     write(*,*) 'OK'
  end if
end program
!----------------------------



And finally, the following program - again by Reinhold Bader - gives an ICE
(segfault) at
             vector_comp => field

0x62d477 gfc_trans_pointer_assignment(gfc_expr*, gfc_expr*)
        ../../gcc/fortran/trans-expr.c:6523

!----------------------------
  program change_field_type
    use, intrinsic :: iso_c_binding
    implicit none
    TYPE, BIND(C) :: scalar_vector
       REAL(kind=c_float) :: scalar
       REAL(kind=c_float) :: vec(3)
    END TYPE
    TYPE, BIND(C) :: scalar_vector_matrix
       REAL(kind=c_float) :: scalar
       REAL(kind=c_float) :: vec(3)
       REAL(kind=c_float) :: mat(3,3)
    END TYPE
    CLASS(*), ALLOCATABLE, TARGET :: one_d_field(:)
    real, pointer :: v1(:)

    allocate(one_d_field(3), &
             source = (/ scalar_vector( 1.0, (/ -1.0, 0.0, 1.0 /) ), &
                         scalar_vector( 1.1, (/ -1.2, 0.2, 0.9 /) ), &
                         scalar_vector( 1.2, (/ -1.4, 0.4, 0.8 /) )  /) )

    call extract_vec(one_d_field, 1, v1, 2)
    print *, v1
    deallocate(one_d_field)   ! v1 becomes undefined

    allocate(one_d_field(1), &
         source = (/ scalar_vector_matrix( 1.0, (/ -1.0, 0.0, 1.0 /), &
         reshape( (/ 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0 /), &
                 (/3, 3/) ) ) /) )

    call extract_vec(one_d_field, 2, v1, 1)
    print *, v1
    deallocate(one_d_field)   ! v1 becomes undefined
  contains
    subroutine extract_vec(field, tag, vector_comp, ic) 
        use, intrinsic :: iso_c_binding
        CLASS(*), TARGET :: field(:)
        REAL(kind=c_float), POINTER :: vector_comp(:)
        INTEGER(kind=c_int), value :: tag, ic

        type(scalar_vector), pointer :: sv(:)
        type(scalar_vector_matrix), pointer :: svm(:)

        select type (field)
        type is (real(c_float))
          vector_comp => field
        class default
          select case (tag)
          case (1)
             sv => field
             vector_comp => sv(:)%vec(ic)
          case (2)
             svm => field
             vector_comp => svm(:)%vec(ic)
          end select
        end select
    end subroutine
  end program
!----------------------------


^ permalink raw reply	[flat|nested] 25+ messages in thread
end of thread, other threads:[~2013-01-07 18:37 UTC | newest]

Thread overview: 25+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2012-12-20 16:18 [Bug fortran/55763] New: Issues with some simpler CLASS(*) programs burnus at gcc dot gnu.org
2012-12-20 16:30 ` [Bug fortran/55763] " burnus at gcc dot gnu.org
2012-12-21 14:29 ` pault at gcc dot gnu.org
2012-12-21 14:32 ` pault at gcc dot gnu.org
2012-12-21 14:43 ` burnus at gcc dot gnu.org
2012-12-21 16:52 ` pault at gcc dot gnu.org
2012-12-21 22:59 ` burnus at gcc dot gnu.org
2012-12-22 17:27 ` burnus at gcc dot gnu.org
2012-12-28 11:22 ` burnus at gcc dot gnu.org
2012-12-28 12:26 ` burnus at gcc dot gnu.org
2012-12-29 23:06 ` anlauf at gmx dot de
2013-01-01 14:09 ` burnus at gcc dot gnu.org
2013-01-03 12:55 ` burnus at gcc dot gnu.org
2013-01-03 13:03 ` burnus at gcc dot gnu.org
2013-01-03 15:44 ` burnus at gcc dot gnu.org
2013-01-03 16:54 ` burnus at gcc dot gnu.org
2013-01-03 23:51 ` burnus at gcc dot gnu.org
2013-01-04  8:58 ` burnus at gcc dot gnu.org
2013-01-04  9:00 ` burnus at gcc dot gnu.org
2013-01-04 23:58 ` anlauf at gmx dot de
2013-01-05 13:12 ` anlauf at gmx dot de
2013-01-06 15:34 ` burnus at gcc dot gnu.org
2013-01-07  8:36 ` burnus at gcc dot gnu.org
2013-01-07 18:31 ` burnus at gcc dot gnu.org
2013-01-07 18:37 ` burnus at gcc dot gnu.org

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).