PR fortran/28885
REGRESSION FIX
* trans-expr.c (gfc_conv_aliased_arg): Ensure that the temp
declaration is retained for INTENT(OUT) arguments.
PR fortran/28873
REGRESSION FIX
PR fortran/20067
* resolve.c (resolve_generic_f): Make error message more
comprehensible.
(resolve_generic_s): Restructure search for specific procedures
to be similar to resolve_generic_f and change to similar error
message. Ensure that symbol reference is refreshed, in case
the search produces a NULL.
(resolve_specific_s): Restructure search, as above and as
resolve_specific_f. Ensure that symbol reference is refreshed,
in case the search produces a NULL.
PR fortran/25077
PR fortran/25102
* interface.c (check_operator_interface): Throw error if the
interface assignment tries to change intrinsic type assigments
or has less than two arguments. Also, it is an error if an
interface operator contains an alternate return.
PR fortran/24866
* parse.c (gfc_fixup_sibling_symbols): Do not modify the symbol
if it is a dummy in the contained namespace.
2006-08-30 Paul Thomas <pault@gcc.gnu.org>
PR fortran/28885
* gfortran.dg/aliasing_dummy_2.f90: New test.
PR fortran/20067
* gfortran.dg/generic_5.f90: Change error message.
PR fortran/28873
* gfortran.dg/generic_6.f90: New test.
PR fortran/25077
* gfortran.dg/redefined_intrinsic_assignment.f90: New test.
PR fortran/25102
* gfortran.dg/invalid_interface_assignment.f90: New test.
PR fortran/24866
* gfortran.dg/module_proc_external_dummy.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@116578
138bc75d-0d04-0410-961f-
82ee72b054a4
+2006-08-30 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/28885
+ REGRESSION FIX
+ * trans-expr.c (gfc_conv_aliased_arg): Ensure that the temp
+ declaration is retained for INTENT(OUT) arguments.
+
+ PR fortran/28873
+ REGRESSION FIX
+ PR fortran/20067
+ * resolve.c (resolve_generic_f): Make error message more
+ comprehensible.
+ (resolve_generic_s): Restructure search for specific procedures
+ to be similar to resolve_generic_f and change to similar error
+ message. Ensure that symbol reference is refreshed, in case
+ the search produces a NULL.
+ (resolve_specific_s): Restructure search, as above and as
+ resolve_specific_f. Ensure that symbol reference is refreshed,
+ in case the search produces a NULL.
+
+ PR fortran/25077
+ PR fortran/25102
+ * interface.c (check_operator_interface): Throw error if the
+ interface assignment tries to change intrinsic type assigments
+ or has less than two arguments. Also, it is an error if an
+ interface operator contains an alternate return.
+
+ PR fortran/24866
+ * parse.c (gfc_fixup_sibling_symbols): Do not modify the symbol
+ if it is a dummy in the contained namespace.
+
2006-08-29 Steven G. Kargl <kargls@comcast.net>
PR fortran/28866
for (formal = intr->sym->formal; formal; formal = formal->next)
{
sym = formal->sym;
-
+ if (sym == NULL)
+ {
+ gfc_error ("Alternate return cannot appear in operator "
+ "interface at %L", &intr->where);
+ return;
+ }
if (args == 0)
{
t1 = sym->ts.type;
&intr->where);
return;
}
+ if (args != 2)
+ {
+ gfc_error
+ ("Assignment operator interface at %L must have two arguments",
+ &intr->where);
+ return;
+ }
+ if (sym->formal->sym->ts.type != BT_DERIVED
+ && sym->formal->next->sym->ts.type != BT_DERIVED
+ && (sym->formal->sym->ts.type == sym->formal->next->sym->ts.type
+ || (gfc_numeric_ts (&sym->formal->sym->ts)
+ && gfc_numeric_ts (&sym->formal->next->sym->ts))))
+ {
+ gfc_error
+ ("Assignment operator interface at %L must not redefine "
+ "an INTRINSIC type assignment", &intr->where);
+ return;
+ }
}
else
{
for (ns = siblings; ns; ns = ns->sibling)
{
gfc_find_sym_tree (sym->name, ns, 0, &st);
- if (!st)
- continue;
+
+ if (!st || (st->n.sym->attr.dummy && ns == st->n.sym->ns))
+ continue;
old_sym = st->n.sym;
if ((old_sym->attr.flavor == FL_PROCEDURE
if (!gfc_generic_intrinsic (expr->symtree->n.sym->name))
{
- gfc_error ("Generic function '%s' at %L is not an intrinsic function",
+ gfc_error ("There is no specific function for the generic '%s' at %L",
expr->symtree->n.sym->name, &expr->where);
return FAILURE;
}
sym = c->symtree->n.sym;
- m = resolve_generic_s0 (c, sym);
- if (m == MATCH_YES)
- return SUCCESS;
- if (m == MATCH_ERROR)
- return FAILURE;
-
- if (sym->ns->parent != NULL && !sym->attr.use_assoc)
+ for (;;)
{
+ m = resolve_generic_s0 (c, sym);
+ if (m == MATCH_YES)
+ return SUCCESS;
+ else if (m == MATCH_ERROR)
+ return FAILURE;
+
+generic:
+ if (sym->ns->parent == NULL)
+ break;
gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
- if (sym != NULL)
- {
- m = resolve_generic_s0 (c, sym);
- if (m == MATCH_YES)
- return SUCCESS;
- if (m == MATCH_ERROR)
- return FAILURE;
- }
+
+ if (sym == NULL)
+ break;
+ if (!generic_sym (sym))
+ goto generic;
}
/* Last ditch attempt. */
-
+ sym = c->symtree->n.sym;
if (!gfc_generic_intrinsic (sym->name))
{
gfc_error
- ("Generic subroutine '%s' at %L is not an intrinsic subroutine",
+ ("There is no specific subroutine for the generic '%s' at %L",
sym->name, &c->loc);
return FAILURE;
}
sym = c->symtree->n.sym;
- m = resolve_specific_s0 (c, sym);
- if (m == MATCH_YES)
- return SUCCESS;
- if (m == MATCH_ERROR)
- return FAILURE;
-
- gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
-
- if (sym != NULL)
+ for (;;)
{
m = resolve_specific_s0 (c, sym);
if (m == MATCH_YES)
return SUCCESS;
if (m == MATCH_ERROR)
return FAILURE;
+
+ if (sym->ns->parent == NULL)
+ break;
+
+ gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
+
+ if (sym == NULL)
+ break;
}
+ sym = c->symtree->n.sym;
gfc_error ("Unable to resolve the specific subroutine '%s' at %L",
sym->name, &c->loc);
gcc_assert (rse.ss == gfc_ss_terminator);
gfc_trans_scalarizing_loops (&loop, &body);
}
+ else
+ {
+ /* Make sure that the temporary declaration survives. */
+ tmp = gfc_finish_block (&body);
+ gfc_add_expr_to_block (&loop.pre, tmp);
+ }
/* Add the post block after the second loop, so that any
freeing of allocated memory is done at the right time. */
+2006-08-30 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/28885
+ * gfortran.dg/aliasing_dummy_2.f90: New test.
+
+ PR fortran/20067
+ * gfortran.dg/generic_5.f90: Change error message.
+
+ PR fortran/28873
+ * gfortran.dg/generic_6.f90: New test.
+
+ PR fortran/25077
+ * gfortran.dg/redefined_intrinsic_assignment.f90: New test.
+
+ PR fortran/25102
+ * gfortran.dg/invalid_interface_assignment.f90: New test.
+
+ PR fortran/24866
+ * gfortran.dg/module_proc_external_dummy.f90: New test.
+
2006-08-29 Andrew Pinski <pinskia@physics.uc.edu>
PR c++/28349
--- /dev/null
+! { dg-do compile }
+! This tests the fix for PR28885, in which multiple calls to a procedure
+! with different components of an array of derived types for an INTENT(OUT)
+! argument caused an ICE internal compiler error. This came about because
+! the compiler would lose the temporary declaration with each subsequent
+! call of the procedure.
+!
+! Reduced from the contribution by Drew McCormack <drewmccormack@mac.com>
+!
+program test
+ type t
+ integer :: i
+ integer :: j
+ end type
+ type (t) :: a(5)
+ call sub('one',a%j)
+ call sub('two',a%i)
+contains
+ subroutine sub(key,a)
+ integer, intent(out) :: a(:)
+ character(*),intent(in) :: key
+ a = 1
+ end subroutine
+end program
CONTAINS
SUBROUTINE provoke
USE ice_gfortran
- CALL ice(23.0) ! { dg-error "is not an intrinsic subroutine" }
+ CALL ice(23.0) ! { dg-error "no specific subroutine" }
END SUBROUTINE
END MODULE
-
+! { dg-final { cleanup-modules "ice_gfortran provoke_ice" } }
--- /dev/null
+! { dg-do compile }
+! Tests the patch for PR28873, in which the call create () would cause an
+! error because resolve.c(resolve_generic_s) was failing to look in the
+! parent namespace for a matching specific subroutine. This, in fact, was
+! a regression due to the fix for PR28201.
+!
+! Contributed by Drew McCormack <drewmccormack@mac.com>
+!
+module A
+ private
+ interface create
+ module procedure create1
+ end interface
+ public :: create
+contains
+ subroutine create1
+ print *, "module A"
+ end subroutine
+end module
+
+module B
+ private
+ interface create
+ module procedure create1
+ end interface
+ public :: create
+contains
+ subroutine create1(a)
+ integer a
+ print *, "module B"
+ end subroutine
+end module
+
+module C
+ use A
+ private
+ public useCreate
+contains
+ subroutine useCreate
+ use B
+ call create()
+ call create(1)
+ end subroutine
+end module
+
+ use c
+ call useCreate
+end
+! { dg-final { cleanup-modules "A B C" } }
--- /dev/null
+! { dg-do compile }
+! Tests the fix for PR25102, which did not diagnose the aberrant interface
+! assignement below.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+MODULE TT
+ TYPE data_type
+ INTEGER :: I
+ END TYPE data_type
+ INTERFACE ASSIGNMENT (=)
+ MODULE PROCEDURE set ! { dg-error "Alternate return cannot appear" }
+ END INTERFACE
+CONTAINS
+ PURE SUBROUTINE set(x1,*)
+ TYPE(data_type), INTENT(OUT) :: x1
+ x1%i=0
+ END SUBROUTINE set
+END MODULE
--- /dev/null
+! { dg-do compile }
+! This tests the fix for PR24866 in which the reference to the external str, in
+! sub_module, would get mixed up with the module procedure, str, thus
+! causing an ICE. This is a completed version of the reporter's testcase; ie
+! it adds a main program and working subroutines to allow a check for
+! correct functioning.
+!
+! Contributed by Uttam Pawar <uttamp@us.ibm.com>
+!
+ subroutine sub()
+ print *, "external sub"
+ end subroutine sub
+
+module test_module
+ contains
+ subroutine sub_module(str)
+ external :: str
+ call str ()
+ end subroutine sub_module
+ subroutine str()
+ print *, "module str"
+ end subroutine str
+end module test_module
+
+ use test_module
+ external sub
+ call sub_module (sub)
+ call sub_module (str)
+end
--- /dev/null
+! { dg-do compile }
+! Tests the fix for PR25077 in which no diagnostic was produced
+! for the redefinition of an intrinsic type assignment.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+MODULE M1
+ IMPLICIT NONE
+ INTERFACE ASSIGNMENT(=)
+ MODULE PROCEDURE T1 ! { dg-error "redefine an INTRINSIC type assignment" }
+ END INTERFACE
+CONTAINS
+ SUBROUTINE T1(I,J)
+ INTEGER, INTENT(OUT) :: I
+ INTEGER, INTENT(IN) :: J
+ I=-J
+ END SUBROUTINE T1
+END MODULE M1
OSDN Git Service
