optimization/2463: If-test to sort a 2-D array fails with g77 -O2

[mast@colorado.edu]

>Number:         2463
>Category:       optimization
>Synopsis:       If-test to sort a 2-D array fails with g77 -O2
>Confidential:   no
>Severity:       serious
>Priority:       medium
>Responsible:    unassigned
>State:          open
>Class:          wrong-code
>Submitter-Id:   net
>Arrival-Date:   Mon Apr 02 15:46:00 PDT 2001
>Closed-Date:
>Last-Modified:
>Originator:     David Mastronarde
>Release:        gcc version 2.96 20000731 (Red Hat Linux 7.0)
>Organization:
>Environment:
Pentium III or AMD Athlon processors under Red Hat Linux 7.0 workstation 
class installation, running tcsh as shell.
>Description:
The code performs a simple sort on the elements in
a 2-D array.  The decision on whether to swap a
pair of columns is based on:
      if(idir*(dat(1,ii)-dat(1,jj)).lt.0.) then
With optimization -O0 or -O1, the array is sorted
correctly.  With -O2 or higher, the sort fails.
The compilation command is 
g77 -O2 -o g77bug g77bug.f
>How-To-Repeat:
c         The array to be ordered - it has to be 2-dimensional for this
c         code to fail.  The array doesn't need to be dimensioned oversize
c
        real*4 dat(2,100)
        real*4 curval,baseval/1.6356/
c
c         set idir -1 to order - to +, idir 1 to order in reverse order
c
        idir=-1
        inddisp=30
c         
c         This just fills the array with numbers
c         between -0.5 and 0.5 that are not in order
c
        do i=1,inddisp
          curval=i*baseval
          dat(1,i)=curval - nint(curval)
          dat(2,i)=i
        enddo
c
        print *,'data before'
        do i=1,inddisp
          write(*,'(2f10.4)')(dat(kk,i),kk=1,2)
        enddo
c
        do ii=1,inddisp-1
          do jj=ii+1,inddisp
c                   
c             the simple if test fails with optimization 2 or 3
c             the explicit compound test (commented out) works
c
c           if((idir.gt.0.and. dat(1,ii).lt.dat(1,jj)).or.
c     &         (idir.lt.0.and. dat(1,ii).gt.dat(1,jj)))then
            if(idir*(dat(1,ii)-dat(1,jj)).lt.0.) then
c               
c               The print statement also makes it work right
c
c             print *,'swapping',ii,jj
c               
c               doing the swap with a do loop fails
c               doing it explicitly with individual elements works
c
              do kk=1,2
                tmp=dat(kk,ii)
                dat(kk,ii)=dat(kk,jj)
                dat(kk,jj)=tmp
              enddo
            endif
          enddo
        enddo
c
        print *,'data after'
        do i=1,inddisp
          write(*,'(2f10.4)')(dat(kk,i),kk=1,2)
        enddo
        call exit
        end
>Fix:
The code indicates several changes which avert the problem,
as well as a simple workaround.  However, there is no a
priori way to know that there is a problem of this nature
which needs working around in a given program.
>Release-Note:
>Audit-Trail:
>Unformatted:
----gnatsweb-attachment----
Content-Type: application/octet-stream; name="g77bug.f"
Content-Transfer-Encoding: base64
Content-Disposition: attachment; filename="g77bug.f"

YwkgIFRoZSBhcnJheSB0byBiZSBvcmRlcmVkIC0gaXQgaGFzIHRvIGJlIDItZGltZW5zaW9uYWwg
Zm9yIHRoaXMKYwkgIGNvZGUgdG8gZmFpbC4gIFRoZSBhcnJheSBkb2Vzbid0IG5lZWQgdG8gYmUg
ZGltZW5zaW9uZWQgb3ZlcnNpemUKYwoJcmVhbCo0IGRhdCgyLDEwMCkKCXJlYWwqNCBjdXJ2YWws
YmFzZXZhbC8xLjYzNTYvCmMKYwkgIHNldCBpZGlyIC0xIHRvIG9yZGVyIC0gdG8gKywgaWRpciAx
IHRvIG9yZGVyIGluIHJldmVyc2Ugb3JkZXIKYwoJaWRpcj0tMQoJaW5kZGlzcD0zMApjCSAgCmMJ
ICBUaGlzIGp1c3QgZmlsbHMgdGhlIGFycmF5IHdpdGggbnVtYmVycwpjCSAgYmV0d2VlbiAtMC41
IGFuZCAwLjUgdGhhdCBhcmUgbm90IGluIG9yZGVyCmMKCWRvIGk9MSxpbmRkaXNwCgkgIGN1cnZh
bD1pKmJhc2V2YWwKCSAgZGF0KDEsaSk9Y3VydmFsIC0gbmludChjdXJ2YWwpCgkgIGRhdCgyLGkp
PWkKCWVuZGRvCmMKCXByaW50ICosJ2RhdGEgYmVmb3JlJwoJZG8gaT0xLGluZGRpc3AKCSAgd3Jp
dGUoKiwnKDJmMTAuNCknKShkYXQoa2ssaSksa2s9MSwyKQoJZW5kZG8KYwoJZG8gaWk9MSxpbmRk
aXNwLTEKCSAgZG8gamo9aWkrMSxpbmRkaXNwCmMJCSAgICAKYwkgICAgICB0aGUgc2ltcGxlIGlm
IHRlc3QgZmFpbHMgd2l0aCBvcHRpbWl6YXRpb24gMiBvciAzCmMJICAgICAgdGhlIGV4cGxpY2l0
IGNvbXBvdW5kIHRlc3QgKGNvbW1lbnRlZCBvdXQpIHdvcmtzCmMKYwkgICAgaWYoKGlkaXIuZ3Qu
MC5hbmQuIGRhdCgxLGlpKS5sdC5kYXQoMSxqaikpLm9yLgpjICAgICAmCQkoaWRpci5sdC4wLmFu
ZC4gZGF0KDEsaWkpLmd0LmRhdCgxLGpqKSkpdGhlbgoJICAgIGlmKGlkaXIqKGRhdCgxLGlpKS1k
YXQoMSxqaikpLmx0LjAuKSB0aGVuCmMJCQpjCQlUaGUgcHJpbnQgc3RhdGVtZW50IGFsc28gbWFr
ZXMgaXQgd29yayByaWdodApjCmMJICAgICAgcHJpbnQgKiwnc3dhcHBpbmcnLGlpLGpqCmMJCQpj
CQlkb2luZyB0aGUgc3dhcCB3aXRoIGEgZG8gbG9vcCBmYWlscwpjCQlkb2luZyBpdCBleHBsaWNp
dGx5IHdpdGggaW5kaXZpZHVhbCBlbGVtZW50cyB3b3JrcwpjCgkgICAgICBkbyBraz0xLDIKCQl0
bXA9ZGF0KGtrLGlpKQoJCWRhdChrayxpaSk9ZGF0KGtrLGpqKQoJCWRhdChrayxqaik9dG1wCgkg
ICAgICBlbmRkbwoJICAgIGVuZGlmCgkgIGVuZGRvCgllbmRkbwpjCglwcmludCAqLCdkYXRhIGFm
dGVyJwoJZG8gaT0xLGluZGRpc3AKCSAgd3JpdGUoKiwnKDJmMTAuNCknKShkYXQoa2ssaSksa2s9
MSwyKQoJZW5kZG8KCWNhbGwgZXhpdAoJZW5kCg==