Quantcast
Channel: Recent posts
Viewing all articles
Browse latest Browse all 415

Assign Parameter to Parameter with negation - Missing error message? (+warning #5436)

$
0
0

Hi,

i tried to put some test cases into a loop. I wanted to collect some user-defined-type constants in an array. When i tried to use a negation i got some garbage numbers. I assume, that the use of that negation wasn't legal in the first place, but i think the compiler is missing some error-messages here.

It gives a warning message:
udt_parameter_array.f90(38): warning #5436: Overlapping storage initializations encountered with SCALAR_N_A

The reproducer:

module M_TEST
  implicit none
  public

  type t_test_a
    real :: v(2)
    contains
    ! Without the type-bound procedure, there is no garbage, but negation does not work
    procedure :: negate
    ! Without the operator binding, there is still garbage produced
!    generic :: operator(-) => negate
  end type

  type t_test_b
    real :: v(2)
  end type


  type(t_test_a), parameter :: vx_a = t_test_a([1.0,0.0])
  type(t_test_a), parameter :: vy_a = t_test_a([0.0,1.0])
  type(t_test_a), parameter :: array_a(4) = [vx_a, vy_a,  -vx_a, -vy_a] ! Here should be an error message(?)

  type(t_test_b), parameter :: vx_b = t_test_b([1.0,0.0])
  type(t_test_b), parameter :: vy_b = t_test_b([0.0,1.0])
  type(t_test_b), parameter :: array_b(4) = [vx_b, vy_b,  -vx_b, -vy_b] ! Here should be an error message(?)

  contains

  function negate(this)
    class(t_test_a), intent(in   ) :: this
    type(t_test_a) :: negate
    negate%v = -this%v
  end function

end module


program udt_parameter_array
  use M_TEST
  implicit none

  type(t_test_a), parameter :: scalar_p_a =  vx_a
  type(t_test_a), parameter :: scalar_n_a = -vx_a ! Here should be an error message(?)

  type(t_test_b), parameter :: scalar_p_b =  vx_b
  type(t_test_b), parameter :: scalar_n_b = -vx_b ! Here should be an error message(?)

  write(*,'(A12, 3x, *(G23.15,2x))') 'array_a(1)', array_a(1)
  write(*,'(A12, 3x, *(G23.15,2x))') 'array_a(2)', array_a(2)
  write(*,'(A12, 3x, *(G23.15,2x))') 'array_a(3)', array_a(3)
  write(*,'(A12, 3x, *(G23.15,2x))') 'array_a(4)', array_a(4)
  write(*,'(A12, 3x, *(G23.15,2x))') 'scalar_p_a', scalar_p_a
  write(*,'(A12, 3x, *(G23.15,2x))') 'scalar_n_a', scalar_n_a

  write(*,*)

  write(*,'(A12, 3x, *(G23.15,2x))') 'array_b(1)', array_b(1)
  write(*,'(A12, 3x, *(G23.15,2x))') 'array_b(2)', array_b(2)
  write(*,'(A12, 3x, *(G23.15,2x))') 'array_b(3)', array_b(3)
  write(*,'(A12, 3x, *(G23.15,2x))') 'array_b(4)', array_b(4)
  write(*,'(A12, 3x, *(G23.15,2x))') 'scalar_p_b', scalar_p_b
  write(*,'(A12, 3x, *(G23.15,2x))') 'scalar_n_b', scalar_n_b

end program

Output on my PC:

  array_a(1)      0.00000000000000        0.227795078360642E-40
  array_a(2)      0.00000000000000         0.00000000000000
  array_a(3)     0.114615003994055E-39     0.00000000000000
  array_a(4)     0.918354961579912E-40     0.00000000000000
  scalar_p_a      1.00000000000000         0.00000000000000
  scalar_n_a     0.358732406867153E-42     0.00000000000000

  array_b(1)      0.00000000000000        0.882818032524635E-43
  array_b(2)      0.00000000000000         0.00000000000000
  array_b(3)     0.882818032524635E-43     0.00000000000000
  array_b(4)      0.00000000000000         0.00000000000000
  scalar_p_b      0.00000000000000        0.882818032524635E-43
  scalar_n_b      0.00000000000000         0.00000000000000

It works without the negations in the assignment or when type A has no type bound procedure.

OS: Windows 7
Compiler: Ifort 16.3.207
Options: /Od /warn:all /stand:f08 /C

Greetings,
Wolf


Viewing all articles
Browse latest Browse all 415

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>