Skip to content

[from discourse] Wrong understanding of the rules for lbound and ubound for non-pointer dummy arguments #1435

@pawosm-arm

Description

@pawosm-arm

This issue was signaled on discourse as such: https://fortran-lang.discourse.group/t/an-interesting-difference-between-compilers/7131

There is also a reproducer initially written for AOCC, but since AOCC is based on classic flang, it can also be reproduced with it:

program aocc_run_test
  implicit none
  real :: arr_in1(0:10, 2:5), arr1(0:10,2:5)
  real :: arr_in2(0:10, 2:5), arr2(0:10,2:5)
  real :: arr_in3(0:10, 2:5), arr3(0:10,2:5)
  integer  i, j
  do i=0,10 
  do j=2,5
    arr_in1(i,j) = 1000*i+j
    arr_in2(i,j) = 1000*i+j
    arr_in3(i,j) = 1000*i+j
  end do
  end do

  call evaluate(arr_in1,arr_in2,arr_in3,arr1,arr2,arr3)
contains

  function justcopy(arr_in) 
   real, intent(in) :: arr_in(0:,:)
   real :: justcopy(0:ubound(arr_in,dim=1), 2:5)  !This works for "A" GNU,Intel/InteLLVM,lfortran,NAG,IBM. Does not work for "B" AOCC, NVidia, ARM.
!   real :: justcopy(0:size(arr_in,dim=1)-1, 2:5) !This works for all compilers
   write(*,*)lbound(arr_in,dim=1),ubound(arr_in,dim=1),size(arr_in,1)
   write(*,*)lbound(arr_in,dim=2),ubound(arr_in,dim=2),size(arr_in,2)
   write(*,*)lbound(justcopy,dim=1),ubound(justcopy,dim=1),size(justcopy,1)
   justcopy=arr_in
   write(*,*)lbound(justcopy,dim=1),ubound(justcopy,dim=1),size(justcopy,1)
  end function justcopy
  
  subroutine evaluate(arr_in1,arr_in2,arr_in3,arr_out1,arr_out2,arr_out3)
    real,    intent(in)  :: arr_in1(:,:)
    real,    intent(in)  :: arr_in2(:,:)
    real,    intent(in)  :: arr_in3(:,:)
    real,    intent(out) :: arr_out1(:,:)
    real,    intent(out) :: arr_out2(:,:)
    real,    intent(out) :: arr_out3(:,:)
    real, allocatable  :: X(:,:)

    arr_out1 = justcopy(arr_in1)
    X = justcopy(arr_in2)       
    arr_out2 = X
    arr_out3 = 1.0*justcopy(arr_in3)

    write(*,*)"X--       ", lbound(X), ubound(X),size(X,1) !This line is different for "A" and "B" compilers with "ubound"
    write(*,*)X
    write(*,*)"arr_out1--", lbound(arr_out1), ubound(arr_out1),size(arr_out1,1)
    write(*,*)arr_out1
    write(*,*)"arr_out2--", lbound(arr_out2), ubound(arr_out2),size(arr_out2,1)
    write(*,*)arr_out2
    write(*,*)"arr_out3--", lbound(arr_out3), ubound(arr_out3),size(arr_out3,1)
    write(*,*)arr_out3
    !With ubound arr_out3=arr_out2 != arr_out1 != X
  end subroutine evaluate  
end program aocc_run_test

Note that the most recent changes to LBOUND/UBOUND in classic flang did not improve the reported behavior.

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions