Commit cda7004b by Paul Thomas

re PR fortran/25901 (overloaded function is rejected)

2005-01-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25901
	* decl.c (get_proc_name): Replace subroutine and function
	attributes in "already defined" test by the formal arglist
	pointer being non-NULL.

	Fix regression in testing of admissability of attributes.
	* symbol.c (gfc_add_attribute): If the current_attr has
	non-zero intent, do not do the check for a dummy being
	used.
	* decl.c (attr_decl1): Add current_attr.intent as the
	third argument in the call to gfc_add_attribute.
	* gfortran.h: Add the third argument to the prototype
	for gfc_add_attribute.


2005-01-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25901
	* gfortran.dg/internal references_2.f90: New test.

	Fix regression in testing of admissability of attributes.
	* gfortran.dg/intent_used_1.f90: New test.

From-SVN: r110106
parent 0743efe1
2005-01-23 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25901
* decl.c (get_proc_name): Replace subroutine and function attributes
in "already defined" test by the formal arglist pointer being non-NULL.
Fix regression in testing of admissability of attributes.
* symbol.c (gfc_add_attribute): If the current_attr has non-zero
intent, do not do the check for a dummy being used.
* decl.c (attr_decl1): Add current_attr.intent as the third argument
in the call to gfc_add_attribute.
* gfortran.h: Add the third argument to the prototype for
gfc_add_attribute.
2006-01-21 Joseph S. Myers <joseph@codesourcery.com>
* gfortranspec.c (lang_specific_driver): Update copyright notice
......
......@@ -611,10 +611,14 @@ get_proc_name (const char *name, gfc_symbol ** result)
if (sym && !sym->new && gfc_current_state () != COMP_INTERFACE)
{
/* Trap another encompassed procedure with the same name. */
/* Trap another encompassed procedure with the same name. All
these conditions are necessary to avoid picking up an entry
whose name clashes with that of the encompassing procedure;
this is handled using gsymbols to register unique,globally
accessible names. */
if (sym->attr.flavor != 0
&& sym->attr.proc != 0
&& (sym->attr.subroutine || sym->attr.function))
&& sym->formal)
gfc_error_now ("Procedure '%s' at %C is already defined at %L",
name, &sym->declared_at);
......@@ -3202,7 +3206,7 @@ attr_decl1 (void)
goto cleanup;
}
if (gfc_add_attribute (&sym->attr, &var_locus) == FAILURE)
if (gfc_add_attribute (&sym->attr, &var_locus, current_attr.intent) == FAILURE)
{
m = MATCH_ERROR;
goto cleanup;
......
......@@ -1701,7 +1701,7 @@ void gfc_get_component_attr (symbol_attribute *, gfc_component *);
void gfc_set_sym_referenced (gfc_symbol * sym);
try gfc_add_attribute (symbol_attribute *, locus *);
try gfc_add_attribute (symbol_attribute *, locus *, uint);
try gfc_add_allocatable (symbol_attribute *, locus *);
try gfc_add_dimension (symbol_attribute *, const char *, locus *);
try gfc_add_external (symbol_attribute *, locus *);
......
......@@ -592,12 +592,14 @@ duplicate_attr (const char *attr, locus * where)
gfc_error ("Duplicate %s attribute specified at %L", attr, where);
}
/* Called from decl.c (attr_decl1) to check attributes, when declared separately. */
try
gfc_add_attribute (symbol_attribute * attr, locus * where)
gfc_add_attribute (symbol_attribute * attr, locus * where, uint attr_intent)
{
if (check_used (attr, NULL, where) || check_done (attr, where))
if (check_used (attr, NULL, where)
|| (attr_intent == 0 && check_done (attr, where)))
return FAILURE;
return check_conflict (attr, NULL, where);
......
2005-01-23 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25901
* gfortran.dg/internal references_2.f90: New test.
Fix regression in testing of admissability of attributes.
* gfortran.dg/intent_used_1.f90: New test.
2006-01-23 Ben Elliston <bje@au.ibm.com>
* gcc.misc-tests/dectest.exp (TORTURE_OPTIONS): Include -Os.
! { dg-do compile }
! Tests the fix for the regression caused by the patch for PR20869
! which itself is tested and described by intrinsic_external_1.f90
!
! reported to the fortran list by Dominique Dhumieres dominiq@lps.ens.fr
MODULE global
INTERFACE
SUBROUTINE foo(i, j)
IMPLICIT NONE
INTEGER :: j
integer, DIMENSION(j,*) :: i ! This constituted usage of j and so triggered....
INTENT (IN) j ! Would give "Cannot change attributes of symbol at (1) after it has been used"
INTENT (INOUT) i
END SUBROUTINE foo
END INTERFACE
END MODULE global
! { dg-do compile }
! This tests the fix for the regression caused by the internal references
! patc, which is tested by internal_references_1.f90. Reported as PR25901.
!
! Based on test cases provided by Toon Moene <toon@moene.indiv.nluug.nl>
! and by Martin Reinecke <martin@mpa-garching.mpg.de>
module aap
interface s
module procedure sub,sub1
end interface
contains
subroutine sub1(i)
integer i
real a
call sub(a) ! For the original test, this "defined" the procedure.
end subroutine sub1
subroutine sub(a) ! Would give an error on "already defined" here
real a
end subroutine sub
end module aap
\ No newline at end of file
# Makefile.in generated by automake 1.9.5 from Makefile.am.
# Makefile.in generated by automake 1.9.2 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
# 2003, 2004, 2005 Free Software Foundation, Inc.
# 2003, 2004 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
......@@ -452,13 +452,7 @@ uninstall-nodist_toolexeclibHEADERS:
# (which will cause the Makefiles to be regenerated when you run `make');
# (2) otherwise, pass the desired values on the `make' command line.
$(RECURSIVE_TARGETS):
@failcom='exit 1'; \
for f in x $$MAKEFLAGS; do \
case $$f in \
*=* | --[!k]*);; \
*k*) failcom='fail=yes';; \
esac; \
done; \
@set fnord $$MAKEFLAGS; amf=$$2; \
dot_seen=no; \
target=`echo $@ | sed s/-recursive//`; \
list='$(SUBDIRS)'; for subdir in $$list; do \
......@@ -470,7 +464,7 @@ $(RECURSIVE_TARGETS):
local_target="$$target"; \
fi; \
(cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
|| eval $$failcom; \
|| case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
done; \
if test "$$dot_seen" = "no"; then \
$(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
......@@ -478,13 +472,7 @@ $(RECURSIVE_TARGETS):
mostlyclean-recursive clean-recursive distclean-recursive \
maintainer-clean-recursive:
@failcom='exit 1'; \
for f in x $$MAKEFLAGS; do \
case $$f in \
*=* | --[!k]*);; \
*k*) failcom='fail=yes';; \
esac; \
done; \
@set fnord $$MAKEFLAGS; amf=$$2; \
dot_seen=no; \
case "$@" in \
distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \
......@@ -505,7 +493,7 @@ maintainer-clean-recursive:
local_target="$$target"; \
fi; \
(cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
|| eval $$failcom; \
|| case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
done && test -z "$$fail"
tags-recursive:
list='$(SUBDIRS)'; for subdir in $$list; do \
......
# Makefile.in generated by automake 1.9.5 from Makefile.am.
# Makefile.in generated by automake 1.9.2 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
# 2003, 2004, 2005 Free Software Foundation, Inc.
# 2003, 2004 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment