[Patch, fortran-dev] First attempt at new array descriptor

[Paul Richard Thomas]

Dear Tobias et al.,
>
> This regression is so odd that I will probably wind up sharing it with
> you all tonight because I cannot see what is happening at all.

Well I had another stare at it and understand nothing.  With fortran-dev:

! Based on auto_char_dummy_array_1.f90
! In normal execution output is:
!  a:            3                     <= CORRECT!
!  abc
!
! With pointer assignment commented in....
!  foo:            3
!  a:            0                     <= INCORRECT!
!  abc
! *** glibc detected *** ./a.out: double free or corruption (out):
0x000000000080e550 ***
!======= Backtrace: =========
! etc., etc.
!
! Diffing the tree-original between the two reveals nothing but the
pointer assignment, which
! is never invoked, since bar1 is not called.
!
! 78,85d77
! <       p->dtype = ((integer(kind=8)) SAVE_EXPR <D.1607> << 6) + 49;
! <       p->dim[0].lbound = 1;
! <       p->dim[0].ubound = 2;
! <       p->dim[0].extent = (integer(kind=8)) SAVE_EXPR <D.1607> * 2;
! <       p->dim[0].stride = 1;
! <       p->dim[0].sm = (integer(kind=8)) SAVE_EXPR <D.1607>;
! <       p->data = (void *) &t[0];
! <       p->offset = -1;

program oh_no_not_pr15908_again
  character(12), dimension(:), pointer :: ptr
  character(12), dimension(3)          :: s

  s = "lmn"

  allocate (ptr(3))
  ptr = "xyz"
  call a (ptr, 12)
  deallocate(ptr)
contains

  subroutine a (p, l)
    character(12), dimension(2), target :: t = ["abc","cde"]
    character(l), dimension(:), pointer :: p
    if (.not.associated (p)) then
!      p => t                        ! UNCOMMENT THIS LINE TO TRIGGER FAULT
      call bar1
    else
      i = size (p,1)
      if (i.ne.3) call foo(p, l)
      call bar2(i)
      p = s
      print *, t                      ! Make sure t is referenced
    end if
  end subroutine a

  subroutine foo(p, l)          ! Use extra subroutines to move clutter from 'a'
    character(l), dimension(:), pointer :: p
    print *, "foo: ", SIZE(p,1)
  end subroutine

  subroutine bar1
    print *, "here"
  end subroutine

  subroutine bar2 (i)
    print *, "a: ", i
  end subroutine
end program oh_no_not_pr15908_again


Anybody see where the problem is?

Cheers

Paul