User account creation filtered due to spam.

Bug 35470 - Valid pointer assigment code gives compilation errors
Summary: Valid pointer assigment code gives compilation errors
Status: RESOLVED FIXED
Alias: None
Product: gcc
Classification: Unclassified
Component: fortran (show other bugs)
Version: 4.3.0
: P3 normal
Target Milestone: ---
Assignee: Paul Thomas
URL:
Keywords: rejects-valid
Depends on:
Blocks: 32834
  Show dependency treegraph
 
Reported: 2008-03-05 11:08 UTC by Antony Lewis
Modified: 2008-03-16 19:15 UTC (History)
1 user (show)

See Also:
Host:
Target:
Build:
Known to work:
Known to fail:
Last reconfirmed: 2008-03-15 22:36:11


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description Antony Lewis 2008-03-05 11:08:54 UTC
This code compiles fine on all other known f95 compilers but gives an error in gfortran (code compiled with __GFORTRAN__ works, alternative does not):


 
  type real_pointer
    real, dimension(:), pointer :: p
  end type real_pointer


...
      recursive subroutine QuickSortArr_Real(Arr, Lin, R, index)
      !Sorts an array of pointers to arrays of reals by the value of the index'th entry
      integer, intent(in) :: Lin, R, index
#ifdef __GFORTRAN__
      type(real_pointer), dimension(:) :: Arr
#else
      type(real_pointer), dimension(*) :: Arr
#endif
      integer I, J, L
      real P
      type(real_pointer) :: temp
  
      L = Lin
      do

      I = L
      J = R
      P = Arr((L + R)/2)%p(index)
   
      do
      do while (Arr(I)%p(index) <  P) 
         I = I + 1
      end do
    
      do while (Arr(J)%p(index) > P) 
         J = J - 1
      end do

      if (I <= J) then
     
       Temp%p => Arr(I)%p
       Arr(I)%p => Arr(J)%p
       Arr(J)%p => Temp%p
       I = I + 1
       J = J - 1
      end if
      if (I > J) exit
      
      end do
    if (L < J) call QuickSortArr_Real(Arr, L, J, index);
    L = I
    if (I >= R) exit
    end do

    end subroutine QuickSortArr_Real
Comment 1 Francois-Xavier Coudert 2008-03-05 22:00:11 UTC
Confirmed as rejecting valid code, reduced testcase is:

subroutine sub(arr)
  type real_pointer
    real, pointer :: p(:)
  end type real_pointer
  type(real_pointer), dimension(*) :: arr
  real, pointer :: p(:)

  p => arr(1)%p
end subroutine

$ gfortran -c a.f90
a.f90:9.7:

  p => arr(1)%p
      1
Error: The upper bound in the last dimension must appear in the reference to the assumed size array 'arr' at (1)
Comment 2 Jerry DeLisle 2008-03-15 18:07:39 UTC
Think I have a fix.  Regression testing.

Index: resolve.c
===================================================================
--- resolve.c   (revision 133251)
+++ resolve.c   (working copy)
@@ -967,7 +967,7 @@ check_assumed_size_reference (gfc_symbol
        last = (ref->u.ar.end[dim] == NULL)
               && (ref->u.ar.type == DIMEN_ELEMENT);
 
-  if (last)
+  if (need_full_assumed_size && last)
     {
       gfc_error ("The upper bound in the last dimension must "
                 "appear in the reference to the assumed size "
Comment 3 Jerry DeLisle 2008-03-15 18:10:37 UTC
Jumped too soon. Several failures with that pacth
Comment 4 Paul Thomas 2008-03-15 22:36:11 UTC
(In reply to comment #1)
> Confirmed as rejecting valid code, reduced testcase is:

This fixes it and is regtesting as I write.

Paul
Comment 5 Paul Thomas 2008-03-15 22:37:06 UTC
(In reply to comment #1)
> Confirmed as rejecting valid code, reduced testcase is:

This fixes it and is regtesting as I write.

Paul(In reply to comment #4)
> (In reply to comment #1)
> > Confirmed as rejecting valid code, reduced testcase is:
> 
> This fixes it and is regtesting as I write.
> 
> Paul
> 

If only 'this' would fix things:)

Index: /svn/trunk/gcc/fortran/resolve.c
===================================================================
*** /svn/trunk/gcc/fortran/resolve.c    (revision 133062)
--- /svn/trunk/gcc/fortran/resolve.c    (working copy)
*************** check_assumed_size_reference (gfc_symbol
*** 965,970 ****
--- 965,971 ----
      if (ref->type == REF_ARRAY)
        for (dim = 0; dim < ref->u.ar.as->rank; dim++)
        last = (ref->u.ar.end[dim] == NULL)
+              && (ref->u.ar.as->type == AS_ASSUMED_SIZE)
               && (ref->u.ar.type == DIMEN_ELEMENT);

    if (last)
Comment 6 Jerry DeLisle 2008-03-16 05:00:31 UTC
You r 'this' is better than my 'Think' Passed regression testing here on x86-64.
Comment 7 Paul Thomas 2008-03-16 07:15:18 UTC
(In reply to comment #6)
> You r 'this' is better than my 'Think' Passed regression testing here on
> x86-64.
> 
Jerry,

I did not see that you were working on it - sorry that I trampled on your toes. I took a copy of this the moment that it was posted to keep me amused during a meeting.

Cheers

Paul
Comment 8 Paul Thomas 2008-03-16 19:15:03 UTC
Subject: Bug 35470

Author: pault
Date: Sun Mar 16 19:14:17 2008
New Revision: 133279

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=133279
Log:
2008-03-16  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/35470
	* resolve.c (check_assumed_size_reference):  Only visit the
	first reference and look directly at the highest dimension.

2008-03-16  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/35470
	* gfortran.dg/subref_array_pointer_3.f90 : New test.

Added:
    trunk/gcc/testsuite/gfortran.dg/subref_array_pointer_3.f90
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/resolve.c
    trunk/gcc/testsuite/ChangeLog

Comment 9 Paul Thomas 2008-03-16 19:15:46 UTC
Fixed on trunk

Thanks for the report

Paul