Problem with overloaded assignments and the CLASS attribute

Hi again,

I have another issue with my code, and I’d like to know if I’m being sloppy with the Fortran 2003 Standard or if it’s yet another problem of the PGI compiler. In some situations the code compiles successfully, but other times it doesn’t. The issue doesn’t show up with other compilers. So, consider the following program (a highly truncated version of mine),

MODULE scalars

   IMPLICIT NONE

   PRIVATE
   PUBLIC :: scalar

   TYPE :: scalar
      COMPLEX :: idx
   CONTAINS
      PRIVATE
      PROCEDURE, PASS :: eq_sca
      GENERIC, PUBLIC :: ASSIGNMENT(=) => eq_sca
   END TYPE scalar

   INTERFACE scalar
      MODULE PROCEDURE ctor_sca
   END INTERFACE scalar

CONTAINS

   PURE ELEMENTAL FUNCTION ctor_sca(z) RESULT(u)
      COMPLEX, INTENT(in) :: z
      TYPE(scalar) :: u
      u%idx = z
   END FUNCTION ctor_sca

   PURE ELEMENTAL SUBROUTINE eq_sca(u, v)
      CLASS(scalar), INTENT(out) :: u
      CLASS(scalar), INTENT(in)  :: v   ! <== [1]
      !TYPE(scalar), INTENT(in)  :: v   ! <== [2]
      u%idx = v%idx
   END SUBROUTINE eq_sca

END MODULE scalars


PROGRAM test

   USE scalars

   IMPLICIT NONE

   TYPE(scalar) :: a
   COMPLEX      :: z

   z = (0.,1.)
   a = scalar(z)   ! <== [3]
   PRINT *, "scalar =", a

END PROGRAM test

The module contains a derived data type with a single COMPLEX component, called “scalar”, its structure constructor, and a type-bound overloaded assignment. If I try to compile it, the compiler returns the following error message:

PGF90-S-0000-Internal compiler error. select_rtemp: bad ili 0 (test.f90: 49)
PGF90-S-0000-Internal compiler error. exp_call: ili ret type not cased 22 (test.f90: 49)
0 inform, 0 warnings, 2 severes, 0 fatal for test

The problem is in the interpretation of the type-bound assignment in line [3]. If I use line [1] as above, the compilation fails, but if I use TYPE instead of CLASS (line [2]) then the compilation is successful and the program runs normally.

The same error shows up if I promote the component “idx” to an array of odd rank, for example

COMPLEX :: idx(5)
COMPLEX :: idx(5:5:5)
COMPLEX :: idx(5:5:5:5:5)
...

If the rank is even, however, the compilation is successful and the program runs without problems, even if both dummy arguments in the assignment procedure “eq_sca” have the CLASS attribute.

So, is this another bug of the compiler, or are the CLASS attributes in the overloaded assignment an abuse of the Fortran 2003 language? I thought this could be the case, but it works in the even-rank cases with the PGI compiler, and in all cases with other compilers.

NOTE: The same issue occurs if I use a public overloaded assignment that is not type bound.

Thanks,
helvio

Let me provide yet another short example that doesn’t work. The following example compiles and builds successfully, but it may lead to a segmentation fault when I run the executable (which never happens using other compilers):

MODULE scalars

   IMPLICIT NONE

   PRIVATE
   PUBLIC :: scalar, adj

   TYPE :: scalar
      COMPLEX :: idx
   CONTAINS
      PRIVATE
      PROCEDURE, PASS :: mul_sca_sca
      GENERIC, PUBLIC :: OPERATOR(*) => mul_sca_sca
      PROCEDURE, PASS :: eq_sca
      GENERIC, PUBLIC :: ASSIGNMENT(=) => eq_sca
   END TYPE scalar

   INTERFACE adj
      MODULE PROCEDURE adj_sca
   END INTERFACE adj

CONTAINS

   PURE ELEMENTAL FUNCTION adj_sca(u) RESULT(v)
      CLASS(scalar), INTENT(in) :: u
      TYPE(scalar) :: v
      v%idx = CONJG(u%idx)
   END FUNCTION adj_sca

   PURE ELEMENTAL FUNCTION mul_sca_sca(u, v) RESULT(w)
      CLASS(scalar), INTENT(in) :: u, v
      TYPE(scalar) :: w
      w%idx = u%idx * v%idx
   END FUNCTION mul_sca_sca

   PURE ELEMENTAL SUBROUTINE eq_sca(v, u)
      CLASS(scalar), INTENT(out) :: v
      TYPE(scalar) , INTENT(in)  :: u
      v%idx = u%idx
   END SUBROUTINE eq_sca

END MODULE scalars


PROGRAM test

   USE scalars

   IMPLICIT NONE

   COMPLEX, PARAMETER :: i = (0.,1.)

   !TYPE(scalar)              :: u, v
   TYPE(scalar), DIMENSION(2) :: u, v

   u = scalar(i)
   PRINT *, u

   v = adj(u)
   PRINT *, v

END PROGRAM test

The module provides a derived type with a single scalar COMPLEX component, a type-bound operator (*) and a type-bound assignment (=); like in one of my examples of my first post, the assignment has a TYPE(scalar) input but a CLASS(scalar) output. I don’t know if this is abuse of the Fortran 2003 language, since TYPE(scalar) = TYPE(scalar) assignment is the default assignment and already exists, but other compilers never complained, and PGI’s doesn’t either in some situations. The module also provides the generic interface for a function that simply takes the CONJG of the component of the derived type. All procedures in the module are ELEMENTAL.

This program compiles and builds successfully with the PGI compiler, always. But when I run the program, it returns the “Segmentation fault (core dumped)” message at the point where “v = adj(u)” is to be executed. However, no segmentation fault occurs in the following situations:

  • 1.) if I get rid of the overloaded assignment (=);

2.) if I make the overloaded operator (*) non-type-bound;

3.) if I delete the line “v = adj(u)” in the PROGRAM “test”;

4.) if the TYPE(scalar) objects “u” and “v” in PROGRAM “test” are not arrays.

If I apply either 1.) or 2.), the generic procedure “adj” acts elementally on the TYPE(scalar) object, and returns the expected result. Note that in 2.) the assignment acts elementally and it doesn’t complain; however, the ELEMENTAL attribute seems to be an issue in any other case.

The issue does not occur with other compilers, but I don’t know if I am abusing the Fortran 2003 language somewhere…

Hi Helvio,

For the first post, an ICE is always a compiler error, valid code or not. In this case though I believe the code is valid. I’ve created a report (TPR#18873) and sent it on to our compiler engineers.

For the second post, the segv is occurring when deallocating a temp variable. I’ll need to pass this one on to engineering as well for further investigation (TPR#18874).

Thanks again,
Mat

Late update.
TPR 18874 - F2003 code gets segv when deallocating a tmp var

TPR 18873 - ICE: select_rtemp: bad ili / exp_call: ili ret type not cased 22

were fixed in 12.9.

thanks,
dave