[flang1]: Lowering error when using is_contiguous intrinsic on an array pointer in a derived type

[kiranchandramohan]

An error is observed when using the is_contiguous intrinsic function on an array pointer in a derived type.

Reproducer:

module message
  type :: msg_type
    integer, pointer :: arr(:)
  end type msg_type
contains
subroutine test(msg)
    type(msg_type) :: msg
    print *, is_contiguous(msg%arr)
end subroutine
end module

Error:

Lowering Error: symbol arr$sd is an inconsistent array descriptor
F90-F-0000-Internal compiler error. Errors in Lowering       1  (test.f90: 9)

[michalpasztamobica]

The problem originates from L5649 in lowerlim.c. Looking at the code the symbol is wrongly classified:

lower_sptr(int sptr, int pointerval)
{
  if (SCG(sptr) == SC_BASED) {
  ..
  } else if (ALLOCG(sptr) || POINTERG(sptr)) {

  ..  // We're dealing with a pointer, so we should probably enter here.
  
  } else {  // We hit this "else" statement.
    if (STYPEG(sptr) == ST_MEMBER) {
      /* special case this error: user has referenced an array
         with the wrong number of array indices */
      if (SYMNAME(sptr) && strstr(SYMNAME(sptr), "$sd") != 0)
        lerror("symbol %s is an inconsistent array descriptor", SYMNAME(sptr));   // We hit this error line

gbl.lineno is set to 9, containing end subroutine but the name where the sptr points to is correctly set to "arr$sd".
Worth mentioning - this is a second pass of the parser (sem.which_pass = 1), so we might have cleared the POINTER flag somewhere.

[mleair]

Whenever you see this lower error, it's probably because we missed a call to either "check_member" or "mk_member" when we generate the AST for the expression. In this case, I believe we missed the call to check_member() in the PD_is_contiguous case of ref_pd() in semfunc.c.

The following line in "case PD_is_contiguous" of ref_pd() is probably the culprit:

ARG_AST(1) = mk_id(SDSCG(i));

Try changing it to the following:

ARG_AST(1) = STYPEG(SDSCG(i)) == ST_MEMBER ? check_member(ast, mk_id(SDSCG(i))) : mk_id(SDSCG(i));

-Mark

[michalpasztamobica]

You're quite right, @mleair , thanks for your remark, I was on a slightly wrong track 😉
I applied your patch, just unwinding the if clause for better readability.

[kiranchandramohan]

The following code with storage_size intrinsic and a particular usage also shows the same issue.

program test
  type :: t
    integer :: n
  end type
  type,extends(t) :: t2
    real :: r
  end type
  type t3
    class(t), pointer :: p(:)
  end type

  type(t2), target :: a2(10)
  type(t3) :: a3
  a3%p => a2
  print *,storage_size(a3%p)
end

[mleair]

@kiranchandramohan @gklimowicz Disregard my previous comment (which is now deleted) on this. I thought the storage_size issue was fixed in nvfortran earlier this year but I was mistaken.