PR fortran/32526
* match.c (gfc_match_call): Check, in all cases, that a symbol
is neither generic nor a subroutine before trying to add it as
a subroutine.
PR fortran/32613
* match.c (gfc_match_do): Reset the implied_index attribute.
2007-07-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/32526
* gfortran.dg/interface_14.f90: New test.
PR fortran/32613
* gfortran.dg/do_iterator_2.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@126354
138bc75d-0d04-0410-961f-
82ee72b054a4
+2007-07-05 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/32526
+ * match.c (gfc_match_call): Check, in all cases, that a symbol
+ is neither generic nor a subroutine before trying to add it as
+ a subroutine.
+
+ PR fortran/32613
+ * match.c (gfc_match_do): Reset the implied_index attribute.
+
2007-07-04 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/31198
if (m == MATCH_ERROR)
goto cleanup;
+ iter.var->symtree->n.sym->attr.implied_index = 0;
gfc_check_do_variable (iter.var->symtree);
if (gfc_match_eos () != MATCH_YES)
sym = st->n.sym;
- if (sym->ns != gfc_current_ns
- && !sym->attr.generic
- && !sym->attr.subroutine
- && gfc_get_sym_tree (name, NULL, &st) == 1)
- return MATCH_ERROR;
+ /* If it does not seem to be callable... */
+ if (!sym->attr.generic
+ && !sym->attr.subroutine)
+ {
+ /* ...create a symbol in this scope... */
+ if (sym->ns != gfc_current_ns
+ && gfc_get_sym_tree (name, NULL, &st) == 1)
+ return MATCH_ERROR;
- sym = st->n.sym;
+ if (sym != st->n.sym)
+ sym = st->n.sym;
- if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
- return MATCH_ERROR;
+ /* ...and then to try to make the symbol into a subroutine. */
+ if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
+ return MATCH_ERROR;
+ }
gfc_set_sym_referenced (sym);
+2007-07-05 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/32526
+ * gfortran.dg/interface_14.f90: New test.
+
+ PR fortran/32613
+ * gfortran.dg/do_iterator_2.f90: New test.
+
2007-07-04 H.J. Lu <hongjiu.lu@intel.com>
* gcc.dg/dfp/dfp-round.h (FE_DEC_TONEAREST): Redfined for BID.
--- /dev/null
+! { dg-do run }
+! Tests the fix for pr32613 - see:
+! http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/495c154ee188d7f1/ea292134fe68b1d0#ea292134fe68b1d0
+!
+! Contributed by Al Greynolds <awgreynolds@earthlink.net>
+!
+program main
+ call something
+end
+
+subroutine something
+! integer i !correct results from gfortran depend on this statement (before fix)
+ integer :: m = 0
+ character lit*1, line*100
+ lit(i) = line(i:i)
+ i = 1
+ n = 5
+ line = 'PZ0R1'
+ if (internal (0)) call abort ()
+ if (m .ne. 5) call abort ()
+contains
+ logical function internal (j)
+ intent(in) j
+ do i = j, n
+ k = index ('RE', lit (i))
+ m = m + 1
+ if (k == 0) cycle
+ if (i+1 == n) exit
+ enddo
+ internal = (k == 0)
+ end function
+end
--- /dev/null
+! { dg-do compile }
+! Checks the fix for a regression PR32526, which was caused by
+! the patch for PR31494. The problem here was that the symbol
+! 'new' was determined to be ambiguous.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+ module P_Class
+ implicit none
+ private :: init_Personnel
+ interface new
+ module procedure init_Personnel
+ end interface
+ contains
+ subroutine init_Personnel(this)
+ integer, intent (in) :: this
+ print *, "init personnel", this
+ end subroutine init_Personnel
+ end module P_Class
+
+ module S_Class
+ use P_Class
+ implicit none
+ private :: init_Student
+ type Student
+ private
+ integer :: personnel = 1
+ end type Student
+ interface new
+ module procedure init_Student
+ end interface
+ contains
+ subroutine init_Student(this)
+ type (Student), intent (in) :: this
+ call new(this%personnel)
+ end subroutine init_Student
+ end module S_Class
+
+ module T_Class
+ use P_Class
+ implicit none
+ private :: init_Teacher
+ type Teacher
+ private
+ integer :: personnel = 2
+ end type Teacher
+ interface new
+ module procedure init_Teacher
+ end interface
+ contains
+ subroutine init_Teacher(this)
+ type (Teacher), intent (in) :: this
+ call new(this%personnel)
+ end subroutine init_Teacher
+ end module T_Class
+
+ module poly_Class
+ use S_Class
+ use T_Class
+ end module poly_Class
+
+ module D_Class
+ use poly_Class
+ end module D_Class
+
+ use D_Class
+ type (Teacher) :: a
+ type (Student) :: b
+ call new (a)
+ call new (b)
+ end
+
+! { dg-final { cleanup-modules "P_class S_Class T_Class D_Class poly_Class" } }