procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/28885 (ICE passing components of array of derived type)

Browse source 
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-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.

From-SVN: r116578
This commit is contained in:
Paul Thomas 2006-08-30 05:18:36 +00:00
parent a2ef097954
commit 8c086c9c6e
12 changed files with 253 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
gcc/fortran/ChangeLog
View file

@ -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

25
gcc/fortran/interface.c
View file

@ -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
{

5
gcc/fortran/parse.c
View file

@ -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

55
gcc/fortran/resolve.c
View file

@ -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);

6
gcc/fortran/trans-expr.c
View file

@ -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. */

20
gcc/testsuite/ChangeLog
View file

@ -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

24
gcc/testsuite/gfortran.dg/aliasing_dummy_2.f90 Normal file
View file

@ -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

4
gcc/testsuite/gfortran.dg/generic_5.f90
View file

@ -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" } }

49
gcc/testsuite/gfortran.dg/generic_6.f90 Normal file
View file

@ -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" } }

19
gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90 Normal file
View file

@ -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

29
gcc/testsuite/gfortran.dg/module_proc_external_dummy.f90 Normal file
View file

@ -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

18
gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment.f90 Normal file
View file

@ -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