aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog31
-rw-r--r--gcc/fortran/interface.c25
-rw-r--r--gcc/fortran/parse.c5
-rw-r--r--gcc/fortran/resolve.c55
-rw-r--r--gcc/fortran/trans-expr.c6
-rw-r--r--gcc/testsuite/ChangeLog20
-rw-r--r--gcc/testsuite/gfortran.dg/aliasing_dummy_2.f9024
-rw-r--r--gcc/testsuite/gfortran.dg/generic_5.f904
-rw-r--r--gcc/testsuite/gfortran.dg/generic_6.f9049
-rw-r--r--gcc/testsuite/gfortran.dg/invalid_interface_assignment.f9019
-rw-r--r--gcc/testsuite/gfortran.dg/module_proc_external_dummy.f9029
-rw-r--r--gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment.f9018
12 files changed, 253 insertions, 32 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index aeb3cb9..ce38af8 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,34 @@
+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
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index f1d968d..47fc79b 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -503,7 +503,12 @@ check_operator_interface (gfc_interface * intr, gfc_intrinsic_op operator)
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;
@@ -531,6 +536,24 @@ check_operator_interface (gfc_interface * intr, gfc_intrinsic_op operator)
&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
{
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 0416d28..9ac7e45 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2706,8 +2706,9 @@ gfc_fixup_sibling_symbols (gfc_symbol * sym, gfc_namespace * siblings)
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
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 3924dc6..f1606b1 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1181,7 +1181,7 @@ generic:
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;
}
@@ -1614,31 +1614,31 @@ resolve_generic_s (gfc_code * c)
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;
}
@@ -1708,23 +1708,24 @@ resolve_specific_s (gfc_code * c)
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);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b1bd217..37bf782 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1707,6 +1707,12 @@ gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
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. */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 15f5d63..4fe14fc 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,23 @@
+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
diff --git a/gcc/testsuite/gfortran.dg/aliasing_dummy_2.f90 b/gcc/testsuite/gfortran.dg/aliasing_dummy_2.f90
new file mode 100644
index 0000000..3a3856f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/aliasing_dummy_2.f90
@@ -0,0 +1,24 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/generic_5.f90 b/gcc/testsuite/gfortran.dg/generic_5.f90
index 037dba2..cb72098 100644
--- a/gcc/testsuite/gfortran.dg/generic_5.f90
+++ b/gcc/testsuite/gfortran.dg/generic_5.f90
@@ -23,7 +23,7 @@ MODULE provoke_ice
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" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_6.f90 b/gcc/testsuite/gfortran.dg/generic_6.f90
new file mode 100644
index 0000000..9d08ac2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_6.f90
@@ -0,0 +1,49 @@
+! { 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" } }
diff --git a/gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90 b/gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90
new file mode 100644
index 0000000..d29163d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90
@@ -0,0 +1,19 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/module_proc_external_dummy.f90 b/gcc/testsuite/gfortran.dg/module_proc_external_dummy.f90
new file mode 100644
index 0000000..08f61b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_proc_external_dummy.f90
@@ -0,0 +1,29 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment.f90 b/gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment.f90
new file mode 100644
index 0000000..915f92e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment.f90
@@ -0,0 +1,18 @@
+! { 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
generated by cgit v1.1 at 2025-12-26 23:33:19 +0000