[Bug testsuite/58851] FAIL: gfortran.dg/unlimited_polymorphic_13.f90 -O0 execution test

["paul.richard.thomas at gmail dot com" <gcc-bugzilla@gcc.gnu.org>]

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

--- Comment #3 from paul.richard.thomas at gmail dot com <paul.richard.thomas at gmail dot com> ---
I had changed the testcase to:

! { dg-do run }
!
! PR fortran/58793
!
! Contributed by  Vladimir Fuka
!
! Had the wrong value for the storage_size for complex
!
module m
  use iso_fortran_env
  implicit none
  integer, parameter :: c1 = real_kinds(1)
  integer, parameter :: c2 = real_kinds(2)
  integer, parameter :: c3 = real_kinds(size(real_kinds)-1)
  integer, parameter :: c4 = real_kinds(size(real_kinds))
  real(c1) :: r1
  real(c2) :: r2
  real(c3) :: r3
  real(c4) :: r4
contains
 subroutine s(o, k)
    class(*) :: o
    integer :: k
    integer :: sz

    select case (k)
     case (4)
      sz = storage_size(r1)*2
     case (8)
      sz = storage_size(r2)*2
     case (10)
      sz = storage_size(r3)*2
     case (16)
      sz = storage_size(r4)*2
     case default
       call abort()
    end select

    if (storage_size(o) /= sz) call abort()
    select type (o)
      type is (complex(c1))
        if (storage_size(o) /= sz) call abort()
      type is (complex(c2))
        if (storage_size(o) /= sz) call abort()
      type is (complex(c3))
        if (storage_size(o) /= sz) call abort()
      type is (complex(c4))
        if (storage_size(o) /= sz) call abort()
    end select
  end subroutine s
end module m

program p
 use m
 call s((1._c1, 2._c1), c1)
 call s((1._c2, 2._c2), c2)
 call s((1._c3, 2._c3), c3)
 call s((1._c4, 2._c4), c4)
end program p

Is it not the case that the select type (o) is unnecessary for the test?

That is ' if (storage_size(o) /= sz) call abort()' is all that is needed?

Cheers

Paul

On 23 October 2013 17:44, burnus at gcc dot gnu.org
<gcc-bugzilla@gcc.gnu.org> wrote:
> http://gcc.gnu.org/bugzilla/show_bug.cgi?id=58851
>
> Tobias Burnus <burnus at gcc dot gnu.org> changed:
>
>            What    |Removed                     |Added
> ----------------------------------------------------------------------------
>                  CC|                            |burnus at gcc dot gnu.org
>
> --- Comment #2 from Tobias Burnus <burnus at gcc dot gnu.org> ---
> How about the following (untested)? It has a bit less coverage but hopefully it
> is still sufficient. Additionally, it should be portable.
>
> --- a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_13.f90
> +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_13.f90
> @@ -20,0 +21,8 @@ contains
> +    real(c1) :: rc1
> +    real(c2) :: rc2
> +    real(c3) :: rc3
> +    real(c4) :: rc4
> +    complex(c1) :: cc1
> +    complex(c2) :: cc2
> +    complex(c3) :: cc3
> +    complex(c4) :: cc4
> @@ -22,10 +30,14 @@ contains
> -    select case (k)
> -     case (4)
> -      sz = 32*2
> -     case (8)
> -      sz = 64*2
> -     case (10,16)
> -      sz = 128*2
> -     case default
> -       call abort()
> -    end select
> +    if (k == c1) then
> +      sz = storage_size(cc1)
> +      if (sz /= 2*storage_size(rc1)) call abort()
> +    elseif (k == c2) then
> +      sz = storage_size(cc2)
> +      if (sz /= 2*storage_size(rc2)) call abort()
> +    elseif (k == c3) then
> +      sz = storage_size(cc3)
> +      if (sz /= 2*storage_size(rc3)) call abort()
> +    elseif (k == c4) then
> +      sz = storage_size(cc4)
> +      if (sz /= 2*storage_size(rc4)) call abort()
> +    endif
> +    if (sz < 2) call abort()
>
> --
> You are receiving this mail because:
> You are on the CC list for the bug.
> You are the assignee for the bug.