This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: [Patch, Fortran] attribute declaration outside of INTERFACE body (PR36361)
- From: "Janus Weil" <jaydub66 at googlemail dot com>
- To: "fortran at gcc dot gnu dot org" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>, "Tobias Burnus" <burnus at net-b dot de>
- Date: Mon, 2 Jun 2008 00:15:45 +0200
- Subject: Re: [Patch, Fortran] attribute declaration outside of INTERFACE body (PR36361)
- Dkim-signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=googlemail.com; s=gamma; h=domainkey-signature:received:received:message-id:date:from:to:subject:in-reply-to:mime-version:content-type:references; bh=hsylOMk2g8m57XXuCV5A49O3REIopC7EsVGaLOqwi0o=; b=B1kyDv3wWv2pATov6t2bfeUTZj7HmKGTEFXvAhZ8glOcejhepzPLqjnUlAXNXONh5NLUCr6XhYKyR3UguAqZ5ER3ZuylPR7Lgn1ab4/m2XY43ZVqIJUhyDvrFoR7daZOAvTwbnhm4TfrUZbHc0Fbi16QI1URd8151lJJJK+ZjLs=
- Domainkey-signature: a=rsa-sha1; c=nofws; d=googlemail.com; s=gamma; h=message-id:date:from:to:subject:in-reply-to:mime-version:content-type:references; b=fx0QGSGlZICqGUQ5IklJJiUDCNkAM7VE5chpS8M8Yl/KL7KTkFJuqp7AR9XpyiTNPaKbic5ba9042g3rsxEcD0hQ+sWK95juRgJIYQZQvNztAOSVRAddTqzoW5uT5PhV2zhbwEY/EGTE53grGbaikLbTk5vtbQvv+8gfJ0Z/iWc=
- References: <854832d40805301619r2ac9d481ke5d7d20afbbbc751@mail.gmail.com>
> here is my patch for PR36361, including test cases, regtested on
> i686-pc-linux-gnu with no
> failures. It also includes the one-line fix from PR36275 comment #3.
I have modified the fix for PR36275 a little, so that it also fixes
PR36322, which is actually related. Both are based on a sub-optimal
mechanism for copying the typespec for a PROCEDURE from its interface
(which happens in "resolve_symbol"). Before, the elements of ts were
just copied one by one (missing a few, which caused the problems). Now
I made sure that all of them are copied, an that the way of doing this
still works even if new elements are added in the future.
I also added a test case for PR36322.
> There is just one thing I need someone's opinion on: The new test case
> interface_24.f90 has some slight issues regarding error recovery.
I'd still like to hear some thoughts on this.
Cheers,
Janus
Index: gcc/testsuite/gfortran.dg/interface_24.f90
===================================================================
--- gcc/testsuite/gfortran.dg/interface_24.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/interface_24.f90 (revision 0)
@@ -0,0 +1,66 @@
+! { dg-do compile }
+!
+! This tests the fix for PR36361: If a function was declared in an INTERFACE
+! statement, no attributes may be declared outside of the INTERFACE body.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m1
+ interface
+ real function f1()
+ end function
+ end interface
+ dimension :: f1(4) ! { dg-error "outside its INTERFACE body" }
+end module
+
+
+module m2
+ dimension :: f2(4)
+ interface
+ real function f2() ! { dg-error "outside its INTERFACE body" }
+ !end function
+ end interface
+end module
+
+
+! valid
+module m3
+ interface
+ real function f3()
+ dimension :: f3(4)
+ end function
+ end interface
+end module
+
+
+module m4
+ interface
+ function f4() ! { dg-error "cannot have a deferred shape" }
+ real :: f4(:)
+ end function
+ end interface
+ allocatable :: f4 ! { dg-error "outside of INTERFACE body" }
+end module
+
+
+module m5
+ allocatable :: f5(:)
+ interface
+ function f5() ! { dg-error "outside its INTERFACE body" }
+ !real f5(:)
+ !end function
+ end interface
+end module
+
+
+!valid
+module m6
+ interface
+ function f6()
+ real f6(:)
+ allocatable :: f6
+ end function
+ end interface
+end module
+
+! { dg-final { cleanup-modules "m1 m2 m3 m4 m5 m6" } }
Index: gcc/testsuite/gfortran.dg/proc_decl_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/proc_decl_2.f90 (revision 136252)
+++ gcc/testsuite/gfortran.dg/proc_decl_2.f90 (working copy)
@@ -4,16 +4,27 @@
module m
+ use ISO_C_BINDING
+
abstract interface
subroutine csub() bind(c)
end subroutine csub
end interface
+ integer, parameter :: ckind = C_FLOAT_COMPLEX
+ abstract interface
+ function stub() bind(C)
+ import ckind
+ complex(ckind) stub
+ end function
+ end interface
+
procedure():: mp1
procedure(real), private:: mp2
procedure(mfun), public:: mp3
procedure(csub), public, bind(c) :: c, d
procedure(csub), public, bind(c, name="myB") :: b
+ procedure(stub), bind(C) :: e
contains
@@ -32,6 +43,15 @@ contains
procedure(a), optional :: b
end subroutine bar
+ subroutine bar2(x)
+ abstract interface
+ character function abs_fun()
+ end function
+ end interface
+ procedure(abs_fun):: x
+ end subroutine
+
+
end module
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c (revision 136252)
+++ gcc/fortran/symbol.c (working copy)
@@ -814,6 +814,14 @@ gfc_add_allocatable (symbol_attribute *a
return FAILURE;
}
+ if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY
+ && gfc_find_state (COMP_INTERFACE) == FAILURE)
+ {
+ gfc_error ("ALLOCATABLE delaration outside of INTERFACE body at %L",
+ where);
+ return FAILURE;
+ }
+
attr->allocatable = 1;
return check_conflict (attr, NULL, where);
}
@@ -832,6 +840,14 @@ gfc_add_dimension (symbol_attribute *att
return FAILURE;
}
+ if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY
+ && gfc_find_state (COMP_INTERFACE) == FAILURE)
+ {
+ gfc_error ("DIMENSION declaration for %s outside its INTERFACE body "
+ "at %L", name, where);
+ return FAILURE;
+ }
+
attr->dimension = 1;
return check_conflict (attr, name, where);
}
@@ -1453,6 +1469,13 @@ gfc_add_explicit_interface (gfc_symbol *
return FAILURE;
}
+ if (source == IFSRC_IFBODY && (sym->attr.dimension || sym->attr.allocatable))
+ {
+ gfc_error ("Attribute declaration for %s outside its INTERFACE body "
+ "at %L", sym->name, where);
+ return FAILURE;
+ }
+
sym->formal = formal;
sym->attr.if_source = source;
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 136252)
+++ gcc/fortran/decl.c (working copy)
@@ -5216,7 +5216,7 @@ attr_decl1 (void)
/* Update symbol table. DIMENSION attribute is set
in gfc_set_array_spec(). */
if (current_attr.dimension == 0
- && gfc_copy_attr (&sym->attr, ¤t_attr, NULL) == FAILURE)
+ && gfc_copy_attr (&sym->attr, ¤t_attr, &var_locus) == FAILURE)
{
m = MATCH_ERROR;
goto cleanup;
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 136252)
+++ gcc/fortran/resolve.c (working copy)
@@ -7703,6 +7703,7 @@ resolve_symbol (gfc_symbol *sym)
gfc_symtree *this_symtree;
gfc_namespace *ns;
gfc_component *c;
+ gfc_symbol *ifc;
if (sym->attr.flavor == FL_UNKNOWN)
{
@@ -7749,11 +7750,12 @@ resolve_symbol (gfc_symbol *sym)
/* Get the attributes from the interface (now resolved). */
if (sym->ts.interface->attr.if_source || sym->ts.interface->attr.intrinsic)
{
- sym->ts.type = sym->ts.interface->ts.type;
- sym->ts.kind = sym->ts.interface->ts.kind;
- sym->attr.function = sym->ts.interface->attr.function;
- sym->attr.subroutine = sym->ts.interface->attr.subroutine;
- copy_formal_args (sym, sym->ts.interface);
+ ifc = sym->ts.interface;
+ sym->ts = ifc->ts;
+ sym->ts.interface = ifc;
+ sym->attr.function = ifc->attr.function;
+ sym->attr.subroutine = ifc->attr.subroutine;
+ copy_formal_args (sym, ifc);
}
else if (sym->ts.interface->name[0] != '\0')
{
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c (revision 136252)
+++ gcc/fortran/parse.c (working copy)
@@ -1914,23 +1914,18 @@ loop:
unexpected_eof ();
case ST_SUBROUTINE:
- new_state = COMP_SUBROUTINE;
- gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY,
- gfc_new_block->formal, NULL);
- if (current_interface.type != INTERFACE_ABSTRACT &&
- !gfc_new_block->attr.dummy &&
- gfc_add_external (&gfc_new_block->attr, &gfc_current_locus) == FAILURE)
+ case ST_FUNCTION:
+ if (st == ST_SUBROUTINE)
+ new_state = COMP_SUBROUTINE;
+ else if (st == ST_FUNCTION)
+ new_state = COMP_FUNCTION;
+ if (gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY,
+ gfc_new_block->formal, NULL) == FAILURE)
{
reject_statement ();
gfc_free_namespace (gfc_current_ns);
goto loop;
}
- break;
-
- case ST_FUNCTION:
- new_state = COMP_FUNCTION;
- gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY,
- gfc_new_block->formal, NULL);
if (current_interface.type != INTERFACE_ABSTRACT &&
!gfc_new_block->attr.dummy &&
gfc_add_external (&gfc_new_block->attr, &gfc_current_locus) == FAILURE)